Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
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