postgresql-simple 0.5.4.0 → 0.6
raw patch · 17 files changed
+600/−62 lines, 17 filesdep +Onlydep ~aesondep ~attoparsecdep ~base
Dependencies added: Only
Dependency ranges changed: aeson, attoparsec, base, bytestring, bytestring-builder, case-insensitive, containers, hashable, postgresql-libpq, scientific, semigroups, template-haskell, text, time, transformers, uuid-types, vector
Files
- CHANGES.md +58/−0
- bench/Select.hs +32/−0
- postgresql-simple.cabal +47/−25
- src/Database/PostgreSQL/Simple.hs +1/−0
- src/Database/PostgreSQL/Simple/FromField.hs +10/−6
- src/Database/PostgreSQL/Simple/FromRow.hs +190/−0
- src/Database/PostgreSQL/Simple/Internal.hs +6/−3
- src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hs +40/−6
- src/Database/PostgreSQL/Simple/Range.hs +7/−3
- src/Database/PostgreSQL/Simple/Time/Internal/Printer.hs +1/−1
- src/Database/PostgreSQL/Simple/ToField.hs +11/−0
- src/Database/PostgreSQL/Simple/ToRow.hs +90/−0
- src/Database/PostgreSQL/Simple/Transaction.hs +1/−1
- src/Database/PostgreSQL/Simple/Types.hs +1/−17
- src/Database/PostgreSQL/Simple/Vector.hs +45/−0
- src/Database/PostgreSQL/Simple/Vector/Unboxed.hs +44/−0
- test/Main.hs +16/−0
CHANGES.md view
@@ -1,3 +1,61 @@+### Version 0.6 (2018-09-25)++ * *Breaking change*: Use `Only` package's `Only for a common 1-tuple.++ Consider a downstream library depending already both on+ `Only` and `postgresql-simple` package. This library my define+ a `MyClass` with instances for `Only.Only` and `PostgreSQL.Only`.+ As now these types are the same, a library would break.+ Therefore I consider "merging" types a breaking change.++ There are two ways for adopting this change in that scenario:++ - Either CPP-guard `PostgreSQL.Only` instance with++ ```haskell+ #if !MIN_VERSION_postgresql_simple(0,6,0)+ instance MyClass (PostgreSQL.Only a) where ...+ #endif+ ```++ - or simply remove it and add `postgresql-simple >=0.6` lower bound,+ making sure that there's only single `Only`.++ * Add `ToField` instances for case-insensitive strict and lazy text.+ Thanks to Max Tagher for the implementation.+ https://github.com/lpsmith/postgresql-simple/pull/232++ * Add support to CockroachDB.+ Thanks to Georte Steel.+ https://github.com/lpsmith/postgresql-simple/pull/245++ * Add Generic ConnectInfo instance+ Thanks to Dmitry Dzhus.+ https://github.com/lpsmith/postgresql-simple/pull/235++ * Add `fromFieldRange :: Typeable a => FieldParser a -> FieldParser (PGRange a)`+ https://github.com/lpsmith/postgresql-simple/pull/221++ * Add `fromFieldJSONByteString :: FieldParser ByteString`+ https://github.com/lpsmith/postgresql-simple/pull/222/files++ * Fix off-by-one error in year builder.+ Thanks to Nathan Ferris Hunter.+ https://github.com/lpsmith/postgresql-simple/pull/230++ * Extend ToRow and FromRow to tuples of size 18+ Thanks to Bardur Arantsson.+ https://github.com/lpsmith/postgresql-simple/pull/229++ * Add `Vector` and `Vector.Unboxed` `query` variants.+ These are more memory efficient+ (especially, if you anyway will convert to some vector)+ https://github.com/phadej/1++ * Documentation improvements+ https://github.com/lpsmith/postgresql-simple/pull/227+ https://github.com/lpsmith/postgresql-simple/pull/236+ ### Version 0.5.4.0 (2018-05-23) * Support GHC-8.4 (Semigroup/Monoid)
+ bench/Select.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Database.PostgreSQL.Simple+import qualified Database.PostgreSQL.Simple.Vector as V+import qualified Database.PostgreSQL.Simple.Vector.Unboxed as VU++import System.Environment (getArgs)+import Data.Foldable (Foldable, foldl')+import qualified Data.Vector.Unboxed as VU++main :: IO ()+main = do+ args <- getArgs+ conn <- connectPostgreSQL ""+ case args of+ ("vector":_) -> do+ result <- V.query_ conn "SELECT * FROM generate_series(1, 10000000);"+ print (process result)+ ("unboxed":_) -> do+ -- dummy column+ result <- VU.query_ conn "SELECT (NULL :: VOID), * FROM generate_series(1, 10000000);"+ print (process' result)+ _ -> do+ result <- query_ conn "SELECT * FROM generate_series(1, 10000000);"+ print (process result)++process :: Foldable f => f (Only Int) -> Int+process = foldl' (\x (Only y) -> max x y) 0++process' :: VU.Vector ((), Int) -> Int+process' = VU.foldl' (\x (_, y) -> max x y) 0
postgresql-simple.cabal view
@@ -1,6 +1,6 @@-Cabal-version: >= 1.10+Cabal-version: 1.12 Name: postgresql-simple-Version: 0.5.4.0+Version: 0.6 Synopsis: Mid-Level PostgreSQL client library Description:@@ -8,9 +8,10 @@ License: BSD3 License-file: LICENSE Author: Bryan O'Sullivan, Leon P Smith-Maintainer: Leon P Smith <leon@melding-monads.com>+Maintainer: Oleg Grenrus <oleg.grenrus@iki.fi> Copyright: (c) 2011 MailRank, Inc.- (c) 2011-2015 Leon P Smith+ (c) 2011-2018 Leon P Smith+ (c) 2018 Oleg Grenrus Category: Database Build-type: Simple @@ -26,7 +27,8 @@ || == 7.10.3 || == 8.0.2 || == 8.2.2- || == 8.4.2+ || == 8.4.4+ || == 8.6.1 Library default-language: Haskell2010@@ -55,6 +57,9 @@ Database.PostgreSQL.Simple.TypeInfo.Static Database.PostgreSQL.Simple.Types Database.PostgreSQL.Simple.Errors+ Database.PostgreSQL.Simple.Vector+ Database.PostgreSQL.Simple.Vector.Unboxed+ -- Other-modules: Database.PostgreSQL.Simple.Internal @@ -67,27 +72,32 @@ Database.PostgreSQL.Simple.Time.Internal.Printer Database.PostgreSQL.Simple.TypeInfo.Types + -- GHC bundled libs Build-depends:- aeson >= 0.6,- attoparsec >= 0.10.3,- base >= 4.6 && < 5,- bytestring >= 0.9,- bytestring-builder,- case-insensitive,- containers,- hashable,- postgresql-libpq >= 0.9 && < 0.10,- template-haskell,- text >= 0.11.1,- time >= 1.1.4,- transformers,- uuid-types >= 1.0.0,- scientific,- vector+ base >=4.6.0.0 && <4.13+ , bytestring >=0.10.0.0 && <0.11+ , containers >=0.5.0.0 && <0.7+ , time >=1.4.0.1 && <1.9+ , transformers >=0.3.0.0 && <0.6+ , template-haskell >=2.8.0.0 && <2.15+ , text >=1.2.3.0 && <1.3 + -- Other dependencies+ Build-depends:+ aeson >=1.4.1.0 && <1.5+ , attoparsec >=0.13.2.2 && <0.14+ , bytestring-builder >=0.10.8.1.0 && <0.11+ , case-insensitive >=1.2.0.11 && <1.3+ , hashable >=1.2.7.0 && <1.3+ , Only >=0.1 && <0.1.1+ , postgresql-libpq >=0.9.4.2 && < 0.10+ , uuid-types >=1.0.3 && <1.1+ , scientific >=0.3.6.2 && <0.4+ , vector >=0.12.0.1 && <0.13+ if !impl(ghc >= 8.0) Build-depends:- semigroups >=0.18.2+ semigroups >=0.18.5 && <0.19 if !impl(ghc >= 7.6) Build-depends:@@ -104,12 +114,12 @@ source-repository head type: git- location: http://github.com/lpsmith/postgresql-simple+ location: http://github.com/phadej/postgresql-simple source-repository this type: git- location: http://github.com/hackage-trustees/postgresql-simple- tag: v0.5.4.0+ location: http://github.com/phadej/postgresql-simple+ tag: v0.6 test-suite test default-language: Haskell2010@@ -148,7 +158,19 @@ , text , time , vector+ , case-insensitive if !impl(ghc >= 7.6) build-depends: ghc-prim++benchmark select+ default-language: Haskell2010+ type: exitcode-stdio-1.0++ hs-source-dirs: bench+ main-is: Select.hs++ build-depends: base+ , postgresql-simple+ , vector
src/Database/PostgreSQL/Simple.hs view
@@ -355,6 +355,7 @@ returning :: (ToRow q, FromRow r) => Connection -> Query -> [q] -> IO [r] returning = returningWith fromRow +-- | A version of 'returning' taking parser as argument returningWith :: (ToRow q) => RowParser r -> Connection -> Query -> [q] -> IO [r] returningWith _ _ _ [] = return [] returningWith parser conn q qs = do
src/Database/PostgreSQL/Simple/FromField.hs view
@@ -550,17 +550,21 @@ Nothing -> returnError ConversionFailed f "Invalid UUID" Just uuid -> pure uuid --- | json+-- | json, jsonb instance FromField JSON.Value where- fromField f mbs =+ fromField f mbs = parse =<< fromFieldJSONByteString f mbs+ where parse bs = case parseOnly (JSON.value' <* endOfInput) bs of+ Left err -> returnError ConversionFailed f err+ Right val -> pure val++-- | Return the JSON ByteString directly+fromFieldJSONByteString :: Field -> Maybe ByteString -> Conversion ByteString+fromFieldJSONByteString f mbs = if typeOid f /= $(inlineTypoid TI.json) && typeOid f /= $(inlineTypoid TI.jsonb) then returnError Incompatible f "" else case mbs of Nothing -> returnError UnexpectedNull f ""- Just bs ->- case parseOnly (JSON.value' <* endOfInput) bs of- Left err -> returnError ConversionFailed f err- Right val -> pure val+ Just bs -> pure bs -- | Parse a field to a JSON 'JSON.Value' and convert that into a -- Haskell value using 'JSON.fromJSON'.
src/Database/PostgreSQL/Simple/FromRow.hs view
@@ -238,6 +238,196 @@ null *> null *> null *> null *> null *> pure Nothing) <|> (Just <$> fromRow) +instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k) =>+ FromRow (a,b,c,d,e,f,g,h,i,j,k) where+ fromRow = (,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field+ <*> field <*> field <*> field <*> field <*> field+ <*> field++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k) =>+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k)) where+ fromRow = (null *> null *> null *> null *> null *>+ null *> null *> null *> null *> null *>+ null *> pure Nothing)+ <|> (Just <$> fromRow)++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k, FromField l) =>+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l) where+ fromRow = (,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field+ <*> field <*> field <*> field <*> field <*> field+ <*> field <*> field++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k, FromField l) =>+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l)) where+ fromRow = (null *> null *> null *> null *> null *>+ null *> null *> null *> null *> null *>+ null *> null *> pure Nothing)+ <|> (Just <$> fromRow)++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k, FromField l, FromField m) =>+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m) where+ fromRow = (,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field+ <*> field <*> field <*> field <*> field <*> field+ <*> field <*> field <*> field++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k, FromField l, FromField m) =>+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m)) where+ fromRow = (null *> null *> null *> null *> null *>+ null *> null *> null *> null *> null *>+ null *> null *> null *> pure Nothing)+ <|> (Just <$> fromRow)++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k, FromField l, FromField m, FromField n) =>+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where+ fromRow = (,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field+ <*> field <*> field <*> field <*> field <*> field+ <*> field <*> field <*> field <*> field++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k, FromField l, FromField m, FromField n) =>+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n)) where+ fromRow = (null *> null *> null *> null *> null *>+ null *> null *> null *> null *> null *>+ null *> null *> null *> null *> pure Nothing)+ <|> (Just <$> fromRow)++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k, FromField l, FromField m, FromField n, FromField o) =>+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where+ fromRow = (,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field+ <*> field <*> field <*> field <*> field <*> field+ <*> field <*> field <*> field <*> field <*> field++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k, FromField l, FromField m, FromField n, FromField o) =>+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)) where+ fromRow = (null *> null *> null *> null *> null *>+ null *> null *> null *> null *> null *>+ null *> null *> null *> null *> null *> pure Nothing)+ <|> (Just <$> fromRow)++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k, FromField l, FromField m, FromField n, FromField o,+ FromField p) =>+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) where+ fromRow = (,,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field+ <*> field <*> field <*> field <*> field <*> field+ <*> field <*> field <*> field <*> field <*> field+ <*> field++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k, FromField l, FromField m, FromField n, FromField o,+ FromField p) =>+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p)) where+ fromRow = (null *> null *> null *> null *> null *>+ null *> null *> null *> null *> null *>+ null *> null *> null *> null *> null *>+ null *> pure Nothing)+ <|> (Just <$> fromRow)++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k, FromField l, FromField m, FromField n, FromField o,+ FromField p, FromField q) =>+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) where+ fromRow = (,,,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field+ <*> field <*> field <*> field <*> field <*> field+ <*> field <*> field <*> field <*> field <*> field+ <*> field <*> field++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k, FromField l, FromField m, FromField n, FromField o,+ FromField p, FromField q) =>+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q)) where+ fromRow = (null *> null *> null *> null *> null *>+ null *> null *> null *> null *> null *>+ null *> null *> null *> null *> null *>+ null *> null *> pure Nothing)+ <|> (Just <$> fromRow)++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k, FromField l, FromField m, FromField n, FromField o,+ FromField p, FromField q, FromField r) =>+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) where+ fromRow = (,,,,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field+ <*> field <*> field <*> field <*> field <*> field+ <*> field <*> field <*> field <*> field <*> field+ <*> field <*> field <*> field++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k, FromField l, FromField m, FromField n, FromField o,+ FromField p, FromField q, FromField r) =>+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r)) where+ fromRow = (null *> null *> null *> null *> null *>+ null *> null *> null *> null *> null *>+ null *> null *> null *> null *> null *>+ null *> null *> null *> pure Nothing)+ <|> (Just <$> fromRow)++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k, FromField l, FromField m, FromField n, FromField o,+ FromField p, FromField q, FromField r, FromField s) =>+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) where+ fromRow = (,,,,,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field+ <*> field <*> field <*> field <*> field <*> field+ <*> field <*> field <*> field <*> field <*> field+ <*> field <*> field <*> field <*> field++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k, FromField l, FromField m, FromField n, FromField o,+ FromField p, FromField q, FromField r, FromField s) =>+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s)) where+ fromRow = (null *> null *> null *> null *> null *>+ null *> null *> null *> null *> null *>+ null *> null *> null *> null *> null *>+ null *> null *> null *> null *> pure Nothing)+ <|> (Just <$> fromRow)++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k, FromField l, FromField m, FromField n, FromField o,+ FromField p, FromField q, FromField r, FromField s, FromField t) =>+ FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) where+ fromRow = (,,,,,,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field+ <*> field <*> field <*> field <*> field <*> field+ <*> field <*> field <*> field <*> field <*> field+ <*> field <*> field <*> field <*> field <*> field++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k, FromField l, FromField m, FromField n, FromField o,+ FromField p, FromField q, FromField r, FromField s, FromField t) =>+ FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t)) where+ fromRow = (null *> null *> null *> null *> null *>+ null *> null *> null *> null *> null *>+ null *> null *> null *> null *> null *>+ null *> null *> null *> null *> null *> pure Nothing)+ <|> (Just <$> fromRow)+ instance FromField a => FromRow [a] where fromRow = do n <- numFieldsRemaining
src/Database/PostgreSQL/Simple/Internal.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP, BangPatterns, DoAndIfThenElse, RecordWildCards #-}-{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} ------------------------------------------------------------------------------ -- |@@ -50,6 +51,7 @@ import Control.Monad.Trans.State.Strict import Control.Monad.Trans.Reader import Control.Monad.Trans.Class+import GHC.Generics import GHC.IO.Exception #if !defined(mingw32_HOST_OS) import Control.Concurrent(threadWaitRead, threadWaitWrite)@@ -119,7 +121,7 @@ , connectUser :: String , connectPassword :: String , connectDatabase :: String- } deriving (Eq,Read,Show,Typeable)+ } deriving (Generic,Eq,Read,Show,Typeable) -- | Default information for setting up a connection. --@@ -188,7 +190,8 @@ -- -- Omitting @password@ will default to an appropriate password found -- in the @pgpass@ file, or no password at all if a matching line is--- not found. See+-- not found. The path of the @pgpass@ file may be specified by setting+-- the @PGPASSFILE@ environment variable. See -- <https://www.postgresql.org/docs/9.5/static/libpq-pgpass.html> for -- more information regarding this file. --
src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hs view
@@ -14,11 +14,14 @@ module Database.PostgreSQL.Simple.Internal.PQResultUtils ( finishQueryWith+ , finishQueryWithV+ , finishQueryWithVU , getRowWith ) where import Control.Exception as E import Data.ByteString (ByteString)+import Data.Foldable (for_) import Database.PostgreSQL.Simple.FromField (ResultError(..)) import Database.PostgreSQL.Simple.Ok import Database.PostgreSQL.Simple.Types (Query(..))@@ -26,18 +29,49 @@ import Database.PostgreSQL.Simple.TypeInfo import qualified Database.PostgreSQL.LibPQ as PQ import qualified Data.ByteString.Char8 as B+import qualified Data.Vector as V+import qualified Data.Vector.Mutable as MV+import qualified Data.Vector.Unboxed as VU+import qualified Data.Vector.Unboxed.Mutable as MVU import Control.Monad.Trans.Reader import Control.Monad.Trans.State.Strict finishQueryWith :: RowParser r -> Connection -> Query -> PQ.Result -> IO [r]-finishQueryWith parser conn q result = do+finishQueryWith parser conn q result = finishQueryWith' q result $ do+ nrows <- PQ.ntuples result+ ncols <- PQ.nfields result+ forM' 0 (nrows-1) $ \row ->+ getRowWith parser row ncols conn result++finishQueryWithV :: RowParser r -> Connection -> Query -> PQ.Result -> IO (V.Vector r)+finishQueryWithV parser conn q result = finishQueryWith' q result $ do+ nrows <- PQ.ntuples result+ let PQ.Row nrows' = nrows+ ncols <- PQ.nfields result+ mv <- MV.unsafeNew (fromIntegral nrows')+ for_ [ 0 .. nrows-1 ] $ \row -> do+ let PQ.Row row' = row+ value <- getRowWith parser row ncols conn result+ MV.unsafeWrite mv (fromIntegral row') value+ V.unsafeFreeze mv++finishQueryWithVU :: VU.Unbox r => RowParser r -> Connection -> Query -> PQ.Result -> IO (VU.Vector r)+finishQueryWithVU parser conn q result = finishQueryWith' q result $ do+ nrows <- PQ.ntuples result+ let PQ.Row nrows' = nrows+ ncols <- PQ.nfields result+ mv <- MVU.unsafeNew (fromIntegral nrows')+ for_ [ 0 .. nrows-1 ] $ \row -> do+ let PQ.Row row' = row+ value <- getRowWith parser row ncols conn result+ MVU.unsafeWrite mv (fromIntegral row') value+ VU.unsafeFreeze mv++finishQueryWith' :: Query -> PQ.Result -> IO a -> IO a+finishQueryWith' q result k = do status <- PQ.resultStatus result case status of- PQ.TuplesOk -> do- nrows <- PQ.ntuples result- ncols <- PQ.nfields result- forM' 0 (nrows-1) $ \row ->- getRowWith parser row ncols conn result+ PQ.TuplesOk -> k PQ.EmptyQuery -> queryErr "query: Empty query" PQ.CommandOk -> queryErr "query resulted in a command response" PQ.CopyOut -> queryErr "query: COPY TO is not supported"
src/Database/PostgreSQL/Simple/Range.hs view
@@ -19,6 +19,7 @@ , empty , isEmpty, isEmptyBy , contains, containsBy+ , fromFieldRange ) where import Control.Applicative hiding (empty)@@ -189,7 +190,10 @@ instance (FromField a, Typeable a) => FromField (PGRange a) where- fromField f mdat = do+ fromField = fromFieldRange fromField++fromFieldRange :: Typeable a => FieldParser a -> FieldParser (PGRange a)+fromFieldRange fromField' f mdat = do info <- typeInfo f case info of Range{} ->@@ -199,8 +203,8 @@ Just "empty" -> pure $ empty Just bs -> let parseIt NegInfinity = pure NegInfinity- parseIt (Inclusive v) = Inclusive <$> fromField f' (Just v)- parseIt (Exclusive v) = Exclusive <$> fromField f' (Just v)+ parseIt (Inclusive v) = Inclusive <$> fromField' f' (Just v)+ parseIt (Exclusive v) = Exclusive <$> fromField' f' (Just v) parseIt PosInfinity = pure PosInfinity in case parseOnly pgrange bs of Left e -> returnError ConversionFailed f e
src/Database/PostgreSQL/Simple/Time/Internal/Printer.hs view
@@ -71,7 +71,7 @@ year :: BoundedPrim Int32-year = condB (> 10000) int32Dec (checkBCE >$< liftB digits4)+year = condB (>= 10000) int32Dec (checkBCE >$< liftB digits4) where checkBCE :: Int32 -> Int checkBCE y
src/Database/PostgreSQL/Simple/ToField.hs view
@@ -42,6 +42,8 @@ import qualified Data.ByteString as SB import qualified Data.ByteString.Lazy as LB+import Data.CaseInsensitive (CI)+import qualified Data.CaseInsensitive as CI import qualified Data.Text as ST import qualified Data.Text.Encoding as ST import qualified Data.Text.Lazy as LT@@ -230,6 +232,15 @@ toField = toField . LT.toStrict {-# INLINE toField #-} +-- | citext+instance ToField (CI ST.Text) where+ toField = toField . CI.original+ {-# INLINE toField #-}++-- | citext+instance ToField (CI LT.Text) where+ toField = toField . LT.toStrict . CI.original+ {-# INLINE toField #-} instance ToField UTCTime where toField = Plain . inQuotes . utcTimeToBuilder
src/Database/PostgreSQL/Simple/ToRow.hs view
@@ -89,6 +89,96 @@ [toField a, toField b, toField c, toField d, toField e, toField f, toField g, toField h, toField i, toField j] +instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,+ ToField g, ToField h, ToField i, ToField j, ToField k)+ => ToRow (a,b,c,d,e,f,g,h,i,j,k) where+ toRow (a,b,c,d,e,f,g,h,i,j,k) =+ [toField a, toField b, toField c, toField d, toField e, toField f,+ toField g, toField h, toField i, toField j, toField k]++instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,+ ToField g, ToField h, ToField i, ToField j, ToField k, ToField l)+ => ToRow (a,b,c,d,e,f,g,h,i,j,k,l) where+ toRow (a,b,c,d,e,f,g,h,i,j,k,l) =+ [toField a, toField b, toField c, toField d, toField e, toField f,+ toField g, toField h, toField i, toField j, toField k, toField l]++instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,+ ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,+ ToField m)+ => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m) where+ toRow (a,b,c,d,e,f,g,h,i,j,k,l,m) =+ [toField a, toField b, toField c, toField d, toField e, toField f,+ toField g, toField h, toField i, toField j, toField k, toField l,+ toField m]++instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,+ ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,+ ToField m, ToField n)+ => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where+ toRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n) =+ [toField a, toField b, toField c, toField d, toField e, toField f,+ toField g, toField h, toField i, toField j, toField k, toField l,+ toField m, toField n]++instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,+ ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,+ ToField m, ToField n, ToField o)+ => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where+ toRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) =+ [toField a, toField b, toField c, toField d, toField e, toField f,+ toField g, toField h, toField i, toField j, toField k, toField l,+ toField m, toField n, toField o]++instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,+ ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,+ ToField m, ToField n, ToField o, ToField p)+ => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) where+ toRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) =+ [toField a, toField b, toField c, toField d, toField e, toField f,+ toField g, toField h, toField i, toField j, toField k, toField l,+ toField m, toField n, toField o, toField p]++instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,+ ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,+ ToField m, ToField n, ToField o, ToField p, ToField q)+ => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) where+ toRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) =+ [toField a, toField b, toField c, toField d, toField e, toField f,+ toField g, toField h, toField i, toField j, toField k, toField l,+ toField m, toField n, toField o, toField p, toField q]++instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,+ ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,+ ToField m, ToField n, ToField o, ToField p, ToField q, ToField r)+ => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) where+ toRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) =+ [toField a, toField b, toField c, toField d, toField e, toField f,+ toField g, toField h, toField i, toField j, toField k, toField l,+ toField m, toField n, toField o, toField p, toField q, toField r]++instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,+ ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,+ ToField m, ToField n, ToField o, ToField p, ToField q, ToField r,+ ToField s)+ => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) where+ toRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) =+ [toField a, toField b, toField c, toField d, toField e, toField f,+ toField g, toField h, toField i, toField j, toField k, toField l,+ toField m, toField n, toField o, toField p, toField q, toField r,+ toField s]++instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,+ ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,+ ToField m, ToField n, ToField o, ToField p, ToField q, ToField r,+ ToField s, ToField t)+ => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) where+ toRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) =+ [toField a, toField b, toField c, toField d, toField e, toField f,+ toField g, toField h, toField i, toField j, toField k, toField l,+ toField m, toField n, toField o, toField p, toField q, toField r,+ toField s, toField t]+ instance (ToField a) => ToRow [a] where toRow = map toField
src/Database/PostgreSQL/Simple/Transaction.hs view
@@ -176,7 +176,7 @@ -- | Rollback a transaction. rollback :: Connection -> IO ()-rollback conn = execute_ conn "ABORT" >> return ()+rollback conn = execute_ conn "ROLLBACK" >> return () -- | Rollback a transaction, ignoring any @IOErrors@ rollback_ :: Connection -> IO ()
src/Database/PostgreSQL/Simple/Types.hs view
@@ -42,6 +42,7 @@ import qualified Data.ByteString as B import Data.Text (Text) import qualified Data.Text as T+import Data.Tuple.Only (Only(..)) import Database.PostgreSQL.LibPQ (Oid(..)) import Database.PostgreSQL.Simple.Compat (toByteString) @@ -99,23 +100,6 @@ #if !(MIN_VERSION_base(4,11,0)) mappend = (<>) #endif---- | A single-value \"collection\".------ This is useful if you need to supply a single parameter to a SQL--- query, or extract a single column from a SQL result.------ Parameter example:------ @query c \"select x from scores where x > ?\" ('Only' (42::Int))@------ Result example:------ @xs <- query_ c \"select id from users\"---forM_ xs $ \\('Only' id) -> {- ... -}@-newtype Only a = Only {- fromOnly :: a- } deriving (Eq, Ord, Read, Show, Typeable, Functor) -- | Wrap a list of values for use in an @IN@ clause. Replaces a -- single \"@?@\" character with a parenthesized list of rendered
+ src/Database/PostgreSQL/Simple/Vector.hs view
@@ -0,0 +1,45 @@+-- | 'query' variants returning 'V.Vector'.+module Database.PostgreSQL.Simple.Vector where++import Database.PostgreSQL.Simple (Connection, formatQuery, formatMany)+import Database.PostgreSQL.Simple.FromRow (FromRow(..))+import Database.PostgreSQL.Simple.ToRow (ToRow(..))+import Database.PostgreSQL.Simple.Internal (RowParser, exec)+import Database.PostgreSQL.Simple.Internal.PQResultUtils+import Database.PostgreSQL.Simple.Types ( Query (..) )++import qualified Data.Vector as V++-- | Perform a @SELECT@ or other SQL query that is expected to return+-- results. All results are retrieved and converted before this+-- function returns.+query :: (ToRow q, FromRow r) => Connection -> Query -> q -> IO (V.Vector r)+query = queryWith fromRow++-- | A version of 'query' that does not perform query substitution.+query_ :: (FromRow r) => Connection -> Query -> IO (V.Vector r)+query_ = queryWith_ fromRow++-- | A version of 'query' taking parser as argument+queryWith :: ToRow q => RowParser r -> Connection -> Query -> q -> IO (V.Vector r)+queryWith parser conn template qs = do+ result <- exec conn =<< formatQuery conn template qs+ finishQueryWithV parser conn template result++-- | A version of 'query_' taking parser as argument+queryWith_ :: RowParser r -> Connection -> Query -> IO (V.Vector r)+queryWith_ parser conn q@(Query que) = do+ result <- exec conn que+ finishQueryWithV parser conn q result++-- | Execute @INSERT ... RETURNING@, @UPDATE ... RETURNING@, or other SQL+-- query that accepts multi-row input and is expected to return results.+returning :: (ToRow q, FromRow r) => Connection -> Query -> [q] -> IO (V.Vector r)+returning = returningWith fromRow++-- | A version of 'returning' taking parser as argument+returningWith :: (ToRow q) => RowParser r -> Connection -> Query -> [q] -> IO (V.Vector r)+returningWith _ _ _ [] = return V.empty+returningWith parser conn q qs = do+ result <- exec conn =<< formatMany conn q qs+ finishQueryWithV parser conn q result
+ src/Database/PostgreSQL/Simple/Vector/Unboxed.hs view
@@ -0,0 +1,44 @@+module Database.PostgreSQL.Simple.Vector.Unboxed where++import Database.PostgreSQL.Simple (Connection, formatQuery, formatMany)+import Database.PostgreSQL.Simple.FromRow (FromRow(..))+import Database.PostgreSQL.Simple.ToRow (ToRow(..))+import Database.PostgreSQL.Simple.Internal (RowParser, exec)+import Database.PostgreSQL.Simple.Internal.PQResultUtils+import Database.PostgreSQL.Simple.Types ( Query (..) )++import qualified Data.Vector.Unboxed as VU++-- | Perform a @SELECT@ or other SQL query that is expected to return+-- results. All results are retrieved and converted before this+-- function returns.+query :: (ToRow q, FromRow r, VU.Unbox r) => Connection -> Query -> q -> IO (VU.Vector r)+query = queryWith fromRow++-- | A version of 'query' that does not perform query substitution.+query_ :: (FromRow r, VU.Unbox r) => Connection -> Query -> IO (VU.Vector r)+query_ = queryWith_ fromRow++-- | A version of 'query' taking parser as argument+queryWith :: (ToRow q, VU.Unbox r) => RowParser r -> Connection -> Query -> q -> IO (VU.Vector r)+queryWith parser conn template qs = do+ result <- exec conn =<< formatQuery conn template qs+ finishQueryWithVU parser conn template result++-- | A version of 'query_' taking parser as argument+queryWith_ :: VU.Unbox r => RowParser r -> Connection -> Query -> IO (VU.Vector r)+queryWith_ parser conn q@(Query que) = do+ result <- exec conn que+ finishQueryWithVU parser conn q result++-- | Execute @INSERT ... RETURNING@, @UPDATE ... RETURNING@, or other SQL+-- query that accepts multi-row input and is expected to return results.+returning :: (ToRow q, FromRow r, VU.Unbox r) => Connection -> Query -> [q] -> IO (VU.Vector r)+returning = returningWith fromRow++-- | A version of 'returning' taking parser as argument+returningWith :: (ToRow q, VU.Unbox r) => RowParser r -> Connection -> Query -> [q] -> IO (VU.Vector r)+returningWith _ _ _ [] = return VU.empty+returningWith parser conn q qs = do+ result <- exec conn =<< formatMany conn q qs+ finishQueryWithVU parser conn q result
test/Main.hs view
@@ -23,6 +23,8 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy.Char8 as BL+import Data.CaseInsensitive (CI)+import qualified Data.CaseInsensitive as CI import Data.Map (Map) import qualified Data.Map as Map import Data.Text(Text)@@ -50,6 +52,7 @@ , testCase "Array" . testArray , testCase "Array of nullables" . testNullableArray , testCase "HStore" . testHStore+ , testCase "citext" . testCIText , testCase "JSON" . testJSON , testCase "Savepoint" . testSavepoint , testCase "Unicode" . testUnicode@@ -202,6 +205,19 @@ let m = Only (HStoreMap (Map.fromList xs)) m' <- query conn "SELECT ?::hstore" m [m] @?= m'++testCIText :: TestEnv -> Assertion+testCIText TestEnv{..} = do+ execute_ conn "CREATE EXTENSION IF NOT EXISTS citext"+ roundTrip (CI.mk "")+ roundTrip (CI.mk "UPPERCASE")+ roundTrip (CI.mk "lowercase")+ where+ roundTrip :: (CI Text) -> Assertion+ roundTrip cit = do+ let toPostgres = Only cit+ fromPostgres <- query conn "SELECT ?::citext" toPostgres+ [toPostgres] @?= fromPostgres testJSON :: TestEnv -> Assertion testJSON TestEnv{..} = do