on master help sign in
Add Semigroup instances

This resolves #30

commit525c27635a21865ab1bb3f02b129e76a5c8ef3d3 authorMichael Xavier <michael@michaelxavier.net> dateTue 31 May 2016, 13:51 (10 years ago) parent938b3f2
2 files changed+32−10
katip/katip.cabal+1 katip/src/Katip/Core.hs+31−10
katip/katip.cabal+1
@@ -74,6 +74,7 @@ library
7474 , resourcet >= 1.1 && < 1.2
7575 , microlens >= 0.2.0.0 && < 0.5
7676 , microlens-th >= 0.1.0.0 && < 0.5
77+ , semigroups
7778
7879 hs-source-dirs: src
7980 default-language: Haskell2010
katip/src/Katip/Core.hs+31−10
@@ -40,7 +40,7 @@ import Data.Foldable as FT
4040import qualified Data.HashMap.Strict as HM
4141import Data.List
4242import qualified Data.Map.Strict as M
43−import Data.Monoid
43+import Data.Semigroup
4444import Data.String
4545import Data.String.Conv
4646import Data.Text (Text)
@@ -75,7 +75,7 @@ readMay s = case [x | (x,t) <- reads s, ("","") <- lex t] of
7575-- IsString/OverloadedStrings, so "foo" will result in Namespace
7676-- ["foo"].
7777newtype Namespace = Namespace { unNamespace :: [Text] }
78− deriving (Eq,Show,Read,Ord,Generic,ToJSON,FromJSON,Monoid)
78+ deriving (Eq,Show,Read,Ord,Generic,ToJSON,FromJSON,Semigroup,Monoid)
7979
8080instance IsString Namespace where
8181 fromString s = Namespace [fromString s]
@@ -163,10 +163,16 @@ newtype LogStr = LogStr { unLogStr :: B.Builder }
163163instance IsString LogStr where
164164 fromString = LogStr . B.fromString
165165
166+
167+instance Semigroup LogStr where
168+ (LogStr a) <> (LogStr b) = LogStr (a <> b)
169+
170+
166171instance Monoid LogStr where
167− mappend (LogStr a) (LogStr b) = LogStr (a `mappend` b)
172+ mappend = (<>)
168173 mempty = LogStr mempty
169174
175+
170176instance FromJSON LogStr where
171177 parseJSON = A.withText "LogStr" parseLogStr
172178 where
@@ -335,11 +341,15 @@ data PayloadSelection
335341 | SomeKeys [Text]
336342 deriving (Show, Eq)
337343
344+instance Semigroup PayloadSelection where
345+ AllKeys <> _ = AllKeys
346+ _ <> AllKeys = AllKeys
347+ SomeKeys as <> SomeKeys bs = SomeKeys (as <> bs)
348+
349+
338350instance Monoid PayloadSelection where
339351 mempty = SomeKeys []
340− mappend AllKeys _ = AllKeys
341− mappend _ AllKeys = AllKeys
342− mappend (SomeKeys as) (SomeKeys bs) = SomeKeys (as++bs)
352+ mappend = (<>)
343353
344354
345355-------------------------------------------------------------------------------
@@ -402,15 +412,22 @@ instance ToJSON SimpleLogPayload where
402412 toJSON (SimpleLogPayload as) = object $ map go as
403413 where go (k, AnyLogPayload v) = k A..= v
404414
415+
405416instance ToObject SimpleLogPayload
406417
418+
407419instance LogItem SimpleLogPayload where
408420 payloadKeys V0 _ = SomeKeys []
409421 payloadKeys _ _ = AllKeys
410422
423+
424+instance Semigroup SimpleLogPayload where
425+ SimpleLogPayload a <> SimpleLogPayload b = SimpleLogPayload (a <> b)
426+
427+
411428instance Monoid SimpleLogPayload where
412429 mempty = SimpleLogPayload []
413− SimpleLogPayload a `mappend` SimpleLogPayload b = SimpleLogPayload (a `mappend` b)
430+ mappend = (<>)
414431
415432
416433-------------------------------------------------------------------------------
@@ -472,11 +489,15 @@ data Scribe = Scribe {
472489 }
473490
474491
492+instance Semigroup Scribe where
493+ (Scribe a) <> (Scribe b) = Scribe $ \ item -> do
494+ a item
495+ b item
496+
497+
475498instance Monoid Scribe where
476499 mempty = Scribe $ const $ return ()
477− mappend (Scribe a) (Scribe b) = Scribe $ \ item -> do
478− a item
479− b item
500+ mappend = (<>)
480501
481502
482503-------------------------------------------------------------------------------