Merge pull request #224 from bgamari/master

Compatibility with Semigroup/Monoid proposal

Author: lpsmith

postgresql-simple.cabal

@@ -73,6 +73,7 @@ Library
     transformers,
     uuid-types >= 1.0.0,
     scientific,
+    semigroups,
     vector
 
   if !impl(ghc >= 7.6)

src/Database/PostgreSQL/Simple/HStore/Implementation.hs

@@ -34,6 +34,7 @@ import           Data.Text.Encoding.Error(UnicodeException)
 import qualified Data.Text.Lazy          as TL
 import           Data.Typeable
 import           Data.Monoid(Monoid(..))
+import           Data.Semigroup
 import           Database.PostgreSQL.Simple.FromField
 import           Database.PostgreSQL.Simple.ToField
 
@@ -59,19 +60,24 @@ toLazyByteString x = case x of
                        Empty -> BL.empty
                        Comma x -> BU.toLazyByteString x
 
-instance Monoid HStoreBuilder where
-    mempty = Empty
-    mappend Empty     x = x
-    mappend (Comma a) x
+instance Semigroup HStoreBuilder where
+    Empty   <> x = x
+    Comma a <> x
         = Comma (a `mappend` case x of
                                Empty   -> mempty
                                Comma b -> char8 ',' `mappend` b)
 
+instance Monoid HStoreBuilder where
+    mempty = Empty
+#if !(MIN_VERSION_base(4,11,0))
+    mappend = (<>)
+#endif
+
 class ToHStoreText a where
   toHStoreText :: a -> HStoreText
 
 -- | Represents escape text, ready to be the key or value to a hstore value
-newtype HStoreText = HStoreText Builder deriving (Typeable, Monoid)
+newtype HStoreText = HStoreText Builder deriving (Typeable, Semigroup, Monoid)
 
 instance ToHStoreText HStoreText where
   toHStoreText = id

src/Database/PostgreSQL/Simple/Types.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, GeneralizedNewtypeDeriving #-}
 
 ------------------------------------------------------------------------------
 -- |
@@ -33,7 +33,9 @@ module Database.PostgreSQL.Simple.Types
 import           Control.Arrow (first)
 import           Data.ByteString (ByteString)
 import           Data.Hashable (Hashable(hashWithSalt))
+import           Data.Foldable (toList)
 import           Data.Monoid (Monoid(..))
+import           Data.Semigroup
 import           Data.String (IsString(..))
 import           Data.Typeable (Typeable)
 import           Data.ByteString.Builder ( stringUtf8 )
@@ -88,11 +90,16 @@ instance Read Query where
 instance IsString Query where
     fromString = Query . toByteString . stringUtf8
 
+instance Semigroup Query where
+    Query a <> Query b = Query (B.append a b)
+    {-# INLINE (<>) #-}
+    sconcat xs = Query (B.concat $ map fromQuery $ toList xs)
+
 instance Monoid Query where
     mempty = Query B.empty
-    mappend (Query a) (Query b) = Query (B.append a b)
-    {-# INLINE mappend #-}
-    mconcat xs = Query (B.concat (map fromQuery xs))
+#if !(MIN_VERSION_base(4,11,0))
+    mappend = (<>)
+#endif
 
 -- | Wrap a list of values for use in an @IN@ clause.  Replaces a
 -- single \"@?@\" character with a parenthesized list of rendered