1
1
mirror of https://github.com/github/semantic.git synced 2024-12-29 01:42:43 +03:00

Move the Named functor to Analysis.Functor.Named.

This commit is contained in:
Patrick Thomson 2020-01-17 10:31:09 -05:00
parent 311654e5f8
commit a4a23e9a51
2 changed files with 34 additions and 28 deletions

View File

@ -0,0 +1,32 @@
module Analysis.Functor.Named
( module Analysis.Name
, Named (..)
, named
, named'
, namedName
, namedValue
) where
import Analysis.Name
-- | Annotates an @a@ with a 'Name'-provided name, which is ignored for '==' and 'compare'.
data Named a = Named Name a
deriving (Foldable, Functor, Show, Traversable)
named :: Name -> a -> Named a
named = Named
named' :: Name -> Named Name
named' u = Named u u
namedName :: Named a -> Name
namedName (Named n _) = n
namedValue :: Named a -> a
namedValue (Named _ a) = a
instance Eq a => Eq (Named a) where
(==) = (==) `on` namedValue
instance Ord a => Ord (Named a) where
compare = compare `on` namedValue

View File

@ -1,14 +1,9 @@
{-# LANGUAGE DeriveTraversable, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Analysis.Name
( Name(..)
, Named(..)
, named
, named'
, namedName
, namedValue
) where
import Data.Function (on)
import Data.String (IsString)
import Data.Text (Text)
@ -17,24 +12,3 @@ newtype Name = Name { unName :: Text }
deriving (Eq, IsString, Ord, Show)
-- | Annotates an @a@ with a 'Name'-provided name, which is ignored for '==' and 'compare'.
data Named a = Named Name a
deriving (Foldable, Functor, Show, Traversable)
named :: Name -> a -> Named a
named = Named
named' :: Name -> Named Name
named' u = Named u u
namedName :: Named a -> Name
namedName (Named n _) = n
namedValue :: Named a -> a
namedValue (Named _ a) = a
instance Eq a => Eq (Named a) where
(==) = (==) `on` namedValue
instance Ord a => Ord (Named a) where
compare = compare `on` namedValue