hasql 1.2 → 1.3
raw patch · 18 files changed
+272/−272 lines, 18 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Hasql.Query: Query :: ByteString -> (Params a) -> (Result b) -> Bool -> Query a b
- Hasql.Query: data Query a b
- Hasql.Query: instance Data.Profunctor.Unsafe.Profunctor Hasql.Query.Query
- Hasql.Query: instance GHC.Base.Functor (Hasql.Query.Query a)
- Hasql.Session: query :: params -> Query params result -> Session result
+ Hasql.Session: statement :: params -> Statement params result -> Session result
+ Hasql.Statement: Statement :: ByteString -> (Params a) -> (Result b) -> Bool -> Statement a b
+ Hasql.Statement: data Statement a b
+ Hasql.Statement: instance Data.Profunctor.Unsafe.Profunctor Hasql.Statement.Statement
+ Hasql.Statement: instance GHC.Base.Functor (Hasql.Statement.Statement a)
Files
- benchmarks/Main.hs +19/−19
- hasql.cabal +4/−4
- library/Hasql/Decoders.hs +1/−1
- library/Hasql/Encoders.hs +2/−2
- library/Hasql/Private/IO.hs +15/−15
- library/Hasql/Private/Session.hs +6/−6
- library/Hasql/Query.hs +0/−55
- library/Hasql/Session.hs +1/−1
- library/Hasql/Statement.hs +55/−0
- profiling/Main.hs +18/−18
- tasty/Main.hs +88/−88
- tasty/Main/Connection.hs +1/−1
- tasty/Main/DSL.hs +2/−2
- tasty/Main/Queries.hs +0/−36
- tasty/Main/Statements.hs +36/−0
- threads-test/Main.hs +4/−4
- threads-test/Main/Queries.hs +0/−20
- threads-test/Main/Statements.hs +20/−0
benchmarks/Main.hs view
@@ -6,7 +6,7 @@ import Criterion.Main import qualified Hasql.Connection as A import qualified Hasql.Session as B-import qualified Hasql.Query as C+import qualified Hasql.Statement as C import qualified Hasql.Decoders as D import qualified Hasql.Encoders as E import qualified Data.Vector as F@@ -45,31 +45,31 @@ sessionWithSingleLargeResultInVector :: B.Session (Vector (Int64, Int64)) sessionWithSingleLargeResultInVector =- B.query () queryWithManyRowsInVector+ B.statement () statementWithManyRowsInVector sessionWithManyLargeResults :: B.Session [Vector (Int64, Int64)] sessionWithManyLargeResults =- replicateM 1000 (B.query () queryWithManyRowsInVector)+ replicateM 1000 (B.statement () statementWithManyRowsInVector) sessionWithSingleLargeResultInList :: B.Session (List (Int64, Int64)) sessionWithSingleLargeResultInList =- B.query () queryWithManyRowsInList+ B.statement () statementWithManyRowsInList sessionWithManySmallResults :: B.Session [(Int64, Int64)] sessionWithManySmallResults =- replicateM 1000 (B.query () queryWithSingleRow)+ replicateM 1000 (B.statement () statementWithSingleRow) -- * Statements ------------------------- -queryWithManyParameters :: C.Query (Vector (Int64, Int64)) ()-queryWithManyParameters =+statementWithManyParameters :: C.Statement (Vector (Int64, Int64)) ()+statementWithManyParameters = $(todo "statementWithManyParameters") -queryWithSingleRow :: C.Query () (Int64, Int64)-queryWithSingleRow =- C.Query template encoder decoder True+statementWithSingleRow :: C.Statement () (Int64, Int64)+statementWithSingleRow =+ C.Statement template encoder decoder True where template = "SELECT 1, 2"@@ -84,9 +84,9 @@ tuple !a !b = (a, b) -queryWithManyRows :: (D.Row (Int64, Int64) -> D.Result result) -> C.Query () result-queryWithManyRows decoder =- C.Query template encoder (decoder rowDecoder) True+statementWithManyRows :: (D.Row (Int64, Int64) -> D.Result result) -> C.Statement () result+statementWithManyRows decoder =+ C.Statement template encoder (decoder rowDecoder) True where template = "SELECT generate_series(0,1000) as a, generate_series(1000,2000) as b"@@ -98,10 +98,10 @@ tuple !a !b = (a, b) -queryWithManyRowsInVector :: C.Query () (Vector (Int64, Int64))-queryWithManyRowsInVector =- queryWithManyRows D.rowVector+statementWithManyRowsInVector :: C.Statement () (Vector (Int64, Int64))+statementWithManyRowsInVector =+ statementWithManyRows D.rowVector -queryWithManyRowsInList :: C.Query () (List (Int64, Int64))-queryWithManyRowsInList =- queryWithManyRows D.rowList+statementWithManyRowsInList :: C.Statement () (List (Int64, Int64))+statementWithManyRowsInList =+ statementWithManyRows D.rowList
hasql.cabal view
@@ -1,7 +1,7 @@ name: hasql version:- 1.2+ 1.3 category: Hasql, Database, PostgreSQL synopsis:@@ -51,7 +51,7 @@ Hasql.Decoders Hasql.Encoders Hasql.Connection- Hasql.Query+ Hasql.Statement Hasql.Session other-modules: Hasql.Private.Prelude@@ -114,7 +114,7 @@ other-modules: Main.DSL Main.Connection- Main.Queries+ Main.Statements Main.Prelude default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples@@ -143,7 +143,7 @@ main-is: Main.hs other-modules:- Main.Queries+ Main.Statements ghc-options: -O2 -threaded
library/Hasql/Decoders.hs view
@@ -102,7 +102,7 @@ -- | -- Exactly one row.--- Will raise the 'Hasql.Query.UnexpectedAmountOfRows' error if it's any other.+-- Will raise the 'Hasql.Errors.UnexpectedAmountOfRows' error if it's any other. -- {-# INLINABLE singleRow #-} singleRow :: Row a -> Result a
library/Hasql/Encoders.hs view
@@ -536,13 +536,13 @@ -- $insertMany -- It is not currently possible to pass in an array of encodable values--- to use in an 'insert many' query using Hasql. Instead, PostgreSQL's+-- to use in an 'insert many' statement using Hasql. Instead, PostgreSQL's -- (9.4 or later) `unnest` function can be used to in an analogous way -- to haskell's `zip` function by passing in multiple arrays of values -- to be zipped into the rows we want to insert: -- -- @--- insertMultipleLocations :: Query (Vector (UUID, Double, Double)) ()+-- insertMultipleLocations :: Statement (Vector (UUID, Double, Double)) () -- insertMultipleLocations = -- statement sql encoder decoder True -- where
library/Hasql/Private/IO.hs view
@@ -106,8 +106,8 @@ False -> fmap (Left . ClientError) $ LibPQ.errorMessage connection True -> pure (Right ()) -{-# INLINE sendPreparedParametricQuery #-}-sendPreparedParametricQuery ::+{-# INLINE sendPreparedParametricStatement #-}+sendPreparedParametricStatement :: LibPQ.Connection -> PreparedStatementRegistry.PreparedStatementRegistry -> Bool ->@@ -115,7 +115,7 @@ ParamsEncoders.Params a -> a -> IO (Either CommandError ())-sendPreparedParametricQuery connection registry integerDatetimes template (ParamsEncoders.Params (Op encoderOp)) input =+sendPreparedParametricStatement connection registry integerDatetimes template (ParamsEncoders.Params (Op encoderOp)) input = let (oidList, valueAndFormatList) = let@@ -128,15 +128,15 @@ key <- ExceptT $ getPreparedStatementKey connection registry template oidList ExceptT $ checkedSend connection $ LibPQ.sendQueryPrepared connection key valueAndFormatList LibPQ.Binary -{-# INLINE sendUnpreparedParametricQuery #-}-sendUnpreparedParametricQuery ::+{-# INLINE sendUnpreparedParametricStatement #-}+sendUnpreparedParametricStatement :: LibPQ.Connection -> Bool -> ByteString -> ParamsEncoders.Params a -> a -> IO (Either CommandError ())-sendUnpreparedParametricQuery connection integerDatetimes template (ParamsEncoders.Params (Op encoderOp)) input =+sendUnpreparedParametricStatement connection integerDatetimes template (ParamsEncoders.Params (Op encoderOp)) input = let params = let@@ -145,8 +145,8 @@ in foldr step [] (encoderOp input) in checkedSend connection $ LibPQ.sendQueryParams connection template params LibPQ.Binary -{-# INLINE sendParametricQuery #-}-sendParametricQuery ::+{-# INLINE sendParametricStatement #-}+sendParametricStatement :: LibPQ.Connection -> Bool -> PreparedStatementRegistry.PreparedStatementRegistry ->@@ -155,13 +155,13 @@ Bool -> a -> IO (Either CommandError ())-sendParametricQuery connection integerDatetimes registry template encoder prepared params =- {-# SCC "sendParametricQuery" #-} +sendParametricStatement connection integerDatetimes registry template encoder prepared params =+ {-# SCC "sendParametricStatement" #-} if prepared- then sendPreparedParametricQuery connection registry integerDatetimes template encoder params- else sendUnpreparedParametricQuery connection integerDatetimes template encoder params+ then sendPreparedParametricStatement connection registry integerDatetimes template encoder params+ else sendUnpreparedParametricStatement connection integerDatetimes template encoder params -{-# INLINE sendNonparametricQuery #-}-sendNonparametricQuery :: LibPQ.Connection -> ByteString -> IO (Either CommandError ())-sendNonparametricQuery connection sql =+{-# INLINE sendNonparametricStatement #-}+sendNonparametricStatement :: LibPQ.Connection -> ByteString -> IO (Either CommandError ())+sendNonparametricStatement connection sql = checkedSend connection $ LibPQ.sendQuery connection sql
library/Hasql/Private/Session.hs view
@@ -9,7 +9,7 @@ import qualified Hasql.Private.Encoders.Params as Encoders.Params import qualified Hasql.Private.Settings as Settings import qualified Hasql.Private.IO as IO-import qualified Hasql.Query as Query+import qualified Hasql.Statement as Statement import qualified Hasql.Private.Connection as Connection @@ -34,7 +34,7 @@ sql sql = Session $ ReaderT $ \(Connection.Connection pqConnectionRef integerDatetimes registry) -> ExceptT $ fmap (mapLeft (QueryError sql [])) $ withMVar pqConnectionRef $ \pqConnection -> do- r1 <- IO.sendNonparametricQuery pqConnection sql+ r1 <- IO.sendNonparametricStatement pqConnection sql r2 <- IO.getResults pqConnection integerDatetimes decoder return $ r1 *> r2 where@@ -42,12 +42,12 @@ Decoders.Results.single Decoders.Result.unit -- |--- Parameters and a specification of the parametric query to apply them to.-query :: params -> Query.Query params result -> Session result-query input (Query.Query template encoder decoder preparable) =+-- Parameters and a specification of a parametric single-statement query to apply them to.+statement :: params -> Statement.Statement params result -> Session result+statement input (Statement.Statement template encoder decoder preparable) = Session $ ReaderT $ \(Connection.Connection pqConnectionRef integerDatetimes registry) -> ExceptT $ fmap (mapLeft (QueryError template inputReps)) $ withMVar pqConnectionRef $ \pqConnection -> do- r1 <- IO.sendParametricQuery pqConnection integerDatetimes registry template (unsafeCoerce encoder) preparable input+ r1 <- IO.sendParametricStatement pqConnection integerDatetimes registry template (unsafeCoerce encoder) preparable input r2 <- IO.getResults pqConnection integerDatetimes (unsafeCoerce decoder) return $ r1 *> r2 where
− library/Hasql/Query.hs
@@ -1,55 +0,0 @@-module Hasql.Query-where--import Hasql.Private.Prelude-import qualified Hasql.Decoders as Decoders-import qualified Hasql.Encoders as Encoders----- |--- A specification of a strictly single-statement query, which can be parameterized and prepared.--- --- Consists of the following:--- --- * SQL template,--- * params encoder,--- * result decoder,--- * a flag, determining whether it should be prepared.--- --- The SQL template must be formatted according to Postgres' standard,--- with any non-ASCII characters of the template encoded using UTF-8.--- According to the format,--- parameters must be referred to using the positional notation, as in the following:--- @$1@, @$2@, @$3@ and etc.--- Those references must be used to refer to the values of the 'Encoders.Params' encoder.--- --- Following is an example of the declaration of a prepared statement with its associated codecs.--- --- @--- selectSum :: Hasql.Query.'Query' (Int64, Int64) Int64--- selectSum =--- Hasql.Query.'Query' sql encoder decoder True--- where--- sql =--- "select ($1 + $2)"--- encoder =--- 'contramap' 'fst' (Hasql.Encoders.'Hasql.Encoders.value' Hasql.Encoders.'Hasql.Encoders.int8') '<>'--- 'contramap' 'snd' (Hasql.Encoders.'Hasql.Encoders.value' Hasql.Encoders.'Hasql.Encoders.int8')--- decoder =--- Hasql.Decoders.'Hasql.Decoders.singleRow' (Hasql.Decoders.'Hasql.Decoders.value' Hasql.Decoders.'Hasql.Decoders.int8')--- @--- --- The statement above accepts a product of two parameters of type 'Int64'--- and produces a single result of type 'Int64'.--- -data Query a b =- Query ByteString (Encoders.Params a) (Decoders.Result b) Bool--instance Functor (Query a) where- {-# INLINE fmap #-}- fmap = rmap--instance Profunctor Query where- {-# INLINE dimap #-}- dimap f1 f2 (Query template encoder decoder preparable) =- Query template (contramap f1 encoder) (fmap f2 decoder) preparable
library/Hasql/Session.hs view
@@ -2,7 +2,7 @@ ( Session, sql,- query,+ statement, -- * Execution run, -- * Errors
+ library/Hasql/Statement.hs view
@@ -0,0 +1,55 @@+module Hasql.Statement+where++import Hasql.Private.Prelude+import qualified Hasql.Decoders as Decoders+import qualified Hasql.Encoders as Encoders+++-- |+-- A specification of a strictly single-statement query, which can be parameterized and prepared.+-- +-- Consists of the following:+-- +-- * SQL template,+-- * params encoder,+-- * result decoder,+-- * a flag, determining whether it should be prepared.+-- +-- The SQL template must be formatted according to Postgres' standard,+-- with any non-ASCII characters of the template encoded using UTF-8.+-- According to the format,+-- parameters must be referred to using the positional notation, as in the following:+-- @$1@, @$2@, @$3@ and etc.+-- Those references must be used to refer to the values of the 'Encoders.Params' encoder.+-- +-- Following is an example of the declaration of a prepared statement with its associated codecs.+-- +-- @+-- selectSum :: Hasql.Statement.'Statement' (Int64, Int64) Int64+-- selectSum =+-- Hasql.Statement.'Statement' sql encoder decoder True+-- where+-- sql =+-- "select ($1 + $2)"+-- encoder =+-- 'contramap' 'fst' (Hasql.Encoders.'Hasql.Encoders.value' Hasql.Encoders.'Hasql.Encoders.int8') '<>'+-- 'contramap' 'snd' (Hasql.Encoders.'Hasql.Encoders.value' Hasql.Encoders.'Hasql.Encoders.int8')+-- decoder =+-- Hasql.Decoders.'Hasql.Decoders.singleRow' (Hasql.Decoders.'Hasql.Decoders.value' Hasql.Decoders.'Hasql.Decoders.int8')+-- @+-- +-- The statement above accepts a product of two parameters of type 'Int64'+-- and produces a single result of type 'Int64'.+-- +data Statement a b =+ Statement ByteString (Encoders.Params a) (Decoders.Result b) Bool++instance Functor (Statement a) where+ {-# INLINE fmap #-}+ fmap = rmap++instance Profunctor Statement where+ {-# INLINE dimap #-}+ dimap f1 f2 (Statement template encoder decoder preparable) =+ Statement template (contramap f1 encoder) (fmap f2 decoder) preparable
profiling/Main.hs view
@@ -4,7 +4,7 @@ import Bug import qualified Hasql.Connection as A import qualified Hasql.Session as B-import qualified Hasql.Query as C+import qualified Hasql.Statement as C import qualified Hasql.Decoders as D import qualified Hasql.Encoders as E import qualified Data.Vector as F@@ -40,27 +40,27 @@ sessionWithSingleLargeResultInVector :: B.Session (Vector (Int64, Int64)) sessionWithSingleLargeResultInVector =- B.query () queryWithManyRowsInVector+ B.statement () statementWithManyRowsInVector sessionWithSingleLargeResultInList :: B.Session (List (Int64, Int64)) sessionWithSingleLargeResultInList =- B.query () queryWithManyRowsInList+ B.statement () statementWithManyRowsInList sessionWithManySmallResults :: B.Session (Vector (Int64, Int64)) sessionWithManySmallResults =- F.replicateM 1000 (B.query () queryWithSingleRow)+ F.replicateM 1000 (B.statement () statementWithSingleRow) -- * Statements ------------------------- -queryWithManyParameters :: C.Query (Vector (Int64, Int64)) ()-queryWithManyParameters =+statementWithManyParameters :: C.Statement (Vector (Int64, Int64)) ()+statementWithManyParameters = $(todo "statementWithManyParameters") -queryWithSingleRow :: C.Query () (Int64, Int64)-queryWithSingleRow =- C.Query template encoder decoder True+statementWithSingleRow :: C.Statement () (Int64, Int64)+statementWithSingleRow =+ C.Statement template encoder decoder True where template = "SELECT 1, 2"@@ -75,9 +75,9 @@ tuple !a !b = (a, b) -queryWithManyRows :: (D.Row (Int64, Int64) -> D.Result result) -> C.Query () result-queryWithManyRows decoder =- C.Query template encoder (decoder rowDecoder) True+statementWithManyRows :: (D.Row (Int64, Int64) -> D.Result result) -> C.Statement () result+statementWithManyRows decoder =+ C.Statement template encoder (decoder rowDecoder) True where template = "SELECT generate_series(0,1000) as a, generate_series(1000,2000) as b"@@ -89,10 +89,10 @@ tuple !a !b = (a, b) -queryWithManyRowsInVector :: C.Query () (Vector (Int64, Int64))-queryWithManyRowsInVector =- queryWithManyRows D.rowVector+statementWithManyRowsInVector :: C.Statement () (Vector (Int64, Int64))+statementWithManyRowsInVector =+ statementWithManyRows D.rowVector -queryWithManyRowsInList :: C.Query () (List (Int64, Int64))-queryWithManyRowsInList =- queryWithManyRows D.rowList+statementWithManyRowsInList :: C.Statement () (List (Int64, Int64))+statementWithManyRowsInList =+ statementWithManyRows D.rowList
tasty/Main.hs view
@@ -7,10 +7,10 @@ import Test.Tasty.HUnit import Test.Tasty.QuickCheck import qualified Test.QuickCheck as QuickCheck-import qualified Main.Queries as Queries+import qualified Main.Statements as Statements import qualified Main.DSL as DSL import qualified Main.Connection as Connection-import qualified Hasql.Query as Query+import qualified Hasql.Statement as Statement import qualified Hasql.Encoders as Encoders import qualified Hasql.Decoders as Decoders import qualified Hasql.Session as Session@@ -24,8 +24,8 @@ [ testCase "Failed query" $ let- query =- Query.Query "select true where 1 = any ($1) and $2" encoder decoder True+ statement =+ Statement.Statement "select true where 1 = any ($1) and $2" encoder decoder True where encoder = contrazip2@@ -34,7 +34,7 @@ decoder = fmap (maybe False (const True)) (Decoders.rowMaybe (Decoders.column Decoders.bool)) session =- Session.query ([3, 7], "a") query+ Session.statement ([3, 7], "a") statement in do x <- Connection.with (Session.run session) assertBool (show x) $ case x of@@ -43,8 +43,8 @@ , testCase "IN simulation" $ let- query =- Query.Query "select true where 1 = any ($1)" encoder decoder True+ statement =+ Statement.Statement "select true where 1 = any ($1)" encoder decoder True where encoder = Encoders.param (Encoders.array (Encoders.dimension foldl' (Encoders.element Encoders.int8)))@@ -52,8 +52,8 @@ fmap (maybe False (const True)) (Decoders.rowMaybe (Decoders.column Decoders.bool)) session = do- result1 <- Session.query [1, 2] query- result2 <- Session.query [2, 3] query+ result1 <- Session.statement [1, 2] statement+ result2 <- Session.statement [2, 3] statement return (result1, result2) in do x <- Connection.with (Session.run session)@@ -61,8 +61,8 @@ , testCase "NOT IN simulation" $ let- query =- Query.Query "select true where 3 <> all ($1)" encoder decoder True+ statement =+ Statement.Statement "select true where 3 <> all ($1)" encoder decoder True where encoder = Encoders.param (Encoders.array (Encoders.dimension foldl' (Encoders.element Encoders.int8)))@@ -70,8 +70,8 @@ fmap (maybe False (const True)) (Decoders.rowMaybe (Decoders.column Decoders.bool)) session = do- result1 <- Session.query [1, 2] query- result2 <- Session.query [2, 3] query+ result1 <- Session.statement [1, 2] statement+ result2 <- Session.statement [2, 3] statement return (result1, result2) in do x <- Connection.with (Session.run session)@@ -79,8 +79,8 @@ , testCase "Composite decoding" $ let- query =- Query.Query sql encoder decoder True+ statement =+ Statement.Statement sql encoder decoder True where sql = "select (1, true)"@@ -89,15 +89,15 @@ decoder = Decoders.singleRow (Decoders.column (Decoders.composite ((,) <$> Decoders.field Decoders.int8 <*> Decoders.field Decoders.bool))) session =- Session.query () query+ Session.statement () statement in do x <- Connection.with (Session.run session) assertEqual (show x) (Right (Right (1, True))) x , testCase "Complex composite decoding" $ let- query =- Query.Query sql encoder decoder True+ statement =+ Statement.Statement sql encoder decoder True where sql = "select (1, true) as entity1, ('hello', 3) as entity2"@@ -114,7 +114,7 @@ Decoders.composite $ (,) <$> Decoders.field Decoders.text <*> Decoders.field Decoders.int8 session =- Session.query () query+ Session.statement () statement in do x <- Connection.with (Session.run session) assertEqual (show x) (Right (Right ((1, True), ("hello", 3)))) x@@ -127,10 +127,10 @@ assertEqual (show x) (Right (Right [])) x where session =- Session.query () query+ Session.statement () statement where- query =- Query.Query sql encoder decoder True+ statement =+ Statement.Statement sql encoder decoder True where sql = "select array[]::int8[]"@@ -154,10 +154,10 @@ catchError session (const (pure ())) *> session where session =- Session.query () query+ Session.statement () statement where- query =- Query.Query sql encoder decoder True+ statement =+ Statement.Statement sql encoder decoder True where sql = "absurd"@@ -177,10 +177,10 @@ try *> fail *> try where try =- Session.query 1 query+ Session.statement 1 statement where- query =- Query.Query sql encoder decoder True+ statement =+ Statement.Statement sql encoder decoder True where sql = "select $1 :: int8"@@ -194,9 +194,9 @@ , testCase "\"in progress after error\" bugfix" $ let- sumQuery :: Query.Query (Int64, Int64) Int64- sumQuery =- Query.Query sql encoder decoder True+ sumStatement :: Statement.Statement (Int64, Int64) Int64+ sumStatement =+ Statement.Statement sql encoder decoder True where sql = "select ($1 + $2)"@@ -207,7 +207,7 @@ Decoders.singleRow (Decoders.column Decoders.int8) sumSession :: Session.Session Int64 sumSession =- Session.sql "begin" *> Session.query (1, 1) sumQuery <* Session.sql "end"+ Session.sql "begin" *> Session.statement (1, 1) sumStatement <* Session.sql "end" errorSession :: Session.Session () errorSession = Session.sql "asldfjsldk"@@ -219,9 +219,9 @@ , testCase "\"another command is already in progress\" bugfix" $ let- sumQuery :: Query.Query (Int64, Int64) Int64- sumQuery =- Query.Query sql encoder decoder True+ sumStatement :: Statement.Statement (Int64, Int64) Int64+ sumStatement =+ Statement.Statement sql encoder decoder True where sql = "select ($1 + $2)"@@ -234,7 +234,7 @@ session = do Session.sql "begin;"- s <- Session.query (1,1) sumQuery+ s <- Session.statement (1,1) sumStatement Session.sql "end;" return s in DSL.session session >>= \x -> assertEqual (show x) (Right 2) x@@ -247,8 +247,8 @@ actualIO = DSL.session $ do let- query =- Query.Query sql encoder decoder True+ statement =+ Statement.Statement sql encoder decoder True where sql = "select $1 = interval '10 seconds'"@@ -256,7 +256,7 @@ (Decoders.singleRow (Decoders.column (Decoders.bool))) encoder = Encoders.param (Encoders.interval)- in DSL.query (10 :: DiffTime) query+ in DSL.statement (10 :: DiffTime) statement in actualIO >>= \x -> assertEqual (show x) (Right True) x , testCase "Interval Decoding" $@@ -264,8 +264,8 @@ actualIO = DSL.session $ do let- query =- Query.Query sql encoder decoder True+ statement =+ Statement.Statement sql encoder decoder True where sql = "select interval '10 seconds'"@@ -273,7 +273,7 @@ (Decoders.singleRow (Decoders.column (Decoders.interval))) encoder = Encoders.unit- in DSL.query () query+ in DSL.statement () statement in actualIO >>= \x -> assertEqual (show x) (Right (10 :: DiffTime)) x , testCase "Interval Encoding/Decoding" $@@ -281,8 +281,8 @@ actualIO = DSL.session $ do let- query =- Query.Query sql encoder decoder True+ statement =+ Statement.Statement sql encoder decoder True where sql = "select $1"@@ -290,7 +290,7 @@ (Decoders.singleRow (Decoders.column (Decoders.interval))) encoder = Encoders.param (Encoders.interval)- in DSL.query (10 :: DiffTime) query+ in DSL.statement (10 :: DiffTime) statement in actualIO >>= \x -> assertEqual (show x) (Right (10 :: DiffTime)) x , testCase "Unknown" $@@ -298,22 +298,22 @@ actualIO = DSL.session $ do let- query =- Query.Query sql mempty Decoders.unit True+ statement =+ Statement.Statement sql mempty Decoders.unit True where sql = "drop type if exists mood"- in DSL.query () query+ in DSL.statement () statement let- query =- Query.Query sql mempty Decoders.unit True+ statement =+ Statement.Statement sql mempty Decoders.unit True where sql = "create type mood as enum ('sad', 'ok', 'happy')"- in DSL.query () query+ in DSL.statement () statement let- query =- Query.Query sql encoder decoder True+ statement =+ Statement.Statement sql encoder decoder True where sql = "select $1 = ('ok' :: mood)"@@ -321,7 +321,7 @@ (Decoders.singleRow (Decoders.column (Decoders.bool))) encoder = Encoders.param (Encoders.unknown)- in DSL.query "ok" query+ in DSL.statement "ok" statement in actualIO >>= assertEqual "" (Right True) , testCase "Textual Unknown" $@@ -329,22 +329,22 @@ actualIO = DSL.session $ do let- query =- Query.Query sql mempty Decoders.unit True+ statement =+ Statement.Statement sql mempty Decoders.unit True where sql = "create or replace function overloaded(a int, b int) returns int as $$ select a + b $$ language sql;"- in DSL.query () query+ in DSL.statement () statement let- query =- Query.Query sql mempty Decoders.unit True+ statement =+ Statement.Statement sql mempty Decoders.unit True where sql = "create or replace function overloaded(a text, b text, c text) returns text as $$ select a || b || c $$ language sql;"- in DSL.query () query+ in DSL.statement () statement let- query =- Query.Query sql encoder decoder True+ statement =+ Statement.Statement sql encoder decoder True where sql = "select overloaded($1, $2) || overloaded($3, $4, $5)"@@ -352,7 +352,7 @@ (Decoders.singleRow (Decoders.column (Decoders.text))) encoder = contramany (Encoders.param Encoders.unknown)- in DSL.query ["1", "2", "4", "5", "6"] query+ in DSL.statement ["1", "2", "4", "5", "6"] statement in actualIO >>= assertEqual "" (Right "3456") , testCase "Enum" $@@ -360,22 +360,22 @@ actualIO = DSL.session $ do let- query =- Query.Query sql mempty Decoders.unit True+ statement =+ Statement.Statement sql mempty Decoders.unit True where sql = "drop type if exists mood"- in DSL.query () query+ in DSL.statement () statement let- query =- Query.Query sql mempty Decoders.unit True+ statement =+ Statement.Statement sql mempty Decoders.unit True where sql = "create type mood as enum ('sad', 'ok', 'happy')"- in DSL.query () query+ in DSL.statement () statement let- query =- Query.Query sql encoder decoder True+ statement =+ Statement.Statement sql encoder decoder True where sql = "select ($1 :: mood)"@@ -383,7 +383,7 @@ (Decoders.singleRow (Decoders.column (Decoders.enum (Just . id)))) encoder = Encoders.param (Encoders.enum id)- in DSL.query "ok" query+ in DSL.statement "ok" statement in actualIO >>= assertEqual "" (Right "ok") , testCase "The same prepared statement used on different types" $ @@ -392,10 +392,10 @@ DSL.session $ do let effect1 =- DSL.query "ok" query+ DSL.statement "ok" statement where- query =- Query.Query sql encoder decoder True+ statement =+ Statement.Statement sql encoder decoder True where sql = "select $1"@@ -404,10 +404,10 @@ decoder = (Decoders.singleRow (Decoders.column (Decoders.text))) effect2 =- DSL.query 1 query+ DSL.statement 1 statement where- query =- Query.Query sql encoder decoder True+ statement =+ Statement.Statement sql encoder decoder True where sql = "select $1"@@ -429,16 +429,16 @@ deleteRows <* dropTable where dropTable =- DSL.query () $ Queries.plain $ + DSL.statement () $ Statements.plain $ "drop table if exists a" createTable =- DSL.query () $ Queries.plain $+ DSL.statement () $ Statements.plain $ "create table a (id bigserial not null, name varchar not null, primary key (id))" insertRow =- DSL.query () $ Queries.plain $+ DSL.statement () $ Statements.plain $ "insert into a (name) values ('a')" deleteRows =- DSL.query () $ Query.Query sql def decoder False+ DSL.statement () $ Statement.Statement sql def decoder False where sql = "delete from a"@@ -450,18 +450,18 @@ let actualIO = DSL.session $ do- DSL.query () $ Queries.plain $ "drop table if exists a"- DSL.query () $ Queries.plain $ "create table a (id serial not null, v char not null, primary key (id))"- id1 <- DSL.query () $ Query.Query "insert into a (v) values ('a') returning id" def (Decoders.singleRow (Decoders.column Decoders.int4)) False- id2 <- DSL.query () $ Query.Query "insert into a (v) values ('b') returning id" def (Decoders.singleRow (Decoders.column Decoders.int4)) False- DSL.query () $ Queries.plain $ "drop table if exists a"+ DSL.statement () $ Statements.plain $ "drop table if exists a"+ DSL.statement () $ Statements.plain $ "create table a (id serial not null, v char not null, primary key (id))"+ id1 <- DSL.statement () $ Statement.Statement "insert into a (v) values ('a') returning id" def (Decoders.singleRow (Decoders.column Decoders.int4)) False+ id2 <- DSL.statement () $ Statement.Statement "insert into a (v) values ('b') returning id" def (Decoders.singleRow (Decoders.column Decoders.int4)) False+ DSL.statement () $ Statements.plain $ "drop table if exists a" pure (id1, id2) in assertEqual "" (Right (1, 2)) =<< actualIO , testCase "List decoding" $ let actualIO =- DSL.session $ DSL.query () $ Queries.selectList+ DSL.session $ DSL.statement () $ Statements.selectList in assertEqual "" (Right [(1, 2), (3, 4), (5, 6)]) =<< actualIO ]
tasty/Main/Connection.hs view
@@ -3,7 +3,7 @@ import Main.Prelude import qualified Hasql.Connection as HC-import qualified Hasql.Query as HQ+import qualified Hasql.Statement as HQ import qualified Hasql.Session
tasty/Main/DSL.hs view
@@ -3,14 +3,14 @@ Session, SessionError(..), session,- Hasql.Session.query,+ Hasql.Session.statement, Hasql.Session.sql, ) where import Main.Prelude import qualified Hasql.Connection as HC-import qualified Hasql.Query as HQ+import qualified Hasql.Statement as HQ import qualified Hasql.Encoders as HE import qualified Hasql.Decoders as HD import qualified Hasql.Session
− tasty/Main/Queries.hs
@@ -1,36 +0,0 @@-module Main.Queries where--import Main.Prelude hiding (def)-import qualified Hasql.Query as HQ-import qualified Hasql.Encoders as HE-import qualified Hasql.Decoders as HD-import qualified Main.Prelude as Prelude---def :: ByteString -> HQ.Query () ()-def sql =- HQ.Query sql Prelude.def Prelude.def False--plain :: ByteString -> HQ.Query () ()-plain sql =- HQ.Query sql mempty HD.unit False--dropType :: ByteString -> HQ.Query () ()-dropType name =- plain $- "drop type if exists " <> name--createEnum :: ByteString -> [ByteString] -> HQ.Query () ()-createEnum name values =- plain $- "create type " <> name <> " as enum (" <> - mconcat (intersperse ", " (map (\x -> "'" <> x <> "'") values)) <> ")"--selectList :: HQ.Query () ([] (Int64, Int64))-selectList =- HQ.Query sql mempty decoder True- where- sql =- "values (1,2), (3,4), (5,6)"- decoder =- HD.rowList ((,) <$> HD.column HD.int8 <*> HD.column HD.int8)
+ tasty/Main/Statements.hs view
@@ -0,0 +1,36 @@+module Main.Statements where++import Main.Prelude hiding (def)+import qualified Hasql.Statement as HQ+import qualified Hasql.Encoders as HE+import qualified Hasql.Decoders as HD+import qualified Main.Prelude as Prelude+++def :: ByteString -> HQ.Statement () ()+def sql =+ HQ.Statement sql Prelude.def Prelude.def False++plain :: ByteString -> HQ.Statement () ()+plain sql =+ HQ.Statement sql mempty HD.unit False++dropType :: ByteString -> HQ.Statement () ()+dropType name =+ plain $+ "drop type if exists " <> name++createEnum :: ByteString -> [ByteString] -> HQ.Statement () ()+createEnum name values =+ plain $+ "create type " <> name <> " as enum (" <> + mconcat (intersperse ", " (map (\x -> "'" <> x <> "'") values)) <> ")"++selectList :: HQ.Statement () ([] (Int64, Int64))+selectList =+ HQ.Statement sql mempty decoder True+ where+ sql =+ "values (1,2), (3,4), (5,6)"+ decoder =+ HD.rowList ((,) <$> HD.column HD.int8 <*> HD.column HD.int8)
threads-test/Main.hs view
@@ -2,11 +2,11 @@ import Rebase.Prelude import qualified Hasql.Connection-import qualified Hasql.Query+import qualified Hasql.Statement import qualified Hasql.Encoders import qualified Hasql.Decoders import qualified Hasql.Session-import qualified Main.Queries as Queries+import qualified Main.Statements as Statements main =@@ -29,13 +29,13 @@ forkIO $ do traceM "1: in" putMVar beginVar ()- session connection1 (Hasql.Session.query 0.2 Queries.selectSleep)+ session connection1 (Hasql.Session.statement 0.2 Statements.selectSleep) traceM "1: out" void (tryPutMVar finishVar False) forkIO $ do takeMVar beginVar traceM "2: in"- session connection2 (Hasql.Session.query 0.1 Queries.selectSleep)+ session connection2 (Hasql.Session.statement 0.1 Statements.selectSleep) traceM "2: out" void (tryPutMVar finishVar True) bool exitFailure exitSuccess . traceShowId =<< takeMVar finishVar
− threads-test/Main/Queries.hs
@@ -1,20 +0,0 @@-module Main.Queries where--import Rebase.Prelude-import Hasql.Query-import qualified Hasql.Encoders as E-import qualified Hasql.Decoders as D---selectSleep :: Query Double ()-selectSleep =- Query sql encoder decoder True- where- sql =- "select pg_sleep($1)"- encoder =- E.param E.float8- decoder =- D.unit--
+ threads-test/Main/Statements.hs view
@@ -0,0 +1,20 @@+module Main.Statements where++import Rebase.Prelude+import Hasql.Statement+import qualified Hasql.Encoders as E+import qualified Hasql.Decoders as D+++selectSleep :: Statement Double ()+selectSleep =+ Statement sql encoder decoder True+ where+ sql =+ "select pg_sleep($1)"+ encoder =+ E.param E.float8+ decoder =+ D.unit++