diff --git a/postgresql-simple.cabal b/postgresql-simple.cabal --- a/postgresql-simple.cabal +++ b/postgresql-simple.cabal @@ -1,5 +1,5 @@ Name: postgresql-simple -Version: 0.3.9.1 +Version: 0.3.10.0 Synopsis: Mid-Level PostgreSQL client library Description: Mid-Level PostgreSQL client library, forked from mysql-simple. @@ -79,7 +79,7 @@ source-repository this type: git location: http://github.com/lpsmith/postgresql-simple - tag: v0.3.9.1 + tag: v0.3.10.0 test-suite test type: exitcode-stdio-1.0 @@ -105,6 +105,7 @@ , ScopedTypeVariables build-depends: base + , aeson , base16-bytestring , bytestring , containers diff --git a/src/Database/PostgreSQL/Simple.hs b/src/Database/PostgreSQL/Simple.hs --- a/src/Database/PostgreSQL/Simple.hs +++ b/src/Database/PostgreSQL/Simple.hs @@ -79,6 +79,9 @@ -- * Queries that return results , query , query_ + -- ** Queries taking parser as argument + , queryWith + , queryWith_ -- * Queries that stream results , FoldOptions(..) , FetchQuantity(..) @@ -366,17 +369,24 @@ -- using 'execute' instead of 'query'). -- -- * 'ResultError': result conversion failed. -query :: (ToRow q, FromRow r) - => Connection -> Query -> q -> IO [r] -query conn template qs = do - result <- exec conn =<< formatQuery conn template qs - finishQuery conn template result +query :: (ToRow q, FromRow r) => Connection -> Query -> q -> IO [r] +query = queryWith fromRow -- | A version of 'query' that does not perform query substitution. query_ :: (FromRow r) => Connection -> Query -> IO [r] -query_ conn q@(Query que) = do +query_ = queryWith_ fromRow + +-- | A version of 'query' taking parser as argument +queryWith :: ToRow q => RowParser r -> Connection -> Query -> q -> IO [r] +queryWith parser conn template qs = do + result <- exec conn =<< formatQuery conn template qs + finishQueryWith parser conn template result + +-- | A version of 'query_' taking parser as argument +queryWith_ :: RowParser r -> Connection -> Query -> IO [r] +queryWith_ parser conn q@(Query que) = do result <- exec conn que - finishQuery conn q result + finishQueryWith parser conn q result -- | Perform a @SELECT@ or other SQL query that is expected to return -- results. Results are streamed incrementally from the server, and @@ -541,8 +551,11 @@ a <- m n loop (n-1) (a:as) -finishQuery :: (FromRow r) => Connection -> Query -> PQ.Result -> IO [r] -finishQuery conn q result = do +finishQuery :: FromRow r => Connection -> Query -> PQ.Result -> IO [r] +finishQuery = finishQueryWith fromRow + +finishQueryWith :: RowParser r -> Connection -> Query -> PQ.Result -> IO [r] +finishQueryWith parser conn q result = do status <- PQ.resultStatus result case status of PQ.EmptyQuery -> @@ -555,7 +568,7 @@ ncols <- PQ.nfields result forM' 0 (nrows-1) $ \row -> do let rw = Row row result - okvc <- runConversion (runStateT (runReaderT (unRP fromRow) rw) 0) conn + okvc <- runConversion (runStateT (runReaderT (unRP parser) rw) 0) conn case okvc of Ok (val,col) | col == ncols -> return val | otherwise -> do diff --git a/src/Database/PostgreSQL/Simple/ToField.hs b/src/Database/PostgreSQL/Simple/ToField.hs --- a/src/Database/PostgreSQL/Simple/ToField.hs +++ b/src/Database/PostgreSQL/Simple/ToField.hs @@ -33,7 +33,7 @@ import Data.Time (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime) import Data.Typeable (Typeable) import Data.Word (Word, Word8, Word16, Word32, Word64) -import Database.PostgreSQL.Simple.Types (Binary(..), In(..), Null) +import Database.PostgreSQL.Simple.Types (Binary(..), In(..), Null, Default) import qualified Blaze.ByteString.Builder.Char.Utf8 as Utf8 import qualified Data.ByteString as SB import qualified Data.ByteString.Lazy as LB @@ -97,6 +97,10 @@ instance ToField Null where toField _ = renderNull + {-# INLINE toField #-} + +instance ToField Default where + toField _ = Plain (fromByteString "default") {-# INLINE toField #-} instance ToField Bool where diff --git a/src/Database/PostgreSQL/Simple/Types.hs b/src/Database/PostgreSQL/Simple/Types.hs --- a/src/Database/PostgreSQL/Simple/Types.hs +++ b/src/Database/PostgreSQL/Simple/Types.hs @@ -16,6 +16,7 @@ module Database.PostgreSQL.Simple.Types ( Null(..) + , Default(..) , Only(..) , In(..) , Binary(..) @@ -42,6 +43,10 @@ instance Eq Null where _ == _ = False _ /= _ = False + +-- | A placeholder for the PostgreSQL @DEFAULT@ value. +data Default = Default + deriving (Read, Show, Typeable) -- | A query string. This type is intended to make it difficult to -- construct a SQL query by concatenating string fragments, as that is diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -12,11 +12,13 @@ import Data.IORef import Data.Typeable import qualified Data.ByteString as B +import Data.Map (Map) import qualified Data.Map as Map import Data.Text(Text) import System.Exit (exitFailure) import System.IO import qualified Data.Vector as V +import Data.Aeson import Notify import Serializable @@ -32,6 +34,7 @@ , TestLabel "Time" . testTime , TestLabel "Array" . testArray , TestLabel "HStore" . testHStore + , TestLabel "JSON" . testJSON , TestLabel "Savepoint" . testSavepoint ] @@ -165,6 +168,19 @@ let m = Only (HStoreMap (Map.fromList xs)) m' <- query conn "SELECT ?::hstore" m [m] @?= m' + +testJSON :: TestEnv -> Test +testJSON TestEnv{..} = TestCase $ do + roundTrip (Map.fromList [] :: Map ByteString ByteString) + roundTrip (Map.fromList [("foo","bar"),("bar","baz"),("baz","hello")] :: Map ByteString ByteString ) + roundTrip (Map.fromList [("fo\"o","bar"),("b\\ar","baz"),("baz","\"value\\with\"escapes")] :: Map ByteString ByteString) + roundTrip (V.fromList [1,2,3,4,5::Int]) + where + roundTrip :: ToJSON a => a -> Assertion + roundTrip a = do + let js = Only (toJSON a) + js' <- query conn "SELECT ?::json" js + [js] @?= js' testSavepoint :: TestEnv -> Test testSavepoint TestEnv{..} = TestCase $ do