Add Semigroup instances

src/Data/Terminfo/Parse.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
 {-# OPTIONS_HADDOCK hide #-}
 {-# LANGUAGE NoMonomorphismRestriction #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -13,6 +14,9 @@ where
 import Control.Monad ( liftM )
 import Control.DeepSeq
 
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Semigroup (Semigroup(..))
+#endif
 import Data.Word
 import qualified Data.Vector.Unboxed as Vector
 
@@ -329,11 +333,16 @@ data BuildResults = BuildResults
     , outParamOps :: !ParamOps
     }
 
-instance Monoid BuildResults where
-    mempty = BuildResults 0 [] []
-    v0 `mappend` v1
+instance Semigroup BuildResults where
+    v0 <> v1
         = BuildResults
         { outParamCount = (outParamCount v0) `max` (outParamCount v1)
-        , outCapOps = (outCapOps v0) `mappend` (outCapOps v1)
-        , outParamOps = (outParamOps v0) `mappend` (outParamOps v1)
+        , outCapOps = (outCapOps v0) <> (outCapOps v1)
+        , outParamOps = (outParamOps v0) <> (outParamOps v1)
         }
+
+instance Monoid BuildResults where
+    mempty = BuildResults 0 [] []
+#if !(MIN_VERSION_base(4,11,0))
+    mappend = (<>)
+#endif

src/Graphics/Vty.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 -- | Vty provides interfaces for both terminal input and terminal
 -- output.
 --
@@ -50,7 +52,9 @@ import Graphics.Vty.Attributes
 import Control.Concurrent.STM
 
 import Data.IORef
-import Data.Monoid
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Semigroup ((<>))
+#endif
 
 -- | A Vty value represents a handle to the Vty library that the
 -- application must create in order to use Vty.

src/Graphics/Vty/Attributes.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE RankNTypes #-}
@@ -60,6 +61,9 @@ module Graphics.Vty.Attributes
 where
 
 import Data.Bits
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Semigroup
+#endif
 import Data.Text (Text)
 import Data.Word
 
@@ -111,13 +115,18 @@ data Attr = Attr
 --  Then the foreground color encoded into 8 bits.
 --  Then the background color encoded into 8 bits.
 
+instance Semigroup Attr where
+    attr0 <> attr1 =
+        Attr ( attrStyle attr0     <> attrStyle attr1 )
+             ( attrForeColor attr0 <> attrForeColor attr1 )
+             ( attrBackColor attr0 <> attrBackColor attr1 )
+             ( attrURL attr0       <> attrURL attr1 )
+
 instance Monoid Attr where
     mempty = Attr mempty mempty mempty mempty
-    mappend attr0 attr1 =
-        Attr ( attrStyle attr0     `mappend` attrStyle attr1 )
-             ( attrForeColor attr0 `mappend` attrForeColor attr1 )
-             ( attrBackColor attr0 `mappend` attrBackColor attr1 )
-             ( attrURL attr0       `mappend` attrURL attr1 )
+#if !(MIN_VERSION_base(4,11,0))
+    mappend = (<>)
+#endif
 
 -- | Specifies the display attributes such that the final style and
 -- color values do not depend on the previously applied display
@@ -142,17 +151,22 @@ deriving instance Eq v => Eq (MaybeDefault v)
 deriving instance Eq v => Show (MaybeDefault v)
 deriving instance (Eq v, Show v, Read v) => Read (MaybeDefault v)
 
+instance Eq v => Semigroup (MaybeDefault v) where
+    Default     <> Default     = Default
+    Default     <> KeepCurrent = Default
+    Default     <> SetTo v     = SetTo v
+    KeepCurrent <> Default     = Default
+    KeepCurrent <> KeepCurrent = KeepCurrent
+    KeepCurrent <> SetTo v     = SetTo v
+    SetTo _v    <> Default     = Default
+    SetTo v     <> KeepCurrent = SetTo v
+    SetTo _     <> SetTo v     = SetTo v
+
 instance Eq v => Monoid ( MaybeDefault v ) where
     mempty = KeepCurrent
-    mappend Default Default = Default
-    mappend Default KeepCurrent = Default
-    mappend Default ( SetTo v ) = SetTo v
-    mappend KeepCurrent Default = Default
-    mappend KeepCurrent KeepCurrent = KeepCurrent
-    mappend KeepCurrent ( SetTo v ) = SetTo v
-    mappend ( SetTo _v ) Default = Default
-    mappend ( SetTo v ) KeepCurrent = SetTo v
-    mappend ( SetTo _ ) ( SetTo v ) = SetTo v
+#if !(MIN_VERSION_base(4,11,0))
+    mappend = (<>)
+#endif
 
 -- | Styles are represented as an 8 bit word. Each bit in the word is 1
 -- if the style attribute assigned to that bit should be applied and 0

src/Graphics/Vty/Config.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
 {-# LANGUAGE TypeOperators #-}
@@ -75,7 +76,10 @@ import Control.Exception (catch, IOException, Exception(..), throwIO)
 import Control.Monad (liftM, guard, void)
 
 import qualified Data.ByteString as BS
-import Data.Monoid
+import Data.Monoid (Monoid(..))
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Semigroup (Semigroup(..))
+#endif
 import Data.Typeable (Typeable)
 
 import Graphics.Vty.Input.Events
@@ -137,6 +141,20 @@ data Config = Config
 defaultConfig :: Config
 defaultConfig = mempty
 
+instance Semigroup Config where
+    c0 <> c1 = Config
+        -- latter config takes priority for everything but inputMap
+        { vmin          = vmin c1     <|> vmin c0
+        , vtime         = vtime c1    <|> vtime c0
+        , mouseMode     = mouseMode c1
+        , bracketedPasteMode = bracketedPasteMode c1
+        , debugLog      = debugLog c1 <|> debugLog c0
+        , inputMap      = inputMap c0 <>  inputMap c1
+        , inputFd      = inputFd c1 <|> inputFd c0
+        , outputFd     = outputFd c1 <|> outputFd c0
+        , termName      = termName c1 <|> termName c0
+        }
+
 instance Monoid Config where
     mempty = Config
         { vmin         = Nothing
@@ -149,18 +167,9 @@ instance Monoid Config where
         , outputFd    = Nothing
         , termName     = Nothing
         }
-    mappend c0 c1 = Config
-        -- latter config takes priority for everything but inputMap
-        { vmin          = vmin c1     <|> vmin c0
-        , vtime         = vtime c1    <|> vtime c0
-        , mouseMode     = mouseMode c1
-        , bracketedPasteMode = bracketedPasteMode c1
-        , debugLog      = debugLog c1 <|> debugLog c0
-        , inputMap      = inputMap c0 <>  inputMap c1
-        , inputFd      = inputFd c1 <|> inputFd c0
-        , outputFd     = outputFd c1 <|> outputFd c0
-        , termName      = termName c1 <|> termName c0
-        }
+#if !(MIN_VERSION_base(4,11,0))
+    mappend = (<>)
+#endif
 
 -- | Load a configuration from @'getAppUserDataDirectory'/config@ and
 -- @$VTY_CONFIG_FILE@.

src/Graphics/Vty/DisplayAttributes.hs

@@ -1,5 +1,6 @@
 -- Copyright 2009-2010 Corey O'Connor
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
 
 module Graphics.Vty.DisplayAttributes where
 
@@ -7,6 +8,9 @@ import Graphics.Vty.Attributes
 
 import Data.Bits ((.&.))
 import Data.ByteString (ByteString)
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Semigroup (Semigroup(..))
+#endif
 import Data.Text (Text)
 import Data.Text.Encoding (encodeUtf8)
 
@@ -47,15 +51,20 @@ data DisplayAttrDiff = DisplayAttrDiff
     }
     deriving (Show)
 
-instance Monoid DisplayAttrDiff where
-    mempty = DisplayAttrDiff [] NoColorChange NoColorChange NoLinkChange
-    mappend d0 d1 =
+instance Semigroup DisplayAttrDiff where
+    d0 <> d1 =
         let ds  = simplifyStyleDiffs (styleDiffs d0)    (styleDiffs d1)
             fcd = simplifyColorDiffs (foreColorDiff d0) (foreColorDiff d1)
             bcd = simplifyColorDiffs (backColorDiff d0) (backColorDiff d1)
             ud  = simplifyUrlDiffs (urlDiff d0) (urlDiff d1)
         in DisplayAttrDiff ds fcd bcd ud
 
+instance Monoid DisplayAttrDiff where
+    mempty = DisplayAttrDiff [] NoColorChange NoColorChange NoLinkChange
+#if !(MIN_VERSION_base(4,11,0))
+    mappend = (<>)
+#endif
+
 -- | Used in the computation of a final style attribute change.
 simplifyStyleDiffs :: [StyleStateChange] -> [StyleStateChange] -> [StyleStateChange]
 simplifyStyleDiffs cs0 cs1 = cs0 `mappend` cs1

src/Graphics/Vty/Image/Internal.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# OPTIONS_HADDOCK hide #-}
@@ -11,6 +12,9 @@ import GHC.Generics
 
 import Control.DeepSeq
 
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Semigroup (Semigroup(..))
+#endif
 import qualified Data.Text.Lazy as TL
 
 -- | A display text is a Data.Text.Lazy
@@ -232,10 +236,16 @@ imageHeight CropBottom { outputHeight = h } = h
 imageHeight CropTop { outputHeight = h } = h
 imageHeight EmptyImage = 0
 
--- | Append in the Monoid instance is equivalent to '<->'.
+-- | Append in the 'Semigroup' instance is equivalent to '<->'.
+instance Semigroup Image where
+    (<>) = vertJoin
+
+-- | Append in the 'Monoid' instance is equivalent to '<->'.
 instance Monoid Image where
     mempty = EmptyImage
-    mappend = vertJoin
+#if !(MIN_VERSION_base(4,11,0))
+    mappend = (<>)
+#endif
 
 -- | combines two images side by side
 --

vty.cabal

@@ -61,6 +61,9 @@ library
                        utf8-string >= 0.3 && < 1.1,
                        vector >= 0.7
 
+  if !impl(ghc >= 8.0)
+    build-depends:     semigroups >= 0.16
+
   exposed-modules:     Graphics.Vty
                        Graphics.Vty.Attributes
                        Graphics.Vty.Config