github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-27 12:57:49 +03:00
Code Issues Projects Releases Wiki Activity

Reformat the Core destructors using LambdaCase.

Browse Source 
stylish-haskell is willing to leave these definitions alone.
This commit is contained in:
Rob Rix 2019-12-20 10:10:02 -05:00
parent d876d010ff
commit 1e1bd838f3
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
1 changed files with 12 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
semantic-core/src/Core/Core.hs
View File

@ -132,8 +132,9 @@ a >>> b = send (a :>> b)
infixr 1 >>>
unseq :: (Alternative m, Project Core sig) => Term sig a -> m (Term sig a, Term sig a)
unseq (Alg sig) | Just (a :>> b) <- prj sig = pure (a, b)
unseq _ = empty
unseq = \case
Alg sig | Just (a :>> b) <- prj sig -> pure (a, b)
_ -> empty
unseqs :: Project Core sig => Term sig a -> NonEmpty (Term sig a)
unseqs = go
@ -149,8 +150,9 @@ Named u n :<- a >>>= b = send (Named u a :>>= abstract1 n b)
infixr 1 >>>=
unbind :: (Alternative m, Project Core sig, RightModule sig) => a -> Term sig a -> m (Named a :<- Term sig a, Term sig a)
unbind n (Alg sig) | Just (Named u a :>>= b) <- prj sig = pure (Named u n :<- a, instantiate1 (pure n) b)
unbind _ _ = empty
unbind n = \case
Alg sig | Just (Named u a :>>= b) <- prj sig -> pure (Named u n :<- a, instantiate1 (pure n) b)
_ -> empty
unstatement :: (Alternative m, Project Core sig, RightModule sig) => a -> Term sig a -> m (Maybe (Named a) :<- Term sig a, Term sig a)
unstatement n t = first (first Just) <$> unbind n t <|> first (Nothing :<-) <$> unseq t
@ -178,8 +180,9 @@ lams :: (Eq a, Foldable t, Has Core sig m) => t (Named a) -> m a -> m a
lams names body = foldr lam body names
unlam :: (Alternative m, Project Core sig, RightModule sig) => a -> Term sig a -> m (Named a, Term sig a)
unlam n (Alg sig) | Just (Lam b) <- prj sig = pure (n <$ b, instantiate1 (pure n) (namedValue b))
unlam _ _ = empty
unlam n = \case
Alg sig | Just (Lam b) <- prj sig -> pure (n <$ b, instantiate1 (pure n) (namedValue b))
_ -> empty
($$) :: Has Core sig m => m a -> m a -> m a
f $$ a = send (f :$ a)
@ -193,8 +196,9 @@ infixl 8 $$
infixl 8 $$*
unapply :: (Alternative m, Project Core sig) => Term sig a -> m (Term sig a, Term sig a)
unapply (Alg sig) | Just (f :$ a) <- prj sig = pure (f, a)
unapply _ = empty
unapply = \case
Alg sig | Just (f :$ a) <- prj sig -> pure (f, a)
_ -> empty
unapplies :: Project Core sig => Term sig a -> (Term sig a, Stack (Term sig a))
unapplies core = case unapply core of