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

Derive the Eq1, Ord1, & Show1 instances for Configuration.

Browse Source
This commit is contained in:
Rob Rix 2017-12-01 09:46:52 -05:00
parent 5e17e4c183
commit 9c84fb0d2a
2 changed files with 15 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
src/Data/Abstract/Cache.hs
View File

@ -28,28 +28,17 @@ cacheInsert :: (Ord l, Ord t, Ord v, Ord (Cell l v)) => Configuration l t v -> (
cacheInsert = (((Cache .) . (. unCache)) .) . (. point) . Map.insertWith (<>) cacheInsert = (((Cache .) . (. unCache)) .) . (. point) . Map.insertWith (<>)
instance (Eq l, Eq1 (Cell l)) => Eq2 (Cache l) where
liftEq2 eqT eqV (Cache a) (Cache b) = liftEq2 (liftEq2 eqT eqV) (liftEq (liftEq2 eqV (liftEq eqV))) a b
instance (Eq l, Eq t, Eq1 (Cell l)) => Eq1 (Cache l t) where instance (Eq l, Eq t, Eq1 (Cell l)) => Eq1 (Cache l t) where
liftEq = liftEq2 (==) liftEq eqV (Cache c1) (Cache c2) = liftEq2 (liftEq eqV) (liftEq (liftEq2 eqV (liftEq eqV))) c1 c2
instance (Ord l, Ord1 (Cell l)) => Ord2 (Cache l) where
liftCompare2 compareT compareV (Cache a) (Cache b) = liftCompare2 (liftCompare2 compareT compareV) (liftCompare (liftCompare2 compareV (liftCompare compareV))) a b
instance (Ord l, Ord t, Ord1 (Cell l)) => Ord1 (Cache l t) where instance (Ord l, Ord t, Ord1 (Cell l)) => Ord1 (Cache l t) where
liftCompare = liftCompare2 compare liftCompare compareV (Cache c1) (Cache c2) = liftCompare2 (liftCompare compareV) (liftCompare (liftCompare2 compareV (liftCompare compareV))) c1 c2
instance (Show l, Show1 (Cell l)) => Show2 (Cache l) where
liftShowsPrec2 spT slT spV slV d = showsUnaryWith (liftShowsPrec2 spKey slKey (liftShowsPrec spPair slPair) (liftShowList spPair slPair)) "Cache" d . unCache
where spKey = liftShowsPrec2 spT slT spV slV
slKey = liftShowList2 spT slT spV slV
spPair = liftShowsPrec2 spV slV spStore slStore
slPair = liftShowList2 spV slV spStore slStore
spStore = liftShowsPrec spV slV
slStore = liftShowList spV slV
instance (Show l, Show t, Show1 (Cell l)) => Show1 (Cache l t) where instance (Show l, Show t, Show1 (Cell l)) => Show1 (Cache l t) where
liftShowsPrec = liftShowsPrec2 showsPrec showList liftShowsPrec spV slV d = showsUnaryWith (liftShowsPrec2 spKey slKey (liftShowsPrec spPair slPair) (liftShowList spPair slPair)) "Cache" d . unCache
where spKey = liftShowsPrec spV slV
slKey = liftShowList spV slV
spPair = liftShowsPrec2 spV slV spStore slStore
slPair = liftShowList2 spV slV spStore slStore
spStore = liftShowsPrec spV slV
slStore = liftShowList spV slV

32
src/Data/Abstract/Configuration.hs
View File

@ -4,9 +4,9 @@ module Data.Abstract.Configuration where
import Data.Abstract.Address import Data.Abstract.Address
import Data.Abstract.Environment import Data.Abstract.Environment
import Data.Abstract.Store import Data.Abstract.Store
import Data.List (intersperse) import Data.Functor.Classes.Eq.Generic
import Data.Functor.Classes import Data.Functor.Classes.Ord.Generic
import Data.Monoid import Data.Functor.Classes.Show.Generic
import GHC.Generics import GHC.Generics
data Configuration l t v data Configuration l t v
@ -22,26 +22,6 @@ deriving instance (Eq l, Eq t, Eq v, Eq (Cell l v)) => Eq (Configuration l t v)
deriving instance (Ord l, Ord t, Ord v, Ord (Cell l v)) => Ord (Configuration l t v) deriving instance (Ord l, Ord t, Ord v, Ord (Cell l v)) => Ord (Configuration l t v)
deriving instance (Show l, Show t, Show v, Show (Cell l v)) => Show (Configuration l t v) deriving instance (Show l, Show t, Show v, Show (Cell l v)) => Show (Configuration l t v)
deriving instance (Ord l, Foldable (Cell l)) => Foldable (Configuration l t) deriving instance (Ord l, Foldable (Cell l)) => Foldable (Configuration l t)
instance (Eq l, Eq t, Eq1 (Cell l)) => Eq1 (Configuration l t) where liftEq = genericLiftEq
instance (Ord l, Ord t, Ord1 (Cell l)) => Ord1 (Configuration l t) where liftCompare = genericLiftCompare
instance (Eq l, Eq1 (Cell l)) => Eq2 (Configuration l) where instance (Show l, Show t, Show1 (Cell l)) => Show1 (Configuration l t) where liftShowsPrec = genericLiftShowsPrec
liftEq2 eqT eqV (Configuration t1 r1 e1 s1) (Configuration t2 r2 e2 s2) = eqT t1 t2 && liftEq (liftEq eqV) r1 r2 && liftEq eqV e1 e2 && liftEq eqV s1 s2
instance (Eq l, Eq t, Eq1 (Cell l)) => Eq1 (Configuration l t) where
liftEq = liftEq2 (==)
instance (Ord l, Ord1 (Cell l)) => Ord2 (Configuration l) where
liftCompare2 compareT compareV (Configuration t1 r1 e1 s1) (Configuration t2 r2 e2 s2) = compareT t1 t2 <> liftCompare (liftCompare compareV) r1 r2 <> liftCompare compareV e1 e2 <> liftCompare compareV s1 s2
instance (Ord l, Ord t, Ord1 (Cell l)) => Ord1 (Configuration l t) where
liftCompare = liftCompare2 compare
showsConstructor :: String -> Int -> [Int -> ShowS] -> ShowS
showsConstructor name d fields = showParen (d > 10) $ showString name . showChar ' ' . foldr (.) id (intersperse (showChar ' ') ([($ 11)] <*> fields))
instance (Show l, Show1 (Cell l)) => Show2 (Configuration l) where
liftShowsPrec2 spT _ spV slV d (Configuration t r e s) = showsConstructor "Configuration" d [ flip spT t, flip (liftShowsPrec (liftShowsPrec spV slV) (liftShowList spV slV)) r, flip (liftShowsPrec spV slV) e, flip (liftShowsPrec spV slV) s ]
instance (Show l, Show t, Show1 (Cell l)) => Show1 (Configuration l t) where
liftShowsPrec = liftShowsPrec2 showsPrec showList