Skip to content

Commit

Permalink
Merge pull request #224 from bgamari/master
Browse files Browse the repository at this point in the history
Compatibility with Semigroup/Monoid proposal
  • Loading branch information
lpsmith authored Sep 17, 2017
2 parents 9033bcb + 44c0bb8 commit 6361568
Show file tree
Hide file tree
Showing 3 changed files with 23 additions and 9 deletions.
1 change: 1 addition & 0 deletions postgresql-simple.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -73,6 +73,7 @@ Library
transformers,
uuid-types >= 1.0.0,
scientific,
semigroups,
vector

if !impl(ghc >= 7.6)
Expand Down
16 changes: 11 additions & 5 deletions src/Database/PostgreSQL/Simple/HStore/Implementation.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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
Expand Down
15 changes: 11 additions & 4 deletions src/Database/PostgreSQL/Simple/Types.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, GeneralizedNewtypeDeriving #-}

------------------------------------------------------------------------------
-- |
Expand Down Expand Up @@ -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 )
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit 6361568

Please sign in to comment.