1
1
mirror of https://github.com/github/semantic.git synced 2025-01-03 04:51:57 +03:00

Implement Semigroup instances for future compatability

This commit is contained in:
Timothy Clem 2018-03-16 10:55:19 -07:00
parent 503cf9f517
commit f3fd569a6b
4 changed files with 19 additions and 5 deletions

View File

@ -91,10 +91,12 @@ type family CallGraphAlgebraStrategy syntax where
CallGraphAlgebraStrategy (TermF f a) = 'Custom
CallGraphAlgebraStrategy a = 'Default
instance Semigroup CallGraph where
(<>) = overlay
instance Monoid CallGraph where
mempty = empty
mappend = overlay
mappend = (<>)
instance Ord CallGraph where
compare (CallGraph G.Empty) (CallGraph G.Empty) = EQ

View File

@ -29,9 +29,12 @@ lookup :: Enum i => i -> Table i a -> Maybe a
lookup i = IntMap.lookup (fromEnum i) . tableBranches
instance (Enum i, Monoid a) => Semigroup (Table i a) where
(Table i1 b1) <> (Table i2 b2) = Table (i1 `mappend` i2) (IntMap.unionWith mappend b1 b2)
instance (Enum i, Monoid a) => Monoid (Table i a) where
mempty = Table mempty mempty
mappend (Table i1 b1) (Table i2 b2) = Table (i1 `mappend` i2) (IntMap.unionWith mappend b1 b2)
mappend = (<>)
instance (Enum i, Show i) => Show1 (Table i) where
liftShowsPrec spA slA d t = showsBinaryWith showsPrec (const (liftShowList spA slA)) "Table" d (tableAddresses t) (toPairs t)

View File

@ -22,9 +22,12 @@ import Rendering.TOC (termTableOfContentsBy, declaration, getDeclaration, toCate
newtype ImportSummary = ImportSummary (Map.Map T.Text Module) deriving (Eq, Show)
instance Semigroup ImportSummary where
(<>) (ImportSummary m1) (ImportSummary m2) = ImportSummary (Map.unionWith mappend m1 m2)
instance Monoid ImportSummary where
mempty = ImportSummary mempty
mappend (ImportSummary m1) (ImportSummary m2) = ImportSummary (Map.unionWith mappend m1 m2)
mappend = (<>)
instance Output ImportSummary where
toOutput = toStrict . (<> "\n") . encode
@ -87,9 +90,12 @@ data Module = Module
, moduleCalls :: [CallExpression]
} deriving (Generic, Eq, Show)
instance Semigroup Module where
(<>) (Module n1 p1 l1 i1 d1 r1) (Module _ p2 _ i2 d2 r2) = Module n1 (p1 <> p2) l1 (i1 <> i2) (d1 <> d2) (r1 <> r2)
instance Monoid Module where
mempty = mempty
mappend (Module n1 p1 l1 i1 d1 r1) (Module _ p2 _ i2 d2 r2) = Module n1 (p1 <> p2) l1 (i1 <> i2) (d1 <> d2) (r1 <> r2)
mappend = (<>)
instance ToJSON Module where
toJSON Module{..} = object

View File

@ -37,9 +37,12 @@ import qualified Data.Text as T
data Summaries = Summaries { changes, errors :: !(Map.Map T.Text [Value]) }
deriving (Eq, Show)
instance Semigroup Summaries where
(<>) (Summaries c1 e1) (Summaries c2 e2) = Summaries (Map.unionWith (<>) c1 c2) (Map.unionWith (<>) e1 e2)
instance Monoid Summaries where
mempty = Summaries mempty mempty
mappend (Summaries c1 e1) (Summaries c2 e2) = Summaries (Map.unionWith (<>) c1 c2) (Map.unionWith (<>) e1 e2)
mappend = (<>)
instance Output Summaries where
toOutput = toStrict . (<> "\n") . encode