diff --git a/benchmark/Main/Queries.hs b/benchmark/Main/Queries.hs index 9e07175..1897eeb 100644 --- a/benchmark/Main/Queries.hs +++ b/benchmark/Main/Queries.hs @@ -9,7 +9,7 @@ import qualified Hasql.Decoding as HD select1 :: Int -> H.Query () (Vector Int64) select1 amount = {-# SCC "select1" #-} - (sql, mempty, decoder, True) + H.Query sql mempty decoder True where !sql = "values " <> @@ -20,7 +20,7 @@ select1 amount = select4 :: Int -> H.Query () (Vector (Int64, Int64, Int64, Int64)) select4 amount = {-# SCC "select4" #-} - (sql, mempty, decoder, True) + H.Query sql mempty decoder True where !sql = "values " <> diff --git a/library/Hasql.hs b/library/Hasql.hs index 771ec9e..244c6c5 100644 --- a/library/Hasql.hs +++ b/library/Hasql.hs @@ -109,15 +109,55 @@ disconnect (Connection pqConnection _ _) = -- | -- A strictly single-statement query, which can be parameterized and prepared. -- --- SQL template, params encoder, result decoder and a flag, determining whether it should be prepared. +-- Consists of the following: -- -type Query a b = - (ByteString, Encoding.Params a, Decoding.Result b, Bool) +-- * 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 must be 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 'Encoding.Params' encoder. +-- +-- Following is an example of the declaration of a prepared statement with its associated codecs. +-- +-- @ +-- selectSum :: Hasql.'Hasql.Query' (Int64, Int64) Int64 +-- selectSum = +-- Hasql.'Hasql.Query' sql encoder decoder True +-- where +-- sql = +-- "select ($1 + $2)" +-- encoder = +-- 'contramap' 'fst' (Hasql.Encoding.'Hasql.Encoding.value' Hasql.Encoding.'Hasql.Encoding.int8') <> +-- 'contramap' 'snd' (Hasql.Encoding.'Hasql.Encoding.value' Hasql.Encoding.'Hasql.Encoding.int8') +-- decoder = +-- Hasql.Decoding.'Hasql.Decoding.singleRow' (Hasql.Decoding.'Hasql.Decoding.value' Hasql.Decoding.'Hasql.Decoding.int8') +-- @ +-- +-- The statement above accepts a product of two parameters of type 'Int64' +-- and results in a single result of type 'Int64'. +-- +data Query a b = + Query !ByteString !(Encoding.Params a) !(Decoding.Result b) !Bool + deriving (Functor) + +instance Profunctor Query where + lmap f (Query p1 p2 p3 p4) = + Query p1 (contramap f p2) p3 p4 + rmap f (Query p1 p2 p3 p4) = + Query p1 p2 (fmap f p3) p4 + dimap f1 f2 (Query p1 p2 p3 p4) = + Query p1 (contramap f1 p2) (fmap f2 p3) p4 -- | -- Execute a parametric query, producing either a deserialization failure or a successful result. query :: Connection -> Query a b -> a -> IO (Either ResultsError b) -query (Connection pqConnection integerDatetimes registry) (template, encoder, decoder, preparable) params = +query (Connection pqConnection integerDatetimes registry) (Query template encoder decoder preparable) params = {-# SCC "query" #-} fmap (mapLeft coerceResultsError) $ runEitherT $ do EitherT $ IO.sendParametricQuery pqConnection integerDatetimes registry template (coerceEncoder encoder) preparable params diff --git a/tasty/Main.hs b/tasty/Main.hs index 25379d5..ea028ac 100644 --- a/tasty/Main.hs +++ b/tasty/Main.hs @@ -27,21 +27,21 @@ tree = DSL.session $ do let query = - (sql, mempty, HD.noResult, True) + H.Query sql mempty HD.noResult True where sql = "drop type if exists mood" in DSL.query () query let query = - (sql, mempty, HD.noResult, True) + H.Query sql mempty HD.noResult True where sql = "create type mood as enum ('sad', 'ok', 'happy')" in DSL.query () query let query = - (sql, encoder, decoder, True) + H.Query sql encoder decoder True where sql = "select ($1 :: mood)" @@ -63,7 +63,7 @@ tree = DSL.query "ok" query where query = - (sql, encoder, decoder, True) + H.Query sql encoder decoder True where sql = "select $1" @@ -75,7 +75,7 @@ tree = DSL.query 1 query where query = - (sql, encoder, decoder, True) + H.Query sql encoder decoder True where sql = "select $1" @@ -107,7 +107,7 @@ tree = DSL.query () $ Queries.plain $ "insert into a (name) values ('a')" deleteRows = - DSL.query () (sql, def, decoder, False) + DSL.query () $ H.Query sql def decoder False where sql = "delete from a" @@ -121,8 +121,8 @@ tree = 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 () ("insert into a (v) values ('a') returning id", def, (HD.singleRow (HD.value HD.int4)), False) - id2 <- DSL.query () ("insert into a (v) values ('b') returning id", def, (HD.singleRow (HD.value HD.int4)), False) + id1 <- DSL.query () $ H.Query "insert into a (v) values ('a') returning id" def (HD.singleRow (HD.value HD.int4)) False + id2 <- DSL.query () $ H.Query "insert into a (v) values ('b') returning id" def (HD.singleRow (HD.value HD.int4)) False DSL.query () $ Queries.plain $ "drop table if exists a" pure (id1, id2) in HUnit.assertEqual "" (Right (1, 2)) =<< actualIO diff --git a/tasty/Main/Queries.hs b/tasty/Main/Queries.hs index c845098..e27d9ac 100644 --- a/tasty/Main/Queries.hs +++ b/tasty/Main/Queries.hs @@ -9,11 +9,11 @@ import qualified Main.Prelude as Prelude def :: ByteString -> H.Query () () def sql = - (sql, Prelude.def, Prelude.def, False) + H.Query sql Prelude.def Prelude.def False plain :: ByteString -> H.Query () () plain sql = - (sql, mempty, HD.noResult, False) + H.Query sql mempty HD.noResult False dropType :: ByteString -> H.Query () () dropType name = @@ -28,7 +28,7 @@ createEnum name values = selectList :: H.Query () ([] (Int64, Int64)) selectList = - (sql, mempty, decoder, True) + H.Query sql mempty decoder True where sql = "values (1,2), (3,4), (5,6)"