github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-24 23:42:31 +03:00
Code Issues Projects Releases Wiki Activity

Define an eliminator for statements.

Browse Source
This commit is contained in:
Rob Rix 2019-07-23 11:18:21 -04:00
parent 16413e1e5b
commit 6050b9594d
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
1 changed files with 4 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
semantic-core/src/Data/Core.hs
View File

@ -9,6 +9,7 @@ module Data.Core
, unseqs
, (>>>=)
, unbind
, unstatement
, do'
, (:<-)(..)
, lam
@ -137,6 +138,9 @@ unbind :: (Alternative m, Member Core sig, RightModule sig) => a -> Term sig a -
unbind n (Term sig) | Just (Named u a :>>= b) <- prj sig = pure (Named u n :<- a, instantiate1 (pure n) b)
unbind _ _ = empty
unstatement :: (Alternative m, Member 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
do' :: (Eq a, Foldable t, Carrier sig m, Member Core sig) => t (Maybe (Named a) :<- m a) -> m a
do' bindings = fromMaybe unit (foldr bind Nothing bindings)
where bind (n :<- a) v = maybe (a >>>) ((>>>=) . (:<- a)) n <$> v <|> Just a