[commit: packages/binary] master: Add Semigroup for Put for GHC 8. (aefa0c5)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/binary

On branch  : master
Link       : http://git.haskell.org/packages/binary.git/commitdiff/aefa0c5407daf15e95d5788df8dd0ab059f35f56

>---------------------------------------------------------------

commit aefa0c5407daf15e95d5788df8dd0ab059f35f56
Author: Lennart Kolmodin <kolmodin at gmail.com>
Date:   Tue Apr 19 07:37:05 2016 +0200

    Add Semigroup for Put for GHC 8.
    
    base-4.9.0.0 has Data.Semigroup.


>---------------------------------------------------------------

aefa0c5407daf15e95d5788df8dd0ab059f35f56
 src/Data/Binary/Put.hs | 34 ++++++++++++++++++++++++++++------
 1 file changed, 28 insertions(+), 6 deletions(-)

diff --git a/src/Data/Binary/Put.hs b/src/Data/Binary/Put.hs
index 23db39f..b476694 100644
--- a/src/Data/Binary/Put.hs
+++ b/src/Data/Binary/Put.hs
@@ -4,6 +4,10 @@
 {-# LANGUAGE Safe #-}
 #endif
 
+#if MIN_VERSION_base(4,9,0)
+#define HAS_SEMIGROUP
+#endif
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      : Data.Binary.Put
@@ -72,7 +76,7 @@ module Data.Binary.Put (
 
   ) where
 
-import Data.Monoid
+import qualified Data.Monoid as Monoid
 import Data.Binary.Builder (Builder, toLazyByteString)
 import qualified Data.Binary.Builder as B
 
@@ -84,6 +88,10 @@ import qualified Data.ByteString.Lazy as L
 import Data.ByteString.Short
 #endif
 
+#ifdef HAS_SEMIGROUP
+import Data.Semigroup
+#endif
+
 import Control.Applicative
 import Prelude -- Silence AMP warning.
 
@@ -135,16 +143,30 @@ instance Monad PutM where
     (>>) = (*>)
     {-# INLINE (>>) #-}
 
-instance Monoid (PutM ()) where
+instance Monoid.Monoid (PutM ()) where
     mempty = pure ()
     {-# INLINE mempty #-}
 
-    mappend m k = Put $
-        let PairS _ w  = unPut m
-            PairS _ w' = unPut k
-        in PairS () (w `mappend` w')
+#ifdef HAS_SEMIGROUP
+    mappend = (<>)
+#else
+    mappend = mappend'
+#endif
     {-# INLINE mappend #-}
 
+mappend' :: Put -> Put -> Put
+mappend' m k = Put $
+    let PairS _ w  = unPut m
+        PairS _ w' = unPut k
+    in PairS () (w `mappend` w')
+{-# INLINE mappend' #-}
+
+#ifdef HAS_SEMIGROUP
+instance Semigroup (PutM ()) where
+    (<>) = mappend'
+    {-# INLINE (<>) #-}
+#endif
+
 tell :: Builder -> Put
 tell b = Put $ PairS () b
 {-# INLINE tell #-}