github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-09 00:56:32 +03:00
Code Issues Projects Releases Wiki Activity

Derive the Foldable, Functor, Traversable, Eq1, Ord1, & Show1 instances.

Browse Source
This commit is contained in:
Rob Rix 2017-11-30 13:21:38 -05:00
parent 630523e2a4
commit 36b00f4ab5
1 changed files with 9 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
src/Abstract/Store.hs
View File

@ -24,6 +24,9 @@ import Control.Monad.Effect.State
import Control.Monad.Fail
import Data.Foldable (asum, toList)
import Data.Functor.Classes
import Data.Functor.Classes.Eq.Generic
import Data.Functor.Classes.Ord.Generic
import Data.Functor.Classes.Show.Generic
import qualified Data.Map as Map
import Data.Pointed
import Data.Semigroup
@ -37,6 +40,12 @@ newtype Store l a = Store { unStore :: Map.Map l (Cell l a) }
deriving instance (Eq l, Eq (Cell l a)) => Eq (Store l a)
deriving instance (Ord l, Ord (Cell l a)) => Ord (Store l a)
deriving instance (Show l, Show (Cell l a)) => Show (Store l a)
instance (Eq l, Eq1 (Cell l)) => Eq1 (Store l) where liftEq = genericLiftEq
instance (Ord l, Ord1 (Cell l)) => Ord1 (Store l) where liftCompare = genericLiftCompare
instance (Show l, Show1 (Cell l)) => Show1 (Store l) where liftShowsPrec = genericLiftShowsPrec
deriving instance Foldable (Cell l) => Foldable (Store l)
deriving instance Functor (Cell l) => Functor (Store l)
deriving instance Traversable (Cell l) => Traversable (Store l)
storeLookup :: Ord l => Address l a -> Store l a -> Maybe (Cell l a)
storeLookup = (. unStore) . Map.lookup . unAddress
@ -93,23 +102,3 @@ instance (Alternative m, Monad m) => MonadAddress Monovariant m where
uninitializedAddress :: MonadFail m => m a
uninitializedAddress = fail "uninitialized address"
instance Foldable (Cell l) => Foldable (Store l) where
foldMap = (. unStore) . foldMap . foldMap
instance (Ord l, Functor (Cell l)) => Functor (Store l) where
fmap f = Store . fmap (fmap f) . unStore
instance (Ord l, Traversable (Cell l)) => Traversable (Store l) where
traverse f = fmap Store . traverse (traverse f) . unStore
instance (Eq l, Eq1 (Cell l)) => Eq1 (Store l) where
liftEq eq (Store m1) (Store m2) = liftEq (liftEq eq) m1 m2
instance (Ord l, Ord1 (Cell l)) => Ord1 (Store l) where
liftCompare compareA (Store m1) (Store m2) = liftCompare (liftCompare compareA) m1 m2
instance (Show l, Show1 (Cell l)) => Show1 (Store l) where
liftShowsPrec sp sl d (Store m) = showsUnaryWith (liftShowsPrec (liftShowsPrec sp sl) (liftShowList sp sl)) "Store" d m