github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-29 18:06:14 +03:00
Code Issues Projects Releases Wiki Activity

Define a helper for constructing Named User.

Browse Source
This commit is contained in:
Rob Rix 2019-07-17 12:54:08 -04:00
parent 76f79fd315
commit 25f6f96ea4
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
3 changed files with 6 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -115,7 +115,7 @@ lam :: (Eq a, Carrier sig m, Member Core sig) => Named a -> m a -> m a
lam (Named u n) b = send (Lam u (bind1 n b))
lam' :: (Carrier sig m, Member Core sig) => User -> m User -> m User
lam' u = lam (named u u)
lam' u = lam (named' u)
lams :: (Eq a, Foldable t, Carrier sig m, Member Core sig) => t (Named a) -> m a -> m a
lams names body = foldr lam body names

2
semantic-core/src/Data/Core/Parser.hs
View File

@ -93,7 +93,7 @@ lvalue = choice
-- * Literals
name :: (TokenParsing m, Monad m) => m (Named User)
name = (named <*> id) <$> identifier <?> "name" where
name = named' <$> identifier <?> "name" where
lit :: (TokenParsing m, Monad m) => m (Term Core User)
lit = let x `given` n = x <$ reserved n in choice

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

@ -5,6 +5,7 @@ module Data.Name
, Name(..)
, Named(..)
, named
, named'
, namedName
, namedValue
, Ignored(..)
@ -65,6 +66,9 @@ data Named a = Named (Ignored User) a
named :: User -> a -> Named a
named = Named . Ignored
named' :: User -> Named User
named' u = Named (Ignored u) u
namedName :: Named a -> User
namedName (Named (Ignored n) _) = n