diff --git a/postgresql-simple.cabal b/postgresql-simple.cabal index 326f1702..74169ec7 100644 --- a/postgresql-simple.cabal +++ b/postgresql-simple.cabal @@ -73,6 +73,7 @@ Library transformers, uuid-types >= 1.0.0, scientific, + semigroups, vector if !impl(ghc >= 7.6) diff --git a/src/Database/PostgreSQL/Simple/HStore/Implementation.hs b/src/Database/PostgreSQL/Simple/HStore/Implementation.hs index ee393822..6249fabb 100644 --- a/src/Database/PostgreSQL/Simple/HStore/Implementation.hs +++ b/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 diff --git a/src/Database/PostgreSQL/Simple/Types.hs b/src/Database/PostgreSQL/Simple/Types.hs index 27b4947d..920b6f4e 100644 --- a/src/Database/PostgreSQL/Simple/Types.hs +++ b/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