Merge pull request #31 from hvr/pr/semigroup

Define Semigroup instances for base>=4.9
haskell · Feb 6, 2016 · 606c57b · 606c57b
2 parents c7d67f7 + d0ab406
commit 606c57b
Show file tree

Hide file tree

Showing 2 changed files with 24 additions and 2 deletions.
diff --git a/src/Text/PrettyPrint/Annotated/HughesPJ.hs b/src/Text/PrettyPrint/Annotated/HughesPJ.hs
@@ -84,7 +84,9 @@ module Text.PrettyPrint.Annotated.HughesPJ (
 
 import Control.DeepSeq ( NFData(rnf) )
 import Data.Function   ( on )
-#if __GLASGOW_HASKELL__ < 709
+#if __GLASGOW_HASKELL__ >= 800
+import qualified Data.Semigroup as Semi ( Semigroup((<>)) )
+#elif __GLASGOW_HASKELL__ < 709
 import Data.Monoid     ( Monoid(mempty, mappend)  )
 #endif
 import Data.String     ( IsString(fromString) )
@@ -258,9 +260,18 @@ data TextDetails = Chr  {-# UNPACK #-} !Char -- ^ A single Char fragment
 #endif
 
 -- Combining @Doc@ values
+#if __GLASGOW_HASKELL__ >= 800
+instance Semi.Semigroup (Doc a) where
+    (<>) = (Text.PrettyPrint.Annotated.HughesPJ.<>)
+
+instance Monoid (Doc a) where
+    mempty  = empty
+    mappend = (Semi.<>)
+#else
 instance Monoid (Doc a) where
     mempty  = empty
     mappend = (<>)
+#endif
 
 instance IsString (Doc a) where
     fromString = text

diff --git a/src/Text/PrettyPrint/HughesPJ.hs b/src/Text/PrettyPrint/HughesPJ.hs
@@ -87,7 +87,9 @@ import qualified Text.PrettyPrint.Annotated.HughesPJ as Ann
 
 import Control.DeepSeq ( NFData(rnf) )
 import Data.Function   ( on )
-#if __GLASGOW_HASKELL__ < 709
+#if __GLASGOW_HASKELL__ >= 800
+import qualified Data.Semigroup as Semi ( Semigroup((<>)) )
+#elif __GLASGOW_HASKELL__ < 709
 import Data.Monoid     ( Monoid(mempty, mappend)  )
 #endif
 import Data.String     ( IsString(fromString) )
@@ -127,9 +129,18 @@ liftBinary f (Doc a) (Doc b) = Doc (f a b)
 type RDoc = Doc
 
 -- Combining @Doc@ values
+#if __GLASGOW_HASKELL__ >= 800
+instance Semi.Semigroup Doc where
+    (<>) = (Text.PrettyPrint.HughesPJ.<>)
+
+instance Monoid Doc where
+    mempty  = empty
+    mappend = (Semi.<>)
+#else
 instance Monoid Doc where
     mempty  = empty
     mappend = (<>)
+#endif
 
 instance IsString Doc where
     fromString = text