diff --git a/postgresql-simple.cabal b/postgresql-simple.cabal index 61c39c8d..da003880 100644 --- a/postgresql-simple.cabal +++ b/postgresql-simple.cabal @@ -16,7 +16,7 @@ Cabal-version: >= 1.9.2 extra-source-files: CONTRIBUTORS - CHANGELOG.md + CHANGES.md Library hs-source-dirs: src diff --git a/src/Database/PostgreSQL/Simple/Compat.hs b/src/Database/PostgreSQL/Simple/Compat.hs index 9cae4d5c..b00090af 100644 --- a/src/Database/PostgreSQL/Simple/Compat.hs +++ b/src/Database/PostgreSQL/Simple/Compat.hs @@ -51,23 +51,9 @@ import Unsafe.Coerce (unsafeCoerce) -- 'withTransactionMode' function calls the restore callback only once, so we -- don't need that polymorphism. mask :: ((IO a -> IO a) -> IO b) -> IO b -#if MIN_VERSION_base(4,3,0) mask io = E.mask $ \restore -> io restore -#else -mask io = do - b <- E.blocked - E.block $ io $ \m -> if b then m else E.unblock m -#endif {-# INLINE mask #-} -#if !MIN_VERSION_base(4,5,0) -infixr 6 <> - -(<>) :: Monoid m => m -> m -> m -(<>) = mappend -{-# INLINE (<>) #-} -#endif - toByteString :: Builder -> ByteString #if MIN_VERSION_bytestring(0,10,0) toByteString x = toStrict (toLazyByteString x) diff --git a/src/Database/PostgreSQL/Simple/FromRow.hs b/src/Database/PostgreSQL/Simple/FromRow.hs index e2ba1af9..2974de34 100644 --- a/src/Database/PostgreSQL/Simple/FromRow.hs +++ b/src/Database/PostgreSQL/Simple/FromRow.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards, FlexibleInstances, DefaultSignatures #-} @@ -36,6 +37,11 @@ import Control.Monad.Trans.Reader import Control.Monad.Trans.Class import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B +#if MIN_VERSION_base(4,9,0) +import Data.Functor.Const +import Data.Functor.Identity +import qualified Data.List.NonEmpty as NE +#endif import Data.Vector (Vector) import qualified Data.Vector as V import Database.PostgreSQL.Simple.Types (Only(..)) @@ -108,8 +114,8 @@ fieldWith fieldP = RP $ do "" ("at least " ++ show (unCol column + 1) ++ " slots in target type") - "mismatch between number of columns to \ - \convert and number in target type" + ("mismatch between number of columns to convert and number" + ++ "in target type") conversionError err else do let !result = rowresult @@ -141,6 +147,27 @@ instance (FromField a) => FromRow (Maybe (Only a)) where fromRow = (null *> pure Nothing) <|> (Just <$> fromRow) +#if MIN_VERSION_base(4,9,0) +instance (FromField a) => FromRow (Identity a) where + fromRow = Identity <$> field + +instance (FromField a) => FromRow (Const a b) where + fromRow = Const <$> field + +instance (FromField a) => FromRow (Maybe (Identity a)) where + fromRow = (null *> pure Nothing) + <|> (Just <$> fromRow) + +instance (FromField a) => FromRow (Maybe (Const a b)) where + fromRow = (null *> pure Nothing) + <|> (Just <$> fromRow) + +instance (FromField a) => FromRow (NE.NonEmpty a) where + fromRow = do + n <- numFieldsRemaining + (NE.:|) <$> field <*> replicateM (n - 1) field +#endif + instance (FromField a, FromField b) => FromRow (a,b) where fromRow = (,) <$> field <*> field diff --git a/src/Database/PostgreSQL/Simple/ToRow.hs b/src/Database/PostgreSQL/Simple/ToRow.hs index 00fe8fdc..64973e33 100644 --- a/src/Database/PostgreSQL/Simple/ToRow.hs +++ b/src/Database/PostgreSQL/Simple/ToRow.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DefaultSignatures, FlexibleInstances, FlexibleContexts #-} +{-# LANGUAGE CPP, DefaultSignatures, FlexibleInstances, FlexibleContexts #-} ------------------------------------------------------------------------------ -- | -- Module: Database.PostgreSQL.Simple.ToRow @@ -23,6 +23,14 @@ module Database.PostgreSQL.Simple.ToRow import Database.PostgreSQL.Simple.ToField (Action(..), ToField(..)) import Database.PostgreSQL.Simple.Types (Only(..), (:.)(..)) +#if MIN_VERSION_base(4,9,0) +import Data.Functor.Const +import Data.Functor.Identity +import qualified Data.List.NonEmpty as NE +#endif +#if MIN_VERSION_base(4,7,0) +import Data.Proxy +#endif import GHC.Generics -- | A collection type that can be turned into a list of rendering @@ -39,9 +47,25 @@ class ToRow a where instance ToRow () where toRow _ = [] +#if MIN_VERSION_base(4,7,0) +instance ToRow (Proxy a) where + toRow _ = [] +#endif + instance (ToField a) => ToRow (Only a) where toRow (Only v) = [toField v] +#if MIN_VERSION_base(4,9,0) +instance (ToField a) => ToRow (Identity a) where + toRow (Identity v) = [toField v] + +instance (ToField a) => ToRow (Const a b) where + toRow (Const v) = [toField v] + +instance (ToField a) => ToRow (NE.NonEmpty a) where + toRow = toRow . NE.toList +#endif + instance (ToField a, ToField b) => ToRow (a,b) where toRow (a,b) = [toField a, toField b]