hasql-postgres 0.10.0 → 0.10.1
raw patch · 6 files changed
+76/−71 lines, 6 filesdep ~hashabledep ~hasqldep ~hasql-backendPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: hashable, hasql, hasql-backend
API changes (from Hackage documentation)
Files
- competition/Main.hs +14/−14
- hasql-postgres.cabal +6/−6
- hspec/Main.hs +41/−40
- library/Hasql/Postgres.hs +2/−2
- library/Hasql/Postgres/Session/Transaction.hs +6/−6
- library/Hasql/Postgres/Statement.hs +7/−3
competition/Main.hs view
@@ -37,17 +37,17 @@ pause hSession (HP.ParamSettings host port user password db) (fromJust $ H.poolSettings 1 30) $ do H.tx Nothing $ do- H.unitTx [H.stmt|DROP TABLE IF EXISTS a|]- H.unitTx [H.stmt|CREATE TABLE a (id SERIAL NOT NULL, + H.unitEx [H.stmt|DROP TABLE IF EXISTS a|]+ H.unitEx [H.stmt|CREATE TABLE a (id SERIAL NOT NULL, name VARCHAR NOT NULL, birthday DATE, PRIMARY KEY (id))|] forM_ rows $ \(name, birthday) -> do- H.unitTx $ [H.stmt|INSERT INTO a (name, birthday) VALUES (?, ?)|] name birthday+ H.unitEx $ [H.stmt|INSERT INTO a (name, birthday) VALUES (?, ?)|] name birthday lift $ continue replicateM_ 100 $ do r <- H.tx Nothing $ do- fmap toList $ H.vectorTx $ [H.stmt|SELECT * FROM a|] :: H.Tx HP.Postgres s [(Int, Text, Day)]+ fmap toList $ H.vectorEx $ [H.stmt|SELECT * FROM a|] :: H.Tx HP.Postgres s [(Int, Text, Day)] deepseq r $ return () lift $ pause @@ -113,15 +113,15 @@ pause hSession (HP.ParamSettings host port user password db) (fromJust $ H.poolSettings 1 30) $ do H.tx Nothing $ do- H.unitTx [H.stmt|DROP TABLE IF EXISTS a|]- H.unitTx [H.stmt|CREATE TABLE a (id SERIAL NOT NULL, + H.unitEx [H.stmt|DROP TABLE IF EXISTS a|]+ H.unitEx [H.stmt|CREATE TABLE a (id SERIAL NOT NULL, name VARCHAR NOT NULL, birthday DATE, PRIMARY KEY (id))|] lift $ continue replicateM_ 1000 $ do H.tx Nothing $ do- fmap toList $ H.vectorTx $ + fmap toList $ H.vectorEx $ [H.stmt|SELECT * FROM a WHERE id > ? AND id < ? AND birthday != ?|] (1000 :: Int) (0 :: Int) @@ -186,20 +186,20 @@ pause hSession (HP.ParamSettings host port user password db) (fromJust $ H.poolSettings 1 30) $ do H.tx Nothing $ do- H.unitTx [H.stmt|DROP TABLE IF EXISTS a|]- H.unitTx [H.stmt|CREATE TABLE a (id SERIAL NOT NULL, balance INT8, PRIMARY KEY (id))|]+ H.unitEx [H.stmt|DROP TABLE IF EXISTS a|]+ H.unitEx [H.stmt|CREATE TABLE a (id SERIAL NOT NULL, balance INT8, PRIMARY KEY (id))|] replicateM_ users $ do- H.unitTx [H.stmt|INSERT INTO a (balance) VALUES (0)|]+ H.unitEx [H.stmt|INSERT INTO a (balance) VALUES (0)|] lift $ continue forM_ transfers $ \(id1, id2) -> do H.tx (Just (H.Serializable, Just True)) $ do runMaybeT $ do do- Identity balance <- MaybeT $ H.maybeTx $ [H.stmt|SELECT balance FROM a WHERE id=?|] id1- lift $ H.unitTx $ [H.stmt|UPDATE a SET balance=? WHERE id=?|] (balance - amount) id1+ Identity balance <- MaybeT $ H.maybeEx $ [H.stmt|SELECT balance FROM a WHERE id=?|] id1+ lift $ H.unitEx $ [H.stmt|UPDATE a SET balance=? WHERE id=?|] (balance - amount) id1 do- Identity balance <- MaybeT $ H.maybeTx $ [H.stmt|SELECT balance FROM a WHERE id=?|] id2- lift $ H.unitTx $ [H.stmt|UPDATE a SET balance=? WHERE id=?|] (balance + amount) id2+ Identity balance <- MaybeT $ H.maybeEx $ [H.stmt|SELECT balance FROM a WHERE id=?|] id2+ lift $ H.unitEx $ [H.stmt|UPDATE a SET balance=? WHERE id=?|] (balance + amount) id2 lift $ pause subject "postgresql-simple" $ do
hasql-postgres.cabal view
@@ -1,7 +1,7 @@ name: hasql-postgres version:- 0.10.0+ 0.10.1 synopsis: A "PostgreSQL" backend for the "hasql" library description:@@ -77,7 +77,7 @@ -- parsers: attoparsec >= 0.10 && < 0.13, -- database:- hasql-backend == 0.3.*,+ hasql-backend == 0.4.*, postgresql-binary == 0.5.*, postgresql-libpq == 0.9.*, -- data:@@ -88,7 +88,7 @@ scientific >= 0.2 && < 0.4, text >= 1 && < 1.3, bytestring >= 0.10 && < 0.11,- hashable >= 1.1 && < 1.3,+ hashable >= 1.2 && < 1.3, -- control: free >= 4.6 && < 5, either >= 4.3 && < 4.4,@@ -144,7 +144,7 @@ postgresql-binary, hasql-postgres, hasql-backend,- hasql == 0.6.*,+ hasql == 0.7.*, -- testing: hspec == 2.1.*, quickcheck-instances == 0.3.*,@@ -156,7 +156,7 @@ scientific >= 0.2 && < 0.4, text >= 1 && < 1.3, bytestring >= 0.10 && < 0.11,- hashable >= 1.1 && < 1.3,+ hashable >= 1.2 && < 1.3, -- general: either, list-t < 0.5,@@ -187,7 +187,7 @@ postgresql-simple == 0.4.*, hasql-postgres, hasql-backend,- hasql == 0.6.*,+ hasql == 0.7.*, -- random: QuickCheck == 2.7.*, quickcheck-instances == 0.3.*,
hspec/Main.hs view
@@ -1,8 +1,9 @@ module Main where -import BasePrelude hiding (assert)+import BasePrelude hiding (assert, isRight, isLeft) import MTLPrelude import Control.Monad.Trans.Either+import Data.Either.Combinators import Test.Hspec import Test.QuickCheck import Test.QuickCheck.Instances@@ -39,7 +40,7 @@ in do r <- session backendSettings poolSettings $ do- H.tx Nothing $ H.unitTx [H.stmt|DROP TABLE IF EXISTS a|]+ H.tx Nothing $ H.unitEx [H.stmt|DROP TABLE IF EXISTS a|] shouldSatisfy r $ \case Left (H.CxError _) -> True _ -> False@@ -48,42 +49,42 @@ flip shouldSatisfy isRight =<< do session1 $ do liftIO . (flip shouldBe) (Just (Identity ("abc" :: Text))) =<< do - H.tx Nothing $ H.maybeTx $ [H.stmt|SELECT ?|] ("abc" :: Text)+ H.tx Nothing $ H.maybeEx $ [H.stmt|SELECT ?|] ("abc" :: Text) liftIO . (flip shouldBe) (Just (Identity True)) =<< do - H.tx Nothing $ H.maybeTx $ [H.stmt|SELECT ?|] True+ H.tx Nothing $ H.maybeEx $ [H.stmt|SELECT ?|] True it "rendering" $ do let rows = [("A", 34525), ("B", 324987)] :: [(Text, Int)] (flip shouldBe) (Right $ Just $ head rows) =<< do session1 $ do H.tx Nothing $ do- H.unitTx [H.stmt|DROP TABLE IF EXISTS a|]- H.unitTx [H.stmt|CREATE TABLE a (id SERIAL NOT NULL, + H.unitEx [H.stmt|DROP TABLE IF EXISTS a|]+ H.unitEx [H.stmt|CREATE TABLE a (id SERIAL NOT NULL, name VARCHAR NOT NULL, birthday INT8, PRIMARY KEY (id))|] forM_ rows $ \(name, birthday) -> do- H.unitTx $ [H.stmt|INSERT INTO a (name, birthday) VALUES (?, ?)|] name birthday+ H.unitEx $ [H.stmt|INSERT INTO a (name, birthday) VALUES (?, ?)|] name birthday H.tx Nothing $ do- H.maybeTx $ [H.stmt|SELECT name, birthday FROM a WHERE id = ? |] (1 :: Int)+ H.maybeEx $ [H.stmt|SELECT name, birthday FROM a WHERE id = ? |] (1 :: Int) it "countEffects" $ do (flip shouldBe) (Right 100) =<< do session1 $ do H.tx Nothing $ do- H.unitTx [H.stmt|DROP TABLE IF EXISTS a|]- H.unitTx [H.stmt|CREATE TABLE a (id SERIAL NOT NULL, name VARCHAR NOT NULL)|]+ H.unitEx [H.stmt|DROP TABLE IF EXISTS a|]+ H.unitEx [H.stmt|CREATE TABLE a (id SERIAL NOT NULL, name VARCHAR NOT NULL)|] replicateM_ 100 $ do- H.unitTx [H.stmt|INSERT INTO a (name) VALUES ('a')|]- H.countTx [H.stmt|DELETE FROM a|]+ H.unitEx [H.stmt|INSERT INTO a (name) VALUES ('a')|]+ H.countEx [H.stmt|DELETE FROM a|] it "autoIncrement" $ do (flip shouldBe) (Right (Just (1 :: Word64), Just (2 :: Word64))) =<< do session1 $ H.tx Nothing $ do- H.unitTx [H.stmt|DROP TABLE IF EXISTS a|]- H.unitTx [H.stmt|CREATE TABLE a (id SERIAL NOT NULL, v INT8, PRIMARY KEY (id))|]- id1 <- (fmap . fmap) runIdentity $ H.maybeTx $ [H.stmt|INSERT INTO a (v) VALUES (1) RETURNING id|]- id2 <- (fmap . fmap) runIdentity $ H.maybeTx $ [H.stmt|INSERT INTO a (v) VALUES (2) RETURNING id|]+ H.unitEx [H.stmt|DROP TABLE IF EXISTS a|]+ H.unitEx [H.stmt|CREATE TABLE a (id SERIAL NOT NULL, v INT8, PRIMARY KEY (id))|]+ id1 <- (fmap . fmap) runIdentity $ H.maybeEx $ [H.stmt|INSERT INTO a (v) VALUES (1) RETURNING id|]+ id2 <- (fmap . fmap) runIdentity $ H.maybeEx $ [H.stmt|INSERT INTO a (v) VALUES (2) RETURNING id|] return (id1, id2) it "cursorResultsOrder" $ do@@ -91,23 +92,23 @@ session1 $ do H.tx (Just (H.ReadCommitted, Nothing)) $ do ListT.toList . fmap runIdentity =<< do - H.streamTx $ [H.stmt|select oid from pg_type ORDER BY oid|]+ H.streamEx 256 $ [H.stmt|select oid from pg_type ORDER BY oid|] it "cursor" $ do flip shouldSatisfy isRight =<< do session1 $ do r :: [(Word, Text)] <- H.tx (Just (H.ReadCommitted, Nothing)) $ do- ListT.toList =<< do H.streamTx $ [H.stmt|select oid, typname from pg_type|]+ ListT.toList =<< do H.streamEx 256 $ [H.stmt|select oid, typname from pg_type|] r' :: [(Word, Text)] <- H.tx (Just (H.ReadCommitted, Nothing)) $ do- fmap toList $ H.vectorTx $ [H.stmt|select oid, typname from pg_type|]+ fmap toList $ H.vectorEx $ [H.stmt|select oid, typname from pg_type|] liftIO $ (flip shouldBe) r' r it "select" $ do (flip shouldSatisfy) (either (const False) (not . null)) =<< do session1 $ do- fmap toList $ H.tx Nothing $ H.vectorTx $ + fmap toList $ H.tx Nothing $ H.vectorEx $ [H.stmt|select oid, typname from pg_type|] :: Session [(Word, Text)] describe "Mapping of" $ do@@ -118,10 +119,10 @@ flip shouldSatisfy isRight =<< do session1 $ do H.tx Nothing $ do- H.unitTx [H.stmt| DROP TYPE IF EXISTS mood |]- H.unitTx [H.stmt| CREATE TYPE mood AS ENUM ('sad', 'ok', 'happy') |]+ H.unitEx [H.stmt| DROP TYPE IF EXISTS mood |]+ H.unitEx [H.stmt| CREATE TYPE mood AS ENUM ('sad', 'ok', 'happy') |] liftIO . (flip shouldBe) (Just (Identity ("ok" :: Text))) =<< do - H.tx Nothing $ H.maybeTx $ [H.stmt|SELECT (? :: mood)|] ("ok" :: Text)+ H.tx Nothing $ H.maybeEx $ [H.stmt|SELECT (? :: mood)|] ("ok" :: Text) describe "Unknown" $ do @@ -129,40 +130,40 @@ flip shouldSatisfy isRight =<< do session1 $ do H.tx Nothing $ do- H.unitTx [H.stmt| DROP TABLE IF EXISTS a |]- H.unitTx [H.stmt| DROP TYPE IF EXISTS mood |]- H.unitTx [H.stmt| CREATE TYPE mood AS ENUM ('sad', 'ok', 'happy') |]- H.unitTx [H.stmt| CREATE TABLE a (id SERIAL NOT NULL, + H.unitEx [H.stmt| DROP TABLE IF EXISTS a |]+ H.unitEx [H.stmt| DROP TYPE IF EXISTS mood |]+ H.unitEx [H.stmt| CREATE TYPE mood AS ENUM ('sad', 'ok', 'happy') |]+ H.unitEx [H.stmt| CREATE TABLE a (id SERIAL NOT NULL, mood mood NOT NULL, PRIMARY KEY (id)) |]- H.unitTx $ [H.stmt| INSERT INTO a (mood) VALUES (?) |] (HP.Unknown "ok")- H.unitTx $ [H.stmt| INSERT INTO a (mood) VALUES (?) |] (HP.Unknown "ok")- H.unitTx $ [H.stmt| INSERT INTO a (mood) VALUES (?) |] (HP.Unknown "happy")+ H.unitEx $ [H.stmt| INSERT INTO a (mood) VALUES (?) |] (HP.Unknown "ok")+ H.unitEx $ [H.stmt| INSERT INTO a (mood) VALUES (?) |] (HP.Unknown "ok")+ H.unitEx $ [H.stmt| INSERT INTO a (mood) VALUES (?) |] (HP.Unknown "happy") liftIO . (flip shouldBe) ([1, 2] :: [Int]) . fmap runIdentity =<< do - H.tx Nothing $ fmap toList $ H.vectorTx $ + H.tx Nothing $ fmap toList $ H.vectorEx $ [H.stmt|SELECT id FROM a WHERE mood = ?|] (HP.Unknown "ok") it "encodes Int64 into \"int8\" using a \"postgresql-binary\" encoder" $ do flip shouldSatisfy isRight =<< do- session1 $ H.tx Nothing $ H.unitTx $+ session1 $ H.tx Nothing $ H.unitEx $ [H.stmt| SELECT (? :: int8) |] (HP.Unknown . PBE.int8 . Left $ 12345) it "does not encode Int64 into \"int4\" using a \"postgresql-binary\" encoder" $ do flip shouldSatisfy (\case Left (H.TxError _) -> True; _ -> False) =<< do- session1 $ H.tx Nothing $ H.unitTx $+ session1 $ H.tx Nothing $ H.unitEx $ [H.stmt| SELECT (? :: int4)|] (HP.Unknown . PBE.int8 . Left $ 12345) it "encodes Int64 into \"int8\" using a \"postgresql-binary\" encoder" $ do flip shouldSatisfy isRight =<< do- session1 $ H.tx Nothing $ H.unitTx $+ session1 $ H.tx Nothing $ H.unitEx $ [H.stmt| SELECT (? :: int8) |] (HP.Unknown . PBE.int8 . Left $ 12345) it "encodes Day into \"date\" using a \"postgresql-binary\" encoder" $ do flip shouldSatisfy isRight =<< do- session1 $ H.tx Nothing $ H.unitTx $+ session1 $ H.tx Nothing $ H.unitEx $ [H.stmt| SELECT (? :: date) |] (HP.Unknown . PBE.date $ (read "1900-01-01" :: Day)) @@ -207,10 +208,10 @@ ] (flip shouldBe) (Right (Just (Identity v1))) =<< do session1 $ H.tx Nothing $ do- H.unitTx $ [H.stmt|DROP TABLE IF EXISTS a|]- H.unitTx $ [H.stmt|CREATE TABLE a ("v" char[][])|]- H.unitTx $ [H.stmt|INSERT INTO a (v) VALUES (?)|] v1- H.maybeTx $ [H.stmt|SELECT v FROM a|]+ H.unitEx $ [H.stmt|DROP TABLE IF EXISTS a|]+ H.unitEx $ [H.stmt|CREATE TABLE a ("v" char[][])|]+ H.unitEx $ [H.stmt|INSERT INTO a (v) VALUES (?)|] v1+ H.maybeEx $ [H.stmt|SELECT v FROM a|] it "5" $ do flip shouldSatisfy isRight =<< do@@ -263,7 +264,7 @@ Backend.CxValue HP.Postgres a => a -> Session (Maybe a) selectSelf v =- H.tx Nothing $ (fmap . fmap) runIdentity $ H.maybeTx $ [H.stmt| SELECT ? |] v+ H.tx Nothing $ (fmap . fmap) runIdentity $ H.maybeEx $ [H.stmt| SELECT ? |] v session1 :: Session r -> IO (Either (H.SessionError HP.Postgres) r) session1 =
library/Hasql/Postgres.hs view
@@ -181,9 +181,9 @@ asks $ \p -> (fmap . fmap) (ResultValue (mappingEnv p)) $ r next r'- Bknd.StreamTx stmt next -> do+ Bknd.StreamTx batching stmt next -> do stmt' <- convertStatement stmt- r <- liftTransaction $ Transaction.streamWithCursor stmt'+ r <- liftTransaction $ Transaction.streamWithCursor batching stmt' r' <- asks $ \p -> (fmap . fmap) (ResultValue (mappingEnv p)) $
library/Hasql/Postgres/Session/Transaction.hs view
@@ -73,11 +73,11 @@ Execution.statement (Statement.declareCursor name s) return name -fetchFromCursor :: Statement.Cursor -> M (Vector (Vector (Maybe ByteString)))-fetchFromCursor cursor =+fetchFromCursor :: Int -> Statement.Cursor -> M (Vector (Vector (Maybe ByteString)))+fetchFromCursor amount cursor = liftExecution $ Execution.vectorResult =<< - Execution.statement (Statement.fetchFromCursor cursor)+ Execution.statement (Statement.fetchFromCursor amount cursor) beginTransaction :: Statement.TransactionMode -> M () beginTransaction mode =@@ -104,13 +104,13 @@ type Stream = ListT M (Vector (Maybe ByteString)) -streamWithCursor :: Statement.Statement -> M Stream-streamWithCursor statement =+streamWithCursor :: Int -> Statement.Statement -> M Stream+streamWithCursor batching statement = do cursor <- declareCursor statement return $ let loop = do- chunk <- lift $ fetchFromCursor cursor+ chunk <- lift $ fetchFromCursor batching cursor guard $ not $ Vector.null chunk Vector.foldl step mempty chunk <> loop step z r = z <> pure r
library/Hasql/Postgres/Statement.hs view
@@ -5,6 +5,7 @@ import qualified Data.Text.Encoding as TE import qualified Data.ByteString as B import qualified Data.ByteString.Lazy.Builder as BB+import qualified Data.ByteString.Lazy.Builder.ASCII as BB import qualified Data.ByteString.Lazy as BL import qualified Hasql.Postgres.Statement.TemplateConverter as TC @@ -75,12 +76,15 @@ template = PreparedTemplate $ "CLOSE " <> cursor -fetchFromCursor :: Cursor -> Statement-fetchFromCursor cursor =+fetchFromCursor :: Int -> Cursor -> Statement+fetchFromCursor amount cursor = Statement template [] True where template =- PreparedTemplate $ "FETCH FORWARD 256 FROM " <> cursor+ PreparedTemplate $ + BL.toStrict $ BB.toLazyByteString $+ BB.string7 "FETCH FORWARD " <> BB.intDec amount <> BB.string7 " FROM " <> + BB.byteString cursor beginTransaction :: TransactionMode -> Statement beginTransaction (i, w) =