Make Query a dedicated data-type

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 " <>

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 =
+-- * SQL template,
-  (ByteString, Encoding.Params a, Decoding.Result b, Bool)
+-- * 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

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)
+          id1 <- DSL.query () $ H.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)
+          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

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)"