github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-25 16:02:43 +03:00
Code Issues Projects Releases Wiki Activity

Factor the ignoring part of Named out.

Browse Source
This commit is contained in:
Rob Rix 2019-07-02 12:08:13 -04:00
parent daa280c300
commit f0c08d8712
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
1 changed files with 13 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -4,7 +4,9 @@ module Data.Name
, Namespaced
, Name(..)
, Named(..)
, named
, namedName
, namedValue
, reservedNames
, isSimpleCharacter
, needsQuotation
@ -68,18 +70,24 @@ instance Pretty Name where
-- | Annotates an @a@ with a 'User'-provided name, which is ignored for '==' and 'compare'.
data Named a = Named User a
deriving (Foldable, Functor, Show, Traversable)
data Named a = Named (Ignored User) a
deriving (Eq, Foldable, Functor, Ord, Show, Traversable)
instance Eq a => Eq (Named a) where (==) = (==) `on` namedValue
instance Ord a => Ord (Named a) where compare = compare `on` namedValue
named :: User -> a -> Named a
named = Named . Ignored
namedName :: Named a -> User
namedName (Named n _) = n
namedName (Named (Ignored n) _) = n
namedValue :: Named a -> a
namedValue (Named _ a) = a
newtype Ignored a = Ignored a
deriving (Foldable, Functor, Show, Traversable)
instance Eq (Ignored a) where _ == _ = True
instance Ord (Ignored a) where compare _ _ = EQ
reservedNames :: HashSet String
reservedNames = [ "#true", "#false", "let", "#frame", "if", "then", "else"