hasql 1.1.1 → 1.2

raw patch · 22 files changed

+575/−629 lines, 22 filesdep +text-builderdep ~tastydep ~tasty-hunitdep ~tasty-quickcheckPVP ok

version bump matches the API change (PVP)

Dependencies added: text-builder

Dependency ranges changed: tasty, tasty-hunit, tasty-quickcheck

API changes (from Hackage documentation)

Files

• benchmarks/Main.hs +6/−6
• hasql.cabal +12/−11
• library/Hasql/Decoders.hs +99/−99
• library/Hasql/Encoders.hs +63/−60
• library/Hasql/Private/Decoders/Result.hs +3/−33
• library/Hasql/Private/Decoders/Results.hs +3/−10
• library/Hasql/Private/Decoders/Row.hs +4/−9
• library/Hasql/Private/Encoders/Array.hs +28/−13
• library/Hasql/Private/Encoders/Params.hs +12/−35
• library/Hasql/Private/Encoders/Value.hs +11/−12
• library/Hasql/Private/Errors.hs +88/−0
• library/Hasql/Private/IO.hs +37/−29
• library/Hasql/Private/PTI.hs +76/−76
• library/Hasql/Private/Query.hs +0/−61
• library/Hasql/Private/Session.hs +22/−80
• library/Hasql/Query.hs +12/−14
• library/Hasql/Session.hs +8/−9
• profiling/Main.hs +6/−6
• tasty/Main.hs +78/−59
• tasty/Main/DSL.hs +1/−1
• tasty/Main/Queries.hs +4/−4
• threads-test/Main/Queries.hs +2/−2

@@ -69,7 +69,7 @@  queryWithSingleRow :: C.Query () (Int64, Int64) queryWithSingleRow =-  C.statement template encoder decoder True+  C.Query template encoder decoder True   where     template =       "SELECT 1, 2"@@ -79,29 +79,29 @@       D.singleRow row       where         row =-          tuple <$> D.value D.int8 <*> D.value D.int8+          tuple <$> D.column D.int8 <*> D.column D.int8           where             tuple !a !b =               (a, b)  queryWithManyRows :: (D.Row (Int64, Int64) -> D.Result result) -> C.Query () result queryWithManyRows decoder =-  C.statement template encoder (decoder rowDecoder) True+  C.Query template encoder (decoder rowDecoder) True   where     template =       "SELECT generate_series(0,1000) as a, generate_series(1000,2000) as b"     encoder =       conquer     rowDecoder =-      tuple <$> D.value D.int8 <*> D.value D.int8+      tuple <$> D.column D.int8 <*> D.column D.int8       where         tuple !a !b =           (a, b)  queryWithManyRowsInVector :: C.Query () (Vector (Int64, Int64)) queryWithManyRowsInVector =-  queryWithManyRows D.rowsVector+  queryWithManyRows D.rowVector  queryWithManyRowsInList :: C.Query () (List (Int64, Int64)) queryWithManyRowsInList =-  queryWithManyRows D.rowsList+  queryWithManyRows D.rowList

@@ -1,7 +1,7 @@ name:   hasql version:-  1.1.1+  1.2 category:   Hasql, Database, PostgreSQL synopsis:@@ -47,11 +47,17 @@     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   default-language:     Haskell2010+  exposed-modules:+    Hasql.Decoders+    Hasql.Encoders+    Hasql.Connection+    Hasql.Query+    Hasql.Session   other-modules:     Hasql.Private.Prelude+    Hasql.Private.Errors     Hasql.Private.PTI     Hasql.Private.IO-    Hasql.Private.Query     Hasql.Private.Session     Hasql.Private.Connection     Hasql.Private.PreparedStatementRegistry@@ -66,12 +72,6 @@     Hasql.Private.Encoders.Array     Hasql.Private.Encoders.Value     Hasql.Private.Encoders.Params-  exposed-modules:-    Hasql.Decoders-    Hasql.Encoders-    Hasql.Connection-    Hasql.Query-    Hasql.Session   build-depends:     -- parsing:     attoparsec >= 0.10 && < 0.14,@@ -85,6 +85,7 @@     vector >= 0.10 && < 0.13,     hashtables >= 1.1 && < 2,     text >= 1 && < 2,+    text-builder >= 0.5.1 && < 0.6,     bytestring >= 0.10 && < 0.11,     hashable >= 1.2 && < 1.3,     -- control:@@ -123,9 +124,9 @@     -- database:     hasql,     -- testing:-    tasty >= 0.12 && < 0.13,-    tasty-quickcheck >= 0.9 && < 0.10,-    tasty-hunit >= 0.9 && < 0.10,+    tasty >= 0.12 && < 2,+    tasty-quickcheck >= 0.9 && < 0.11,+    tasty-hunit >= 0.9 && < 0.11,     quickcheck-instances >= 0.3.11 && < 0.4,     QuickCheck >= 2.8.1 && < 3,     -- general:

@@ -8,16 +8,16 @@   rowsAffected,   singleRow,   -- ** Specialized multi-row results-  maybeRow,-  rowsVector,-  rowsList,+  rowMaybe,+  rowVector,+  rowList,   -- ** Multi-row traversers   foldlRows,   foldrRows,   -- * Row   Row,-  value,-  nullableValue,+  column,+  nullableColumn,   -- * Value   Value,   bool,@@ -49,13 +49,13 @@   custom,   -- * Array   Array,-  arrayDimension,-  arrayValue,-  arrayNullableValue,+  dimension,+  element,+  nullableElement,   -- * Composite   Composite,-  compositeValue,-  compositeNullableValue,+  field,+  nullableField, ) where @@ -82,7 +82,7 @@   deriving (Functor)  -- |--- Decode no value from the result.+-- Decode no column from the result. --  -- Useful for statements like @INSERT@ or @CREATE@. -- @@ -134,28 +134,28 @@ -- | -- Maybe one row or none. -- -{-# INLINABLE maybeRow #-}-maybeRow :: Row a -> Result (Maybe a)-maybeRow (Row row) =+{-# INLINABLE rowMaybe #-}+rowMaybe :: Row a -> Result (Maybe a)+rowMaybe (Row row) =   Result (Results.single (Result.maybe row))  -- | -- Zero or more rows packed into the vector. -- --- It's recommended to prefer this function to 'rowsList',+-- It's recommended to prefer this function to 'rowList', -- since it performs notably better. -- -{-# INLINABLE rowsVector #-}-rowsVector :: Row a -> Result (Vector a)-rowsVector (Row row) =+{-# INLINABLE rowVector #-}+rowVector :: Row a -> Result (Vector a)+rowVector (Row row) =   Result (Results.single (Result.vector row))  -- | -- Zero or more rows packed into the list. -- -{-# INLINABLE rowsList #-}-rowsList :: Row a -> Result [a]-rowsList =+{-# INLINABLE rowList #-}+rowList :: Row a -> Result [a]+rowList =   foldrRows strictCons []  @@ -174,23 +174,23 @@   def =     rowsAffected --- | Maps to @('maybeRow' def)@.+-- | Maps to @('rowMaybe' def)@. instance Default (Row a) => Default (Result (Maybe a)) where   {-# INLINE def #-}   def =-    maybeRow def+    rowMaybe def --- | Maps to @('rowsVector' def)@.+-- | Maps to @('rowVector' def)@. instance Default (Row a) => Default (Result (Vector a)) where   {-# INLINE def #-}   def =-    rowsVector def+    rowVector def --- | Maps to @('rowsList' def)@.+-- | Maps to @('rowList' def)@. instance Default (Row a) => Default (Result ([] a)) where   {-# INLINE def #-}   def =-    rowsList def+    rowList def  -- | Maps to @(fmap Identity ('singleRow' def)@. instance Default (Row a) => Default (Result (Identity a)) where@@ -204,32 +204,32 @@  -- | -- Decoder of an individual row,--- which gets composed of column value decoders.+-- which gets composed of column column decoders. --  -- E.g.: --  -- >x :: Row (Maybe Int64, Text, TimeOfDay) -- >x =--- >  (,,) <$> nullableValue int8 <*> value text <*> value time+-- >  (,,) <$> nullableColumn int8 <*> column text <*> column time --  newtype Row a =   Row (Row.Row a)   deriving (Functor, Applicative, Monad)  -- |--- Lift an individual non-nullable value decoder to a composable row decoder.+-- Lift an individual non-nullable column decoder to a composable row decoder. -- -{-# INLINABLE value #-}-value :: Value a -> Row a-value (Value imp) =+{-# INLINABLE column #-}+column :: Value a -> Row a+column (Value imp) =   Row (Row.nonNullValue imp)  -- |--- Lift an individual nullable value decoder to a composable row decoder.+-- Lift an individual nullable column decoder to a composable row decoder. -- -{-# INLINABLE nullableValue #-}-nullableValue :: Value a -> Row (Maybe a)-nullableValue (Value imp) =+{-# INLINABLE nullableColumn #-}+nullableColumn :: Value a -> Row (Maybe a)+nullableColumn (Value imp) =   Row (Row.value imp)  @@ -239,35 +239,35 @@ instance Default (Value a) => Default (Row (Identity a)) where   {-# INLINE def #-}   def =-    fmap Identity (value def)+    fmap Identity (column def)  instance Default (Value a) => Default (Row (Maybe a)) where   {-# INLINE def #-}   def =-    nullableValue def+    nullableColumn def  instance (Default (Value a1), Default (Value a2)) => Default (Row (a1, a2)) where   {-# INLINE def #-}   def =-    ap (fmap (,) (value def)) (value def)+    ap (fmap (,) (column def)) (column def)   -- * Value -------------------------  -- |--- Decoder of an individual value.+-- Decoder of an individual column. --  newtype Value a =   Value (Value.Value a)   deriving (Functor)  --- ** Plain value decoders+-- ** Plain column decoders -------------------------  -- |--- Decoder of the @BOOL@ values.+-- Decoder of the @BOOL@ columns. --  {-# INLINABLE bool #-} bool :: Value Bool@@ -275,7 +275,7 @@   Value (Value.decoder (const A.bool))  -- |--- Decoder of the @INT2@ values.+-- Decoder of the @INT2@ columns. --  {-# INLINABLE int2 #-} int2 :: Value Int16@@ -283,7 +283,7 @@   Value (Value.decoder (const A.int))  -- |--- Decoder of the @INT4@ values.+-- Decoder of the @INT4@ columns. --  {-# INLINABLE int4 #-} int4 :: Value Int32@@ -291,7 +291,7 @@   Value (Value.decoder (const A.int))  -- |--- Decoder of the @INT8@ values.+-- Decoder of the @INT8@ columns. --  {-# INLINABLE int8 #-} int8 :: Value Int64@@ -300,7 +300,7 @@   Value (Value.decoder (const ({-# SCC "int8.int" #-} A.int)))  -- |--- Decoder of the @FLOAT4@ values.+-- Decoder of the @FLOAT4@ columns. --  {-# INLINABLE float4 #-} float4 :: Value Float@@ -308,7 +308,7 @@   Value (Value.decoder (const A.float4))  -- |--- Decoder of the @FLOAT8@ values.+-- Decoder of the @FLOAT8@ columns. --  {-# INLINABLE float8 #-} float8 :: Value Double@@ -316,7 +316,7 @@   Value (Value.decoder (const A.float8))  -- |--- Decoder of the @NUMERIC@ values.+-- Decoder of the @NUMERIC@ columns. --  {-# INLINABLE numeric #-} numeric :: Value B.Scientific@@ -324,15 +324,15 @@   Value (Value.decoder (const A.numeric))  -- |--- Decoder of the @CHAR@ values.--- Note that it supports UTF-8 values.+-- Decoder of the @CHAR@ columns.+-- Note that it supports UTF-8 columns. {-# INLINABLE char #-} char :: Value Char char =   Value (Value.decoder (const A.char))  -- |--- Decoder of the @TEXT@ values.+-- Decoder of the @TEXT@ columns. --  {-# INLINABLE text #-} text :: Value Text@@ -340,7 +340,7 @@   Value (Value.decoder (const A.text_strict))  -- |--- Decoder of the @BYTEA@ values.+-- Decoder of the @BYTEA@ columns. --  {-# INLINABLE bytea #-} bytea :: Value ByteString@@ -348,7 +348,7 @@   Value (Value.decoder (const A.bytea_strict))  -- |--- Decoder of the @DATE@ values.+-- Decoder of the @DATE@ columns. --  {-# INLINABLE date #-} date :: Value B.Day@@ -356,7 +356,7 @@   Value (Value.decoder (const A.date))  -- |--- Decoder of the @TIMESTAMP@ values.+-- Decoder of the @TIMESTAMP@ columns. --  {-# INLINABLE timestamp #-} timestamp :: Value B.LocalTime@@ -364,22 +364,22 @@   Value (Value.decoder (Prelude.bool A.timestamp_float A.timestamp_int))  -- |--- Decoder of the @TIMESTAMPTZ@ values.+-- Decoder of the @TIMESTAMPTZ@ columns. --  -- /NOTICE/ --  -- Postgres does not store the timezone information of @TIMESTAMPTZ@.--- Instead it stores a UTC value and performs silent conversions+-- Instead it stores a UTC column and performs silent conversions -- to the currently set timezone, when dealt with in the text format. -- However this library bypasses the silent conversions--- and communicates with Postgres using the UTC values directly.+-- and communicates with Postgres using the UTC columns directly. {-# INLINABLE timestamptz #-} timestamptz :: Value B.UTCTime timestamptz =   Value (Value.decoder (Prelude.bool A.timestamptz_float A.timestamptz_int))  -- |--- Decoder of the @TIME@ values.+-- Decoder of the @TIME@ columns. --  {-# INLINABLE time #-} time :: Value B.TimeOfDay@@ -387,20 +387,20 @@   Value (Value.decoder (Prelude.bool A.time_float A.time_int))  -- |--- Decoder of the @TIMETZ@ values.+-- Decoder of the @TIMETZ@ columns. --  -- Unlike in case of @TIMESTAMPTZ@,  -- Postgres does store the timezone information for @TIMETZ@. -- However the Haskell's \"time\" library does not contain any composite type, -- that fits the task, so we use a pair of 'TimeOfDay' and 'TimeZone'--- to represent a value on the Haskell's side.+-- to represent a column on the Haskell's side. {-# INLINABLE timetz #-} timetz :: Value (B.TimeOfDay, B.TimeZone) timetz =   Value (Value.decoder (Prelude.bool A.timetz_float A.timetz_int))  -- |--- Decoder of the @INTERVAL@ values.+-- Decoder of the @INTERVAL@ columns. --  {-# INLINABLE interval #-} interval :: Value B.DiffTime@@ -408,7 +408,7 @@   Value (Value.decoder (Prelude.bool A.interval_float A.interval_int))  -- |--- Decoder of the @UUID@ values.+-- Decoder of the @UUID@ columns. --  {-# INLINABLE uuid #-} uuid :: Value B.UUID@@ -416,7 +416,7 @@   Value (Value.decoder (const A.uuid))  -- |--- Decoder of the @INET@ values.+-- Decoder of the @INET@ columns. -- {-# INLINABLE inet #-} inet :: Value (B.NetAddr B.IP)@@ -424,7 +424,7 @@   Value (Value.decoder (const A.inet))  -- |--- Decoder of the @JSON@ values into a JSON AST.+-- Decoder of the @JSON@ columns into a JSON AST. --  {-# INLINABLE json #-} json :: Value B.Value@@ -432,7 +432,7 @@   Value (Value.decoder (const A.json_ast))  -- |--- Decoder of the @JSON@ values into a raw JSON 'ByteString'.+-- Decoder of the @JSON@ columns into a raw JSON 'ByteString'. --  {-# INLINABLE jsonBytes #-} jsonBytes :: (ByteString -> Either Text a) -> Value a@@ -440,7 +440,7 @@   Value (Value.decoder (const (A.json_bytes fn)))  -- |--- Decoder of the @JSONB@ values into a JSON AST.+-- Decoder of the @JSONB@ columns into a JSON AST. --  {-# INLINABLE jsonb #-} jsonb :: Value B.Value@@ -448,7 +448,7 @@   Value (Value.decoder (const A.jsonb_ast))  -- |--- Decoder of the @JSONB@ values into a raw JSON 'ByteString'.+-- Decoder of the @JSONB@ columns into a raw JSON 'ByteString'. --  {-# INLINABLE jsonbBytes #-} jsonbBytes :: (ByteString -> Either Text a) -> Value a@@ -456,7 +456,7 @@   Value (Value.decoder (const (A.jsonb_bytes fn)))  -- |--- Lifts a custom value decoder function to a 'Value' decoder.+-- Lifts a custom column decoder function to a 'Value' decoder. --  {-# INLINABLE custom #-} custom :: (Bool -> ByteString -> Either Text a) -> Value a@@ -464,7 +464,7 @@   Value (Value.decoderFn fn)  --- ** Composite value decoders+-- ** Composite column decoders -------------------------  -- |@@ -484,9 +484,9 @@   Value (Value.decoder (Composite.run imp))  -- |--- A generic decoder of @HSTORE@ values.+-- A generic decoder of @HSTORE@ columns. -- --- Here's how you can use it to construct a specific value:+-- Here's how you can use it to construct a specific column: --  -- @ -- x :: Value [(Text, Maybe Text)]@@ -500,8 +500,8 @@   Value (Value.decoder (const (A.hstore replicateM A.text_strict A.text_strict)))  -- |--- Given a partial mapping from text to value,--- produces a decoder of that value.+-- Given a partial mapping from text to column,+-- produces a decoder of that column. enum :: (Text -> Maybe a) -> Value a enum mapping =   Value (Value.decoder (const (A.enum mapping)))@@ -643,12 +643,12 @@ -- | -- A generic array decoder. -- --- Here's how you can use it to produce a specific array value decoder:+-- Here's how you can use it to produce a specific array column decoder: --  -- @ -- x :: Value [[Text]] -- x =---   array (arrayDimension 'replicateM' (arrayDimension 'replicateM' (arrayValue text)))+--   array (dimension 'replicateM' (dimension 'replicateM' (element text))) -- @ --  newtype Array a =@@ -663,28 +663,28 @@ --  -- * An implementation of the @replicateM@ function -- (@Control.Monad.'Control.Monad.replicateM'@, @Data.Vector.'Data.Vector.replicateM'@),--- which determines the output value.+-- which determines the output column. -- --- * A decoder of its components, which can be either another 'arrayDimension',--- 'arrayValue' or 'arrayNullableValue'.+-- * A decoder of its components, which can be either another 'dimension',+-- 'element' or 'nullableElement'. -- -{-# INLINABLE arrayDimension #-}-arrayDimension :: (forall m. Monad m => Int -> m a -> m b) -> Array a -> Array b-arrayDimension replicateM (Array imp) =+{-# INLINABLE dimension #-}+dimension :: (forall m. Monad m => Int -> m a -> m b) -> Array a -> Array b+dimension replicateM (Array imp) =   Array (Array.dimension replicateM imp)  -- |--- Lift a 'Value' decoder into an 'Array' decoder for parsing of non-nullable leaf values.-{-# INLINABLE arrayValue #-}-arrayValue :: Value a -> Array a-arrayValue (Value imp) =+-- Lift a 'Value' decoder into an 'Array' decoder for parsing of non-nullable leaf columns.+{-# INLINABLE element #-}+element :: Value a -> Array a+element (Value imp) =   Array (Array.nonNullValue (Value.run imp))  -- |--- Lift a 'Value' decoder into an 'Array' decoder for parsing of nullable leaf values.-{-# INLINABLE arrayNullableValue #-}-arrayNullableValue :: Value a -> Array (Maybe a)-arrayNullableValue (Value imp) =+-- Lift a 'Value' decoder into an 'Array' decoder for parsing of nullable leaf columns.+{-# INLINABLE nullableElement #-}+nullableElement :: Value a -> Array (Maybe a)+nullableElement (Value imp) =   Array (Array.value (Value.run imp))  @@ -692,22 +692,22 @@ -------------------------  -- |--- Composable decoder of composite values (rows, records).+-- Composable decoder of composite columns (rows, records). newtype Composite a =   Composite (Composite.Composite a)   deriving (Functor, Applicative, Monad)  -- |--- Lift a 'Value' decoder into a 'Composite' decoder for parsing of non-nullable leaf values.-{-# INLINABLE compositeValue #-}-compositeValue :: Value a -> Composite a-compositeValue (Value imp) =+-- Lift a 'Value' decoder into a 'Composite' decoder for parsing of non-nullable leaf columns.+{-# INLINABLE field #-}+field :: Value a -> Composite a+field (Value imp) =   Composite (Composite.nonNullValue (Value.run imp))  -- |--- Lift a 'Value' decoder into a 'Composite' decoder for parsing of nullable leaf values.-{-# INLINABLE compositeNullableValue #-}-compositeNullableValue :: Value a -> Composite (Maybe a)-compositeNullableValue (Value imp) =+-- Lift a 'Value' decoder into a 'Composite' decoder for parsing of nullable leaf columns.+{-# INLINABLE nullableField #-}+nullableField :: Value a -> Composite (Maybe a)+nullableField (Value imp) =   Composite (Composite.value (Value.run imp)) 

@@ -5,8 +5,8 @@   -- * Params   Params,   unit,-  value,-  nullableValue,+  param,+  nullableParam,   -- * Value   Value,   bool,@@ -36,9 +36,9 @@   unknown,   -- * Array   Array,-  arrayValue,-  arrayNullableValue,-  arrayDimension,+  element,+  nullableElement,+  dimension,   -- ** Insert Many   -- $insertMany )@@ -47,6 +47,7 @@ import Hasql.Private.Prelude hiding (bool) import qualified PostgreSQL.Binary.Encoding as A import qualified PostgreSQL.Binary.Data as B+import qualified Text.Builder as C import qualified Hasql.Private.Encoders.Params as Params import qualified Hasql.Private.Encoders.Value as Value import qualified Hasql.Private.Encoders.Array as Array@@ -67,7 +68,7 @@ -- someParamsEncoder :: 'Params' (Int64, Maybe Text) -- someParamsEncoder = --   'contramap' 'fst' ('value' 'int8') '<>'---   'contramap' 'snd' ('nullableValue' 'text')+--   'contramap' 'snd' ('nullableParam' 'text') -- @ --  -- As a general solution for tuples of any arity, instead of 'fst' and 'snd',@@ -78,7 +79,7 @@ -- @ -- someParamsEncoder :: 'Params' (Int64, Maybe Text) -- someParamsEncoder =---   'contrazip2' ('value' 'int8') ('nullableValue' 'text')+--   'contrazip2' ('value' 'int8') ('nullableParam' 'text') -- @ --  -- Here's how you can implement encoders for custom composite types:@@ -121,17 +122,17 @@ -- | -- Lift an individual value encoder to a parameters encoder. -- -{-# INLINABLE value #-}-value :: Value a -> Params a-value (Value x) =+{-# INLINABLE param #-}+param :: Value a -> Params a+param (Value x) =   Params (Params.value x)  -- | -- Lift an individual nullable value encoder to a parameters encoder. -- -{-# INLINABLE nullableValue #-}-nullableValue :: Value a -> Params (Maybe a)-nullableValue (Value x) =+{-# INLINABLE nullableParam #-}+nullableParam :: Value a -> Params (Maybe a)+nullableParam (Value x) =   Params (Params.nullableValue x)  @@ -148,27 +149,27 @@ instance Default (Value a) => Default (Params (Identity a)) where   {-# INLINE def #-}   def =-    contramap runIdentity (value def)+    contramap runIdentity (param def)  instance (Default (Value a1), Default (Value a2)) => Default (Params (a1, a2)) where   {-# INLINE def #-}   def =-    contrazip2 (value def) (value def)+    contrazip2 (param def) (param def)  instance (Default (Value a1), Default (Value a2), Default (Value a3)) => Default (Params (a1, a2, a3)) where   {-# INLINE def #-}   def =-    contrazip3 (value def) (value def) (value def)+    contrazip3 (param def) (param def) (param def)  instance (Default (Value a1), Default (Value a2), Default (Value a3), Default (Value a4)) => Default (Params (a1, a2, a3, a4)) where   {-# INLINE def #-}   def =-    contrazip4 (value def) (value def) (value def) (value def)+    contrazip4 (param def) (param def) (param def) (param def)  instance (Default (Value a1), Default (Value a2), Default (Value a3), Default (Value a4), Default (Value a5)) => Default (Params (a1, a2, a3, a4, a5)) where   {-# INLINE def #-}   def =-    contrazip5 (value def) (value def) (value def) (value def) (value def)+    contrazip5 (param def) (param def) (param def) (param def) (param def)   -- * Value Encoder@@ -187,49 +188,49 @@ {-# INLINABLE bool #-} bool :: Value Bool bool =-  Value (Value.unsafePTI PTI.bool (const A.bool))+  Value (Value.unsafePTIWithShow PTI.bool (const A.bool))  -- | -- Encoder of @INT2@ values. {-# INLINABLE int2 #-} int2 :: Value Int16 int2 =-  Value (Value.unsafePTI PTI.int2 (const A.int2_int16))+  Value (Value.unsafePTIWithShow PTI.int2 (const A.int2_int16))  -- | -- Encoder of @INT4@ values. {-# INLINABLE int4 #-} int4 :: Value Int32 int4 =-  Value (Value.unsafePTI PTI.int4 (const A.int4_int32))+  Value (Value.unsafePTIWithShow PTI.int4 (const A.int4_int32))  -- | -- Encoder of @INT8@ values. {-# INLINABLE int8 #-} int8 :: Value Int64 int8 =-  Value (Value.unsafePTI PTI.int8 (const A.int8_int64))+  Value (Value.unsafePTIWithShow PTI.int8 (const A.int8_int64))  -- | -- Encoder of @FLOAT4@ values. {-# INLINABLE float4 #-} float4 :: Value Float float4 =-  Value (Value.unsafePTI PTI.float4 (const A.float4))+  Value (Value.unsafePTIWithShow PTI.float4 (const A.float4))  -- | -- Encoder of @FLOAT8@ values. {-# INLINABLE float8 #-} float8 :: Value Double float8 =-  Value (Value.unsafePTI PTI.float8 (const A.float8))+  Value (Value.unsafePTIWithShow PTI.float8 (const A.float8))  -- | -- Encoder of @NUMERIC@ values. {-# INLINABLE numeric #-} numeric :: Value B.Scientific numeric =-  Value (Value.unsafePTI PTI.numeric (const A.numeric))+  Value (Value.unsafePTIWithShow PTI.numeric (const A.numeric))  -- | -- Encoder of @CHAR@ values.@@ -238,113 +239,115 @@ {-# INLINABLE char #-} char :: Value Char char =-  Value (Value.unsafePTI PTI.text (const A.char_utf8))+  Value (Value.unsafePTIWithShow PTI.text (const A.char_utf8))  -- | -- Encoder of @TEXT@ values. {-# INLINABLE text #-} text :: Value Text text =-  Value (Value.unsafePTI PTI.text (const A.text_strict))+  Value (Value.unsafePTIWithShow PTI.text (const A.text_strict))  -- | -- Encoder of @BYTEA@ values. {-# INLINABLE bytea #-} bytea :: Value ByteString bytea =-  Value (Value.unsafePTI PTI.bytea (const A.bytea_strict))+  Value (Value.unsafePTIWithShow PTI.bytea (const A.bytea_strict))  -- | -- Encoder of @DATE@ values. {-# INLINABLE date #-} date :: Value B.Day date =-  Value (Value.unsafePTI PTI.date (const A.date))+  Value (Value.unsafePTIWithShow PTI.date (const A.date))  -- | -- Encoder of @TIMESTAMP@ values. {-# INLINABLE timestamp #-} timestamp :: Value B.LocalTime timestamp =-  Value (Value.unsafePTI PTI.timestamp (Prelude.bool A.timestamp_float A.timestamp_int))+  Value (Value.unsafePTIWithShow PTI.timestamp (Prelude.bool A.timestamp_float A.timestamp_int))  -- | -- Encoder of @TIMESTAMPTZ@ values. {-# INLINABLE timestamptz #-} timestamptz :: Value B.UTCTime timestamptz =-  Value (Value.unsafePTI PTI.timestamptz (Prelude.bool A.timestamptz_float A.timestamptz_int))+  Value (Value.unsafePTIWithShow PTI.timestamptz (Prelude.bool A.timestamptz_float A.timestamptz_int))  -- | -- Encoder of @TIME@ values. {-# INLINABLE time #-} time :: Value B.TimeOfDay time =-  Value (Value.unsafePTI PTI.time (Prelude.bool A.time_float A.time_int))+  Value (Value.unsafePTIWithShow PTI.time (Prelude.bool A.time_float A.time_int))  -- | -- Encoder of @TIMETZ@ values. {-# INLINABLE timetz #-} timetz :: Value (B.TimeOfDay, B.TimeZone) timetz =-  Value (Value.unsafePTI PTI.timetz (Prelude.bool A.timetz_float A.timetz_int))+  Value (Value.unsafePTIWithShow PTI.timetz (Prelude.bool A.timetz_float A.timetz_int))  -- | -- Encoder of @INTERVAL@ values. {-# INLINABLE interval #-} interval :: Value B.DiffTime interval =-  Value (Value.unsafePTI PTI.interval (Prelude.bool A.interval_float A.interval_int))+  Value (Value.unsafePTIWithShow PTI.interval (Prelude.bool A.interval_float A.interval_int))  -- | -- Encoder of @UUID@ values. {-# INLINABLE uuid #-} uuid :: Value B.UUID uuid =-  Value (Value.unsafePTI PTI.uuid (const A.uuid))+  Value (Value.unsafePTIWithShow PTI.uuid (const A.uuid))  -- | -- Encoder of @INET@ values. {-# INLINABLE inet #-} inet :: Value (B.NetAddr B.IP) inet =-  Value (Value.unsafePTI PTI.inet (const A.inet))+  Value (Value.unsafePTIWithShow PTI.inet (const A.inet))  -- | -- Encoder of @JSON@ values from JSON AST. {-# INLINABLE json #-} json :: Value B.Value json =-  Value (Value.unsafePTI PTI.json (const A.json_ast))+  Value (Value.unsafePTIWithShow PTI.json (const A.json_ast))  -- | -- Encoder of @JSON@ values from raw JSON. {-# INLINABLE jsonBytes #-} jsonBytes :: Value ByteString jsonBytes =-  Value (Value.unsafePTI PTI.json (const A.json_bytes))+  Value (Value.unsafePTIWithShow PTI.json (const A.json_bytes))  -- | -- Encoder of @JSONB@ values from JSON AST. {-# INLINABLE jsonb #-} jsonb :: Value B.Value jsonb =-  Value (Value.unsafePTI PTI.jsonb (const A.jsonb_ast))+  Value (Value.unsafePTIWithShow PTI.jsonb (const A.jsonb_ast))  -- | -- Encoder of @JSONB@ values from raw JSON. {-# INLINABLE jsonbBytes #-} jsonbBytes :: Value ByteString jsonbBytes =-  Value (Value.unsafePTI PTI.jsonb (const A.jsonb_bytes))+  Value (Value.unsafePTIWithShow PTI.jsonb (const A.jsonb_bytes))  -- | -- Unlifts the 'Array' encoder to the plain 'Value' encoder. {-# INLINABLE array #-} array :: Array a -> Value a-array (Array imp) =-  Array.run imp & \(arrayOID, encoder') ->-    Value (Value.Value arrayOID arrayOID encoder')+array (Array (Array.Array valueOID arrayOID arrayEncoder renderer)) =+  let+    encoder env input =+      A.array (PTI.oidWord32 valueOID) (arrayEncoder env input)+    in Value (Value.Value arrayOID arrayOID encoder renderer)  -- | -- Given a function,@@ -353,7 +356,7 @@ {-# INLINABLE enum #-} enum :: (a -> Text) -> Value a enum mapping =-  Value (Value.unsafePTI PTI.text (const (A.text_strict . mapping)))+  Value (Value.unsafePTI PTI.text (const (A.text_strict . mapping)) (C.text . mapping))  -- | -- Identifies the value with the PostgreSQL's \"unknown\" type,@@ -366,7 +369,7 @@ {-# INLINABLE unknown #-} unknown :: Value ByteString unknown =-  Value (Value.unsafePTI PTI.unknown (const A.bytea_strict))+  Value (Value.unsafePTIWithShow PTI.unknown (const A.bytea_strict))   -- ** Instances@@ -491,7 +494,7 @@ --  -- >x :: Value [[Int64]] -- >x =--- >  array (arrayDimension foldl' (arrayDimension foldl' (arrayValue int8)))+-- >  array (dimension foldl' (dimension foldl' (element int8))) --  -- Please note that the PostgreSQL __IN__ keyword does not "accept" an array, but rather a syntactical list of -- values, thus this encoder is not suited for that. Use a **field** = ANY($1) query instead.@@ -501,17 +504,17 @@  -- | -- Lifts the 'Value' encoder into the 'Array' encoder of a non-nullable value.-{-# INLINABLE arrayValue #-}-arrayValue :: Value a -> Array a-arrayValue (Value (Value.Value elementOID arrayOID encoder')) =-  Array (Array.value elementOID arrayOID encoder')+{-# INLINABLE element #-}+element :: Value a -> Array a+element (Value (Value.Value elementOID arrayOID encoder renderer)) =+  Array (Array.value elementOID arrayOID encoder renderer)  -- | -- Lifts the 'Value' encoder into the 'Array' encoder of a nullable value.-{-# INLINABLE arrayNullableValue #-}-arrayNullableValue :: Value a -> Array (Maybe a)-arrayNullableValue (Value (Value.Value elementOID arrayOID encoder')) =-  Array (Array.nullableValue elementOID arrayOID encoder')+{-# INLINABLE nullableElement #-}+nullableElement :: Value a -> Array (Maybe a)+nullableElement (Value (Value.Value elementOID arrayOID encoder renderer)) =+  Array (Array.nullableValue elementOID arrayOID encoder renderer)  -- | -- An encoder of an array dimension,@@ -523,12 +526,12 @@ -- such as @Data.Foldable.'foldl''@, -- which determines the input value. -- --- * A component encoder, which can be either another 'arrayDimension',--- 'arrayValue' or 'arrayNullableValue'.+-- * A component encoder, which can be either another 'dimension',+-- 'element' or 'nullableElement'. -- -{-# INLINABLE arrayDimension #-}-arrayDimension :: (forall a. (a -> b -> a) -> a -> c -> a) -> Array b -> Array c-arrayDimension foldl (Array imp) =+{-# INLINABLE dimension #-}+dimension :: (forall a. (a -> b -> a) -> a -> c -> a) -> Array b -> Array c+dimension foldl (Array imp) =   Array (Array.dimension foldl imp)  -- $insertMany@@ -550,7 +553,7 @@ --         contrazip3 (vector Encoders.uuid) (vector Encoders.float8) (vector Encoders.float8) --         where --           vector value =---             Encoders.value (Encoders.array (Encoders.arrayDimension foldl' (Encoders.arrayValue value)))+--             Encoders.value (Encoders.array (Encoders.dimension foldl' (Encoders.element value))) --       decoder = --         Decoders.unit -- @

@@ -1,6 +1,7 @@ module Hasql.Private.Decoders.Result where  import Hasql.Private.Prelude hiding (maybe, many)+import Hasql.Private.Errors import qualified Database.PostgreSQL.LibPQ as LibPQ import qualified Hasql.Private.Decoders.Row as Row import qualified Data.Attoparsec.ByteString.Char8 as Attoparsec@@ -11,42 +12,11 @@   newtype Result a =-  Result (ReaderT (Bool, LibPQ.Result) (ExceptT Error IO) a)+  Result (ReaderT (Bool, LibPQ.Result) (ExceptT ResultError IO) a)   deriving (Functor, Applicative, Monad) -data Error =-  -- | -  -- An error reported by the DB. Code, message, details, hint.-  -- -  -- * The SQLSTATE code for the error. The SQLSTATE code identifies the type of error that has occurred; -  -- it can be used by front-end applications to perform specific operations (such as error handling) -  -- in response to a particular database error. -  -- For a list of the possible SQLSTATE codes, see Appendix A.-  -- This field is not localizable, and is always present.-  -- -  -- * The primary human-readable error message (typically one line). Always present.-  -- -  -- * Detail: an optional secondary error message carrying more detail about the problem. -  -- Might run to multiple lines.-  -- -  -- * Hint: an optional suggestion what to do about the problem. -  -- This is intended to differ from detail in that it offers advice (potentially inappropriate) -  -- rather than hard facts. Might run to multiple lines.-  ServerError !ByteString !ByteString !(Maybe ByteString) !(Maybe ByteString) |-  -- |-  -- The database returned an unexpected result.-  -- Indicates an improper statement or a schema mismatch.-  UnexpectedResult !Text |-  -- |-  -- An error of the row reader, preceded by the index of the row.-  RowError !Int !Row.Error |-  -- |-  -- An unexpected amount of rows.-  UnexpectedAmountOfRows !Int-  deriving (Show)- {-# INLINE run #-}-run :: Result a -> (Bool, LibPQ.Result) -> IO (Either Error a)+run :: Result a -> (Bool, LibPQ.Result) -> IO (Either ResultError a) run (Result reader) env =   runExceptT (runReaderT reader env) 

@@ -12,6 +12,7 @@ module Hasql.Private.Decoders.Results where  import Hasql.Private.Prelude hiding (maybe, many)+import Hasql.Private.Errors import qualified Database.PostgreSQL.LibPQ as LibPQ import qualified Hasql.Private.Prelude as Prelude import qualified Hasql.Private.Decoders.Result as Result@@ -19,20 +20,12 @@   newtype Results a =-  Results (ReaderT (Bool, LibPQ.Connection) (ExceptT Error IO) a)+  Results (ReaderT (Bool, LibPQ.Connection) (ExceptT CommandError IO) a)   deriving (Functor, Applicative, Monad) -data Error =-  -- |-  -- An error on the client-side,-  -- with a message generated by the \"libpq\" library.-  -- Usually indicates problems with the connection.-  ClientError !(Maybe ByteString) |-  ResultError !Result.Error-  deriving (Show)  {-# INLINE run #-}-run :: Results a -> (Bool, LibPQ.Connection) -> IO (Either Error a)+run :: Results a -> (Bool, LibPQ.Connection) -> IO (Either CommandError a) run (Results stack) env =   runExceptT (runReaderT stack env) 

@@ -1,37 +1,32 @@ module Hasql.Private.Decoders.Row where  import Hasql.Private.Prelude+import Hasql.Private.Errors import qualified Database.PostgreSQL.LibPQ as LibPQ import qualified PostgreSQL.Binary.Decoding as A import qualified Hasql.Private.Decoders.Value as Value   newtype Row a =-  Row (ReaderT Env (ExceptT Error IO) a)+  Row (ReaderT Env (ExceptT RowError IO) a)   deriving (Functor, Applicative, Monad)  data Env =   Env !LibPQ.Result !LibPQ.Row !LibPQ.Column !Bool !(IORef LibPQ.Column) -data Error =-  EndOfInput |-  UnexpectedNull |-  ValueError !Text-  deriving (Show) - -- * Functions -------------------------  {-# INLINE run #-}-run :: Row a -> (LibPQ.Result, LibPQ.Row, LibPQ.Column, Bool) -> IO (Either Error a)+run :: Row a -> (LibPQ.Result, LibPQ.Row, LibPQ.Column, Bool) -> IO (Either RowError a) run (Row impl) (result, row, columnsAmount, integerDatetimes) =   do     columnRef <- newIORef 0     runExceptT (runReaderT impl (Env result row columnsAmount integerDatetimes columnRef))  {-# INLINE error #-}-error :: Error -> Row a+error :: RowError -> Row a error x =   Row (ReaderT (const (ExceptT (pure (Left x))))) 

@@ -3,28 +3,43 @@ import Hasql.Private.Prelude import qualified PostgreSQL.Binary.Encoding as A import qualified Hasql.Private.PTI as B+import qualified Text.Builder as C   data Array a =-  Array B.OID B.OID (Bool -> a -> A.Array)--{-# INLINE run #-}-run :: Array a -> (B.OID, Bool -> a -> A.Encoding)-run (Array valueOID arrayOID encoder) =-  (arrayOID, \env input -> A.array (B.oidWord32 valueOID) (encoder env input))+  Array B.OID B.OID (Bool -> a -> A.Array) (a -> C.Builder)  {-# INLINE value #-}-value :: B.OID -> B.OID -> (Bool -> a -> A.Encoding) -> Array a+value :: B.OID -> B.OID -> (Bool -> a -> A.Encoding) -> (a -> C.Builder) -> Array a value valueOID arrayOID encoder =   Array valueOID arrayOID (\params -> A.encodingArray . encoder params)  {-# INLINE nullableValue #-}-nullableValue :: B.OID -> B.OID -> (Bool -> a -> A.Encoding) -> Array (Maybe a)-nullableValue valueOID arrayOID encoder =-  Array valueOID arrayOID (\params -> maybe A.nullArray (A.encodingArray . encoder params))+nullableValue :: B.OID -> B.OID -> (Bool -> a -> A.Encoding) -> (a -> C.Builder) -> Array (Maybe a)+nullableValue valueOID arrayOID encoder renderer =+  let+    maybeEncoder params =+      maybe A.nullArray (A.encodingArray . encoder params)+    maybeRenderer =+      maybe (C.string "null") renderer+    in Array valueOID arrayOID maybeEncoder maybeRenderer  {-# INLINE dimension #-} dimension :: (forall a. (a -> b -> a) -> a -> c -> a) -> Array b -> Array c-dimension fold (Array valueOID arrayOID encoder) =-  Array valueOID arrayOID (\params -> A.dimensionArray fold (encoder params))-+dimension fold (Array valueOID arrayOID elEncoder elRenderer) =+  let+    encoder el =+      A.dimensionArray fold (elEncoder el)+    renderer els =+      let+        folded =+          let+            step builder el =+              if C.null builder+                then C.char '[' <> elRenderer el+                else builder <> C.string ", " <> elRenderer el+            in fold step mempty els+        in if C.null folded+          then C.string "[]"+          else folded <> C.char ']'+    in Array valueOID arrayOID encoder renderer

@@ -5,52 +5,29 @@ import qualified PostgreSQL.Binary.Encoding as B import qualified Hasql.Private.Encoders.Value as C import qualified Hasql.Private.PTI as D+import qualified Text.Builder as E   -- | -- Encoder of some representation of a parameters product. newtype Params a =-  Params (Op (DList (A.Oid, Bool -> Maybe ByteString)) a)+  Params (Op (DList (A.Oid, A.Format, Bool -> Maybe ByteString, Text)) a)   deriving (Contravariant, Divisible, Decidable, Monoid)  instance Semigroup (Params a) -run :: Params a -> a -> DList (A.Oid, Bool -> Maybe ByteString)-run (Params (Op op)) params =-  {-# SCC "run" #-} -  op params--run' :: Params a -> a -> Bool -> ([A.Oid], [Maybe (ByteString, A.Format)])-run' (Params (Op op)) params integerDatetimes =-  {-# SCC "run'" #-} -  foldr step ([], []) (op params)-  where-    step (oid, bytesGetter) ~(oidList, bytesAndFormatList) =-      (,)-        (oid : oidList)-        (fmap (\bytes -> (bytes, format oid)) (bytesGetter integerDatetimes) : bytesAndFormatList)--run'' :: Params a -> a -> Bool -> [Maybe (A.Oid, ByteString, A.Format)]-run'' (Params (Op op)) params integerDatetimes =-  {-# SCC "run''" #-} -  foldr step [] (op params)-  where-    step a b =-      mapping a : b-      where-        mapping (oid, bytesGetter) =-          (,,) <$> pure oid <*> bytesGetter integerDatetimes <*> pure (format oid)--format :: A.Oid -> A.Format-format oid = case oid of-  A.Oid 705 -> A.Text -- is unknown-  _         -> A.Binary- value :: C.Value a -> Params a value =   contramap Just . nullableValue  nullableValue :: C.Value a -> Params (Maybe a)-nullableValue (C.Value valueOID arrayOID encoder) =-  Params $ Op $ \input -> -    pure (D.oidPQ valueOID, \env -> fmap (B.encodingBytes . encoder env) input)+nullableValue (C.Value valueOID arrayOID encode render) =+  Params $ Op $ \ input ->+  let+    D.OID _ pqOid format =+      valueOID+    encoder env =+      fmap (B.encodingBytes . encode env) input+    rendering =+      maybe "null" (E.run . render) input+    in pure (pqOid, format, encoder, rendering)

@@ -3,24 +3,23 @@ import Hasql.Private.Prelude import qualified PostgreSQL.Binary.Encoding as B import qualified Hasql.Private.PTI as PTI+import qualified Text.Builder as C   data Value a =-  Value PTI.OID PTI.OID (Bool -> a -> B.Encoding)+  Value PTI.OID PTI.OID (Bool -> a -> B.Encoding) (a -> C.Builder)  instance Contravariant Value where   {-# INLINE contramap #-}-  contramap f (Value valueOID arrayOID encoder) =-    Value valueOID arrayOID (\integerDatetimes input -> encoder integerDatetimes (f input))--{-# INLINE run #-}-run :: Value a -> (PTI.OID, PTI.OID, Bool -> a -> B.Encoding)-run (Value valueOID arrayOID encoder') =-  (valueOID, arrayOID, encoder')+  contramap f (Value valueOID arrayOID encode render) =+    Value valueOID arrayOID (\integerDatetimes input -> encode integerDatetimes (f input)) (render . f)  {-# INLINE unsafePTI #-}-unsafePTI :: PTI.PTI -> (Bool -> a -> B.Encoding) -> Value a-unsafePTI pti encoder' =-  Value (PTI.ptiOID pti) (fromMaybe ($bug "No array OID") (PTI.ptiArrayOID pti)) encoder'-+unsafePTI :: PTI.PTI -> (Bool -> a -> B.Encoding) -> (a -> C.Builder) -> Value a+unsafePTI pti =+  Value (PTI.ptiOID pti) (fromMaybe ($bug "No array OID") (PTI.ptiArrayOID pti)) +{-# INLINE unsafePTIWithShow #-}+unsafePTIWithShow :: Show a => PTI.PTI -> (Bool -> a -> B.Encoding) -> Value a+unsafePTIWithShow pti encode =+  unsafePTI pti encode (C.string . show)

@@ -0,0 +1,88 @@+-- |+-- An API for retrieval of multiple results.+-- Can be used to handle:+-- +-- * A single result,+-- +-- * Individual results of a multi-statement query+-- with the help of "Applicative" and "Monad",+-- +-- * Row-by-row fetching.+-- +module Hasql.Private.Errors where++import Hasql.Private.Prelude+++-- |+-- An error during the execution of a query.+-- Comes packed with the query template and a textual representation of the provided params.+data QueryError =+  QueryError ByteString [Text] CommandError+  deriving (Show, Eq)++-- |+-- An error of some command in the session.+data CommandError =+  -- |+  -- An error on the client-side,+  -- with a message generated by the \"libpq\" library.+  -- Usually indicates problems with connection.+  ClientError (Maybe ByteString) |+  -- |+  -- Some error with a command result.+  ResultError ResultError+  deriving (Show, Eq)++-- |+-- An error with a command result.+data ResultError =+  -- | +  -- An error reported by the DB.+  -- Consists of the following: Code, message, details, hint.+  -- +  -- * __Code__.+  -- The SQLSTATE code for the error.+  -- It's recommended to use+  -- <http://hackage.haskell.org/package/postgresql-error-codes the "postgresql-error-codes" package>+  -- to work with those.+  -- +  -- * __Message__.+  -- The primary human-readable error message (typically one line). Always present.+  -- +  -- * __Details__.+  -- An optional secondary error message carrying more detail about the problem. +  -- Might run to multiple lines.+  -- +  -- * __Hint__.+  -- An optional suggestion on what to do about the problem. +  -- This is intended to differ from detail in that it offers advice (potentially inappropriate) +  -- rather than hard facts.+  -- Might run to multiple lines.+  ServerError ByteString ByteString (Maybe ByteString) (Maybe ByteString) |+  -- |+  -- The database returned an unexpected result.+  -- Indicates an improper statement or a schema mismatch.+  UnexpectedResult Text |+  -- |+  -- An error of the row reader, preceded by the index of the row.+  RowError Int RowError |+  -- |+  -- An unexpected amount of rows.+  UnexpectedAmountOfRows Int+  deriving (Show, Eq)++-- |+-- An error during the decoding of a specific row.+data RowError =+  -- |+  -- Appears on the attempt to parse more columns than there are in the result.+  EndOfInput |+  -- |+  -- Appears on the attempt to parse a @NULL@ as some value.+  UnexpectedNull |+  -- |+  -- Appears when a wrong value parser is used.+  -- Comes with the error details.+  ValueError Text+  deriving (Show, Eq)

@@ -4,6 +4,7 @@ where  import Hasql.Private.Prelude+import Hasql.Private.Errors import qualified Database.PostgreSQL.LibPQ as LibPQ import qualified Hasql.Private.Commands as Commands import qualified Hasql.Private.PreparedStatementRegistry as PreparedStatementRegistry@@ -58,7 +59,7 @@   void $ LibPQ.exec c (Commands.asBytes (Commands.setEncodersToUTF8 <> Commands.setMinClientMessagesToWarning))  {-# INLINE getResults #-}-getResults :: LibPQ.Connection -> Bool -> ResultsDecoders.Results a -> IO (Either ResultsDecoders.Error a)+getResults :: LibPQ.Connection -> Bool -> ResultsDecoders.Results a -> IO (Either CommandError a) getResults connection integerDatetimes decoder =   {-# SCC "getResults" #-}    (<*) <$> get <*> dropRemainders@@ -72,7 +73,7 @@ getPreparedStatementKey ::   LibPQ.Connection -> PreparedStatementRegistry.PreparedStatementRegistry ->   ByteString -> [LibPQ.Oid] ->-  IO (Either ResultsDecoders.Error ByteString)+  IO (Either CommandError ByteString) getPreparedStatementKey connection registry template oidList =   {-# SCC "getPreparedStatementKey" #-}    PreparedStatementRegistry.update localKey onNewRemoteKey onOldRemoteKey registry@@ -99,33 +100,50 @@       pure (pure key)  {-# INLINE checkedSend #-}-checkedSend :: LibPQ.Connection -> IO Bool -> IO (Either ResultsDecoders.Error ())+checkedSend :: LibPQ.Connection -> IO Bool -> IO (Either CommandError ()) checkedSend connection send =   send >>= \case-    False -> fmap (Left . ResultsDecoders.ClientError) $ LibPQ.errorMessage connection+    False -> fmap (Left . ClientError) $ LibPQ.errorMessage connection     True -> pure (Right ())  {-# INLINE sendPreparedParametricQuery #-} sendPreparedParametricQuery ::   LibPQ.Connection ->   PreparedStatementRegistry.PreparedStatementRegistry ->+  Bool ->   ByteString ->-  [LibPQ.Oid] ->-  [Maybe (ByteString, LibPQ.Format)] ->-  IO (Either ResultsDecoders.Error ())-sendPreparedParametricQuery connection registry template oidList valueAndFormatList =-  runExceptT $ do-    key <- ExceptT $ getPreparedStatementKey connection registry template oidList-    ExceptT $ checkedSend connection $ LibPQ.sendQueryPrepared connection key valueAndFormatList LibPQ.Binary+  ParamsEncoders.Params a ->+  a ->+  IO (Either CommandError ())+sendPreparedParametricQuery connection registry integerDatetimes template (ParamsEncoders.Params (Op encoderOp)) input =+  let+    (oidList, valueAndFormatList) =+      let+        step (oid, format, encoder, _) ~(oidList, bytesAndFormatList) =+          (,)+            (oid : oidList)+            (fmap (\bytes -> (bytes, format)) (encoder integerDatetimes) : bytesAndFormatList)+        in foldr step ([], []) (encoderOp input)+    in runExceptT $ do+      key <- ExceptT $ getPreparedStatementKey connection registry template oidList+      ExceptT $ checkedSend connection $ LibPQ.sendQueryPrepared connection key valueAndFormatList LibPQ.Binary  {-# INLINE sendUnpreparedParametricQuery #-} sendUnpreparedParametricQuery ::   LibPQ.Connection ->+  Bool ->   ByteString ->-  [Maybe (LibPQ.Oid, ByteString, LibPQ.Format)] ->-  IO (Either ResultsDecoders.Error ())-sendUnpreparedParametricQuery connection template paramList =-  checkedSend connection $ LibPQ.sendQueryParams connection template paramList LibPQ.Binary+  ParamsEncoders.Params a ->+  a ->+  IO (Either CommandError ())+sendUnpreparedParametricQuery connection integerDatetimes template (ParamsEncoders.Params (Op encoderOp)) input =+  let+    params =+      let+        step (oid, format, encoder, _) acc =+          ((,,) <$> pure oid <*> encoder integerDatetimes <*> pure format) : acc+        in foldr step [] (encoderOp input)+    in checkedSend connection $ LibPQ.sendQueryParams connection template params LibPQ.Binary  {-# INLINE sendParametricQuery #-} sendParametricQuery ::@@ -136,24 +154,14 @@   ParamsEncoders.Params a ->   Bool ->   a ->-  IO (Either ResultsDecoders.Error ())+  IO (Either CommandError ()) sendParametricQuery connection integerDatetimes registry template encoder prepared params =   {-# SCC "sendParametricQuery" #-}    if prepared-    then-      let-        (oidList, valueAndFormatList) =-          ParamsEncoders.run' encoder params integerDatetimes-        in-          sendPreparedParametricQuery connection registry template oidList valueAndFormatList-    else-      let-        paramList =-          ParamsEncoders.run'' encoder params integerDatetimes-        in-          sendUnpreparedParametricQuery connection template paramList+    then sendPreparedParametricQuery connection registry integerDatetimes template encoder params+    else sendUnpreparedParametricQuery connection integerDatetimes template encoder params  {-# INLINE sendNonparametricQuery #-}-sendNonparametricQuery :: LibPQ.Connection -> ByteString -> IO (Either ResultsDecoders.Error ())+sendNonparametricQuery :: LibPQ.Connection -> ByteString -> IO (Either CommandError ()) sendNonparametricQuery connection sql =   checkedSend connection $ LibPQ.sendQuery connection sql

@@ -8,87 +8,87 @@ data PTI = PTI { ptiOID :: !OID, ptiArrayOID :: !(Maybe OID) }  -- | A Word32 and a LibPQ representation of an OID-data OID = OID { oidWord32 :: !Word32, oidPQ :: !LibPQ.Oid }+data OID = OID { oidWord32 :: !Word32, oidPQ :: !LibPQ.Oid, oidFormat :: !LibPQ.Format } -mkOID :: Word32 -> OID-mkOID x =-  OID x ((LibPQ.Oid . fromIntegral) x)+mkOID :: LibPQ.Format -> Word32 -> OID+mkOID format x =+  OID x ((LibPQ.Oid . fromIntegral) x) format -mkPTI :: Word32 -> Maybe Word32 -> PTI-mkPTI oid arrayOID =-  PTI (mkOID oid) (fmap mkOID arrayOID)+mkPTI :: LibPQ.Format -> Word32 -> Maybe Word32 -> PTI+mkPTI format oid arrayOID =+  PTI (mkOID format oid) (fmap (mkOID format) arrayOID)   -- * Constants ------------------------- -abstime         = mkPTI 702  (Just 1023)-aclitem         = mkPTI 1033 (Just 1034)-bit             = mkPTI 1560 (Just 1561)-bool            = mkPTI 16   (Just 1000)-box             = mkPTI 603  (Just 1020)-bpchar          = mkPTI 1042 (Just 1014)-bytea           = mkPTI 17   (Just 1001)-char            = mkPTI 18   (Just 1002)-cid             = mkPTI 29   (Just 1012)-cidr            = mkPTI 650  (Just 651)-circle          = mkPTI 718  (Just 719)-cstring         = mkPTI 2275 (Just 1263)-date            = mkPTI 1082 (Just 1182)-daterange       = mkPTI 3912 (Just 3913)-float4          = mkPTI 700  (Just 1021)-float8          = mkPTI 701  (Just 1022)-gtsvector       = mkPTI 3642 (Just 3644)-inet            = mkPTI 869  (Just 1041)-int2            = mkPTI 21   (Just 1005)-int2vector      = mkPTI 22   (Just 1006)-int4            = mkPTI 23   (Just 1007)-int4range       = mkPTI 3904 (Just 3905)-int8            = mkPTI 20   (Just 1016)-int8range       = mkPTI 3926 (Just 3927)-interval        = mkPTI 1186 (Just 1187)-json            = mkPTI 114  (Just 199)-jsonb           = mkPTI 3802 (Just 3807)-line            = mkPTI 628  (Just 629)-lseg            = mkPTI 601  (Just 1018)-macaddr         = mkPTI 829  (Just 1040)-money           = mkPTI 790  (Just 791)-name            = mkPTI 19   (Just 1003)-numeric         = mkPTI 1700 (Just 1231)-numrange        = mkPTI 3906 (Just 3907)-oid             = mkPTI 26   (Just 1028)-oidvector       = mkPTI 30   (Just 1013)-path            = mkPTI 602  (Just 1019)-point           = mkPTI 600  (Just 1017)-polygon         = mkPTI 604  (Just 1027)-record          = mkPTI 2249 (Just 2287)-refcursor       = mkPTI 1790 (Just 2201)-regclass        = mkPTI 2205 (Just 2210)-regconfig       = mkPTI 3734 (Just 3735)-regdictionary   = mkPTI 3769 (Just 3770)-regoper         = mkPTI 2203 (Just 2208)-regoperator     = mkPTI 2204 (Just 2209)-regproc         = mkPTI 24   (Just 1008)-regprocedure    = mkPTI 2202 (Just 2207)-regtype         = mkPTI 2206 (Just 2211)-reltime         = mkPTI 703  (Just 1024)-text            = mkPTI 25   (Just 1009)-tid             = mkPTI 27   (Just 1010)-time            = mkPTI 1083 (Just 1183)-timestamp       = mkPTI 1114 (Just 1115)-timestamptz     = mkPTI 1184 (Just 1185)-timetz          = mkPTI 1266 (Just 1270)-tinterval       = mkPTI 704  (Just 1025)-tsquery         = mkPTI 3615 (Just 3645)-tsrange         = mkPTI 3908 (Just 3909)-tstzrange       = mkPTI 3910 (Just 3911)-tsvector        = mkPTI 3614 (Just 3643)-txid_snapshot   = mkPTI 2970 (Just 2949)-unknown         = mkPTI 705  (Just 705)-uuid            = mkPTI 2950 (Just 2951)-varbit          = mkPTI 1562 (Just 1563)-varchar         = mkPTI 1043 (Just 1015)-void            = mkPTI 2278 Nothing-xid             = mkPTI 28   (Just 1011)-xml             = mkPTI 142  (Just 143)+abstime         = mkPTI LibPQ.Binary 702  (Just 1023)+aclitem         = mkPTI LibPQ.Binary 1033 (Just 1034)+bit             = mkPTI LibPQ.Binary 1560 (Just 1561)+bool            = mkPTI LibPQ.Binary 16   (Just 1000)+box             = mkPTI LibPQ.Binary 603  (Just 1020)+bpchar          = mkPTI LibPQ.Binary 1042 (Just 1014)+bytea           = mkPTI LibPQ.Binary 17   (Just 1001)+char            = mkPTI LibPQ.Binary 18   (Just 1002)+cid             = mkPTI LibPQ.Binary 29   (Just 1012)+cidr            = mkPTI LibPQ.Binary 650  (Just 651)+circle          = mkPTI LibPQ.Binary 718  (Just 719)+cstring         = mkPTI LibPQ.Binary 2275 (Just 1263)+date            = mkPTI LibPQ.Binary 1082 (Just 1182)+daterange       = mkPTI LibPQ.Binary 3912 (Just 3913)+float4          = mkPTI LibPQ.Binary 700  (Just 1021)+float8          = mkPTI LibPQ.Binary 701  (Just 1022)+gtsvector       = mkPTI LibPQ.Binary 3642 (Just 3644)+inet            = mkPTI LibPQ.Binary 869  (Just 1041)+int2            = mkPTI LibPQ.Binary 21   (Just 1005)+int2vector      = mkPTI LibPQ.Binary 22   (Just 1006)+int4            = mkPTI LibPQ.Binary 23   (Just 1007)+int4range       = mkPTI LibPQ.Binary 3904 (Just 3905)+int8            = mkPTI LibPQ.Binary 20   (Just 1016)+int8range       = mkPTI LibPQ.Binary 3926 (Just 3927)+interval        = mkPTI LibPQ.Binary 1186 (Just 1187)+json            = mkPTI LibPQ.Binary 114  (Just 199)+jsonb           = mkPTI LibPQ.Binary 3802 (Just 3807)+line            = mkPTI LibPQ.Binary 628  (Just 629)+lseg            = mkPTI LibPQ.Binary 601  (Just 1018)+macaddr         = mkPTI LibPQ.Binary 829  (Just 1040)+money           = mkPTI LibPQ.Binary 790  (Just 791)+name            = mkPTI LibPQ.Binary 19   (Just 1003)+numeric         = mkPTI LibPQ.Binary 1700 (Just 1231)+numrange        = mkPTI LibPQ.Binary 3906 (Just 3907)+oid             = mkPTI LibPQ.Binary 26   (Just 1028)+oidvector       = mkPTI LibPQ.Binary 30   (Just 1013)+path            = mkPTI LibPQ.Binary 602  (Just 1019)+point           = mkPTI LibPQ.Binary 600  (Just 1017)+polygon         = mkPTI LibPQ.Binary 604  (Just 1027)+record          = mkPTI LibPQ.Binary 2249 (Just 2287)+refcursor       = mkPTI LibPQ.Binary 1790 (Just 2201)+regclass        = mkPTI LibPQ.Binary 2205 (Just 2210)+regconfig       = mkPTI LibPQ.Binary 3734 (Just 3735)+regdictionary   = mkPTI LibPQ.Binary 3769 (Just 3770)+regoper         = mkPTI LibPQ.Binary 2203 (Just 2208)+regoperator     = mkPTI LibPQ.Binary 2204 (Just 2209)+regproc         = mkPTI LibPQ.Binary 24   (Just 1008)+regprocedure    = mkPTI LibPQ.Binary 2202 (Just 2207)+regtype         = mkPTI LibPQ.Binary 2206 (Just 2211)+reltime         = mkPTI LibPQ.Binary 703  (Just 1024)+text            = mkPTI LibPQ.Binary 25   (Just 1009)+tid             = mkPTI LibPQ.Binary 27   (Just 1010)+time            = mkPTI LibPQ.Binary 1083 (Just 1183)+timestamp       = mkPTI LibPQ.Binary 1114 (Just 1115)+timestamptz     = mkPTI LibPQ.Binary 1184 (Just 1185)+timetz          = mkPTI LibPQ.Binary 1266 (Just 1270)+tinterval       = mkPTI LibPQ.Binary 704  (Just 1025)+tsquery         = mkPTI LibPQ.Binary 3615 (Just 3645)+tsrange         = mkPTI LibPQ.Binary 3908 (Just 3909)+tstzrange       = mkPTI LibPQ.Binary 3910 (Just 3911)+tsvector        = mkPTI LibPQ.Binary 3614 (Just 3643)+txid_snapshot   = mkPTI LibPQ.Binary 2970 (Just 2949)+unknown         = mkPTI LibPQ.Text   705  (Just 705)+uuid            = mkPTI LibPQ.Binary 2950 (Just 2951)+varbit          = mkPTI LibPQ.Binary 1562 (Just 1563)+varchar         = mkPTI LibPQ.Binary 1043 (Just 1015)+void            = mkPTI LibPQ.Binary 2278 Nothing+xid             = mkPTI LibPQ.Binary 28   (Just 1011)+xml             = mkPTI LibPQ.Binary 142  (Just 143) 

@@ -1,61 +0,0 @@-module Hasql.Private.Query-where--import Hasql.Private.Prelude-import qualified Database.PostgreSQL.LibPQ as LibPQ-import qualified Hasql.Private.IO as IO-import qualified Hasql.Private.Connection as Connection-import qualified Hasql.Private.Decoders.Results as Decoders.Results-import qualified Hasql.Private.Encoders.Params as Encoders.Params----- |--- An abstraction over parametric queries.--- --- It is composable using--- the standard interfaces of the category theory,--- which it has instances of.--- E.g., here's how you can compose queries--- using the Arrow notation:--- --- @--- -- |--- -- Given an Update query,--- -- which uses the \@fmap (> 0) 'Decoders.Results.rowsAffected'\@ decoder--- -- to detect, whether it had any effect,--- -- and an Insert query,--- -- produces a query which performs Upsert.--- composeUpsert :: Query a Bool -> Query a () -> Query a ()--- composeUpsert update insert =---   proc params -> do---     updated <- update -< params---     if updated---       then 'returnA' -< ()---       else insert -< params--- @-newtype Query a b =-  Query (Kleisli (ReaderT Connection.Connection (ExceptT Decoders.Results.Error IO)) a b)-  deriving (Category, Arrow, ArrowChoice, ArrowLoop, ArrowApply)--instance Functor (Query a) where-  {-# INLINE fmap #-}-  fmap =-    (^<<)--instance Profunctor Query where-  {-# INLINE lmap #-}-  lmap =-    (^>>)-  {-# INLINE rmap #-}-  rmap =-    (^<<)--statement :: ByteString -> Encoders.Params.Params a -> Decoders.Results.Results b -> Bool -> Query a b-statement template encoder decoder preparable =-  Query $ Kleisli $ \params -> -    ReaderT $ \(Connection.Connection pqConnectionRef integerDatetimes registry) -> -      ExceptT $ withMVar pqConnectionRef $ \pqConnection -> do-        r1 <- IO.sendParametricQuery pqConnection integerDatetimes registry template encoder preparable params-        r2 <- IO.getResults pqConnection integerDatetimes decoder-        return $ r1 *> r2-

@@ -2,24 +2,26 @@ where  import Hasql.Private.Prelude+import Hasql.Private.Errors import qualified Database.PostgreSQL.LibPQ as LibPQ import qualified Hasql.Private.Decoders.Results as Decoders.Results import qualified Hasql.Private.Decoders.Result as Decoders.Result+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.Private.Query as Query+import qualified Hasql.Query as Query import qualified Hasql.Private.Connection as Connection   -- | -- A batch of actions to be executed in the context of a database connection. newtype Session a =-  Session (ReaderT Connection.Connection (ExceptT Error IO) a)-  deriving (Functor, Applicative, Monad, MonadError Error, MonadIO)+  Session (ReaderT Connection.Connection (ExceptT QueryError IO) a)+  deriving (Functor, Applicative, Monad, MonadError QueryError, MonadIO)  -- | -- Executes a bunch of commands on the provided connection.-run :: Session a -> Connection.Connection -> IO (Either Error a)+run :: Session a -> Connection.Connection -> IO (Either QueryError a) run (Session impl) connection =   runExceptT $   runReaderT impl connection@@ -31,87 +33,27 @@ sql :: ByteString -> Session () sql sql =   Session $ ReaderT $ \(Connection.Connection pqConnectionRef integerDatetimes registry) ->-    ExceptT $ fmap (mapLeft unsafeCoerce) $ withMVar pqConnectionRef $ \pqConnection -> do+    ExceptT $ fmap (mapLeft (QueryError sql [])) $ withMVar pqConnectionRef $ \pqConnection -> do       r1 <- IO.sendNonparametricQuery pqConnection sql       r2 <- IO.getResults pqConnection integerDatetimes decoder       return $ r1 *> r2   where     decoder =-      Decoders.Results.single $-      Decoders.Result.unit+      Decoders.Results.single Decoders.Result.unit  -- | -- Parameters and a specification of the parametric query to apply them to.-query :: a -> Query.Query a b -> Session b-query input (Query.Query (Kleisli impl)) =-  Session $ unsafeCoerce $ impl input----- * Error------------------------------ |--- An error of some command in the session.-data Error =-  -- |-  -- An error on the client-side,-  -- with a message generated by the \"libpq\" library.-  -- Usually indicates problems with connection.-  ClientError !(Maybe ByteString) |-  -- |-  -- Some error with a command result.-  ResultError !ResultError-  deriving (Show, Eq)---- |--- An error with a command result.-data ResultError =-  -- | -  -- An error reported by the DB.-  -- Consists of the following: Code, message, details, hint.-  -- -  -- * __Code__.-  -- The SQLSTATE code for the error.-  -- It's recommended to use-  -- <http://hackage.haskell.org/package/postgresql-error-codes the "postgresql-error-codes" package>-  -- to work with those.-  -- -  -- * __Message__.-  -- The primary human-readable error message (typically one line). Always present.-  -- -  -- * __Details__.-  -- An optional secondary error message carrying more detail about the problem. -  -- Might run to multiple lines.-  -- -  -- * __Hint__.-  -- An optional suggestion on what to do about the problem. -  -- This is intended to differ from detail in that it offers advice (potentially inappropriate) -  -- rather than hard facts.-  -- Might run to multiple lines.-  ServerError !ByteString !ByteString !(Maybe ByteString) !(Maybe ByteString) |-  -- |-  -- The database returned an unexpected result.-  -- Indicates an improper statement or a schema mismatch.-  UnexpectedResult !Text |-  -- |-  -- An error of the row reader, preceded by the index of the row.-  RowError !Int !RowError |-  -- |-  -- An unexpected amount of rows.-  UnexpectedAmountOfRows !Int-  deriving (Show, Eq)---- |--- An error during the decoding of a specific row.-data RowError =-  -- |-  -- Appears on the attempt to parse more columns than there are in the result.-  EndOfInput |-  -- |-  -- Appears on the attempt to parse a @NULL@ as some value.-  UnexpectedNull |-  -- |-  -- Appears when a wrong value parser is used.-  -- Comes with the error details.-  ValueError !Text-  deriving (Show, Eq)+query :: params -> Query.Query params result -> Session result+query input (Query.Query 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+      r2 <- IO.getResults pqConnection integerDatetimes (unsafeCoerce decoder)+      return $ r1 *> r2+  where+    inputReps =+      let+        Encoders.Params.Params (Op encoderOp) = (unsafeCoerce encoder)+        step (_, _, _, rendering) acc =+          rendering : acc+        in foldr step [] (encoderOp input)

@@ -1,19 +1,11 @@ module Hasql.Query-(-  Query.Query,-  statement,-) where  import Hasql.Private.Prelude-import qualified Hasql.Private.Query as Query-import qualified Hasql.Private.Decoders.Results as Decoders.Results import qualified Hasql.Decoders as Decoders-import qualified Hasql.Private.Encoders.Params as Encoders.Params import qualified Hasql.Encoders as Encoders  - -- | -- A specification of a strictly single-statement query, which can be parameterized and prepared. -- @@ -34,9 +26,9 @@ -- Following is an example of the declaration of a prepared statement with its associated codecs. --  -- @--- selectSum :: Hasql.Query.'Query.Query' (Int64, Int64) Int64+-- selectSum :: Hasql.Query.'Query' (Int64, Int64) Int64 -- selectSum =---   Hasql.Query.'statement' sql encoder decoder True+--   Hasql.Query.'Query' sql encoder decoder True --   where --     sql = --       "select ($1 + $2)"@@ -50,8 +42,14 @@ -- The statement above accepts a product of two parameters of type 'Int64' -- and produces a single result of type 'Int64'. -- -{-# INLINE statement #-}-statement :: ByteString -> Encoders.Params a -> Decoders.Result b -> Bool -> Query.Query a b-statement =-  unsafeCoerce Query.statement+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

@@ -1,15 +1,14 @@ module Hasql.Session (-  Session.Session,-  Session.sql,-  Session.query,+  Session,+  sql,+  query,   -- * Execution-  Session.Error(..),-  Session.ResultError(..),-  Session.RowError(..),-  Session.run,+  run,+  -- * Errors+  module Hasql.Private.Errors, ) where -import qualified Hasql.Private.Session as Session-+import Hasql.Private.Session+import Hasql.Private.Errors

@@ -60,7 +60,7 @@  queryWithSingleRow :: C.Query () (Int64, Int64) queryWithSingleRow =-  C.statement template encoder decoder True+  C.Query template encoder decoder True   where     template =       "SELECT 1, 2"@@ -70,29 +70,29 @@       D.singleRow row       where         row =-          tuple <$> D.value D.int8 <*> D.value D.int8+          tuple <$> D.column D.int8 <*> D.column D.int8           where             tuple !a !b =               (a, b)  queryWithManyRows :: (D.Row (Int64, Int64) -> D.Result result) -> C.Query () result queryWithManyRows decoder =-  C.statement template encoder (decoder rowDecoder) True+  C.Query template encoder (decoder rowDecoder) True   where     template =       "SELECT generate_series(0,1000) as a, generate_series(1000,2000) as b"     encoder =       conquer     rowDecoder =-      tuple <$> D.value D.int8 <*> D.value D.int8+      tuple <$> D.column D.int8 <*> D.column D.int8       where         tuple !a !b =           (a, b)  queryWithManyRowsInVector :: C.Query () (Vector (Int64, Int64)) queryWithManyRowsInVector =-  queryWithManyRows D.rowsVector+  queryWithManyRows D.rowVector  queryWithManyRowsInList :: C.Query () (List (Int64, Int64)) queryWithManyRowsInList =-  queryWithManyRows D.rowsList+  queryWithManyRows D.rowList

@@ -22,15 +22,34 @@   localOption (NumThreads 1) $   testGroup "All tests"   [+    testCase "Failed query" $+    let+      query =+        Query.Query "select true where 1 = any ($1) and $2" encoder decoder True+        where+          encoder =+            contrazip2+              (Encoders.param (Encoders.array (Encoders.dimension foldl' (Encoders.element Encoders.int8))))+              (Encoders.param Encoders.text)+          decoder =+            fmap (maybe False (const True)) (Decoders.rowMaybe (Decoders.column Decoders.bool))+      session =+        Session.query ([3, 7], "a") query+      in do+        x <- Connection.with (Session.run session)+        assertBool (show x) $ case x of+          Right (Left (Session.QueryError "select true where 1 = any ($1) and $2" ["[3, 7]", "\"a\""] _)) -> True+          _ -> False+    ,     testCase "IN simulation" $     let       query =-        Query.statement "select true where 1 = any ($1)" encoder decoder True+        Query.Query "select true where 1 = any ($1)" encoder decoder True         where           encoder =-            Encoders.value (Encoders.array (Encoders.arrayDimension foldl' (Encoders.arrayValue Encoders.int8)))+            Encoders.param (Encoders.array (Encoders.dimension foldl' (Encoders.element Encoders.int8)))           decoder =-            fmap (maybe False (const True)) (Decoders.maybeRow (Decoders.value Decoders.bool))+            fmap (maybe False (const True)) (Decoders.rowMaybe (Decoders.column Decoders.bool))       session =         do           result1 <- Session.query [1, 2] query@@ -43,12 +62,12 @@     testCase "NOT IN simulation" $     let       query =-        Query.statement "select true where 3 <> all ($1)" encoder decoder True+        Query.Query "select true where 3 <> all ($1)" encoder decoder True         where           encoder =-            Encoders.value (Encoders.array (Encoders.arrayDimension foldl' (Encoders.arrayValue Encoders.int8)))+            Encoders.param (Encoders.array (Encoders.dimension foldl' (Encoders.element Encoders.int8)))           decoder =-            fmap (maybe False (const True)) (Decoders.maybeRow (Decoders.value Decoders.bool))+            fmap (maybe False (const True)) (Decoders.rowMaybe (Decoders.column Decoders.bool))       session =         do           result1 <- Session.query [1, 2] query@@ -61,14 +80,14 @@     testCase "Composite decoding" $     let       query =-        Query.statement sql encoder decoder True+        Query.Query sql encoder decoder True         where           sql =             "select (1, true)"           encoder =              Encoders.unit           decoder =-            Decoders.singleRow (Decoders.value (Decoders.composite ((,) <$> Decoders.compositeValue Decoders.int8 <*> Decoders.compositeValue Decoders.bool)))+            Decoders.singleRow (Decoders.column (Decoders.composite ((,) <$> Decoders.field Decoders.int8 <*> Decoders.field Decoders.bool)))       session =         Session.query () query       in do@@ -78,7 +97,7 @@     testCase "Complex composite decoding" $     let       query =-        Query.statement sql encoder decoder True+        Query.Query sql encoder decoder True         where           sql =             "select (1, true) as entity1, ('hello', 3) as entity2"@@ -86,14 +105,14 @@             Encoders.unit           decoder =             Decoders.singleRow $-            (,) <$> Decoders.value entity1 <*> Decoders.value entity2+            (,) <$> Decoders.column entity1 <*> Decoders.column entity2             where               entity1 =                 Decoders.composite $-                (,) <$> Decoders.compositeValue Decoders.int8 <*> Decoders.compositeValue Decoders.bool+                (,) <$> Decoders.field Decoders.int8 <*> Decoders.field Decoders.bool               entity2 =                 Decoders.composite $-                (,) <$> Decoders.compositeValue Decoders.text <*> Decoders.compositeValue Decoders.int8+                (,) <$> Decoders.field Decoders.text <*> Decoders.field Decoders.int8       session =         Session.query () query       in do@@ -111,14 +130,14 @@             Session.query () query             where               query =-                Query.statement sql encoder decoder True+                Query.Query sql encoder decoder True                 where                   sql =                     "select array[]::int8[]"                   encoder =                     Encoders.unit                   decoder =-                    Decoders.singleRow (Decoders.value (Decoders.array (Decoders.arrayDimension replicateM (Decoders.arrayValue Decoders.int8))))+                    Decoders.singleRow (Decoders.column (Decoders.array (Decoders.dimension replicateM (Decoders.element Decoders.int8))))       in io     ,     testCase "Failing prepared statements" $@@ -129,7 +148,7 @@         where           resultTest =             \case-              Right (Left (Session.ResultError (Session.ServerError "26000" _ _ _))) -> False+              Right (Left (Session.QueryError _ _ (Session.ResultError (Session.ServerError "26000" _ _ _)))) -> False               _ -> True           session =             catchError session (const (pure ())) *> session@@ -138,7 +157,7 @@                 Session.query () query                 where                   query =-                    Query.statement sql encoder decoder True+                    Query.Query sql encoder decoder True                     where                       sql =                         "absurd"@@ -161,14 +180,14 @@                 Session.query 1 query                 where                   query =-                    Query.statement sql encoder decoder True+                    Query.Query sql encoder decoder True                     where                       sql =                         "select $1 :: int8"                       encoder =-                        Encoders.value Encoders.int8+                        Encoders.param Encoders.int8                       decoder =-                        Decoders.singleRow $ Decoders.value Decoders.int8+                        Decoders.singleRow $ Decoders.column Decoders.int8               fail =                 catchError (Session.sql "absurd") (const (pure ()))       in io@@ -177,15 +196,15 @@     let       sumQuery :: Query.Query (Int64, Int64) Int64       sumQuery =-        Query.statement sql encoder decoder True+        Query.Query sql encoder decoder True         where           sql =             "select ($1 + $2)"           encoder =-            contramap fst (Encoders.value Encoders.int8) <>-            contramap snd (Encoders.value Encoders.int8)+            contramap fst (Encoders.param Encoders.int8) <>+            contramap snd (Encoders.param Encoders.int8)           decoder =-            Decoders.singleRow (Decoders.value Decoders.int8)+            Decoders.singleRow (Decoders.column Decoders.int8)       sumSession :: Session.Session Int64       sumSession =         Session.sql "begin" *> Session.query (1, 1) sumQuery <* Session.sql "end"@@ -202,15 +221,15 @@     let       sumQuery :: Query.Query (Int64, Int64) Int64       sumQuery =-        Query.statement sql encoder decoder True+        Query.Query sql encoder decoder True         where           sql =             "select ($1 + $2)"           encoder =-            contramap fst (Encoders.value Encoders.int8) <>-            contramap snd (Encoders.value Encoders.int8)+            contramap fst (Encoders.param Encoders.int8) <>+            contramap snd (Encoders.param Encoders.int8)           decoder =-            Decoders.singleRow (Decoders.value Decoders.int8)+            Decoders.singleRow (Decoders.column Decoders.int8)       session :: Session.Session Int64       session =         do@@ -229,14 +248,14 @@         DSL.session $ do           let             query =-              Query.statement sql encoder decoder True+              Query.Query sql encoder decoder True               where                 sql =                   "select $1 = interval '10 seconds'"                 decoder =-                  (Decoders.singleRow (Decoders.value (Decoders.bool)))+                  (Decoders.singleRow (Decoders.column (Decoders.bool)))                 encoder =-                  Encoders.value (Encoders.interval)+                  Encoders.param (Encoders.interval)             in DSL.query (10 :: DiffTime) query       in actualIO >>= \x -> assertEqual (show x) (Right True) x     ,@@ -246,12 +265,12 @@         DSL.session $ do           let             query =-              Query.statement sql encoder decoder True+              Query.Query sql encoder decoder True               where                 sql =                   "select interval '10 seconds'"                 decoder =-                  (Decoders.singleRow (Decoders.value (Decoders.interval)))+                  (Decoders.singleRow (Decoders.column (Decoders.interval)))                 encoder =                   Encoders.unit             in DSL.query () query@@ -263,14 +282,14 @@         DSL.session $ do           let             query =-              Query.statement sql encoder decoder True+              Query.Query sql encoder decoder True               where                 sql =                   "select $1"                 decoder =-                  (Decoders.singleRow (Decoders.value (Decoders.interval)))+                  (Decoders.singleRow (Decoders.column (Decoders.interval)))                 encoder =-                  Encoders.value (Encoders.interval)+                  Encoders.param (Encoders.interval)             in DSL.query (10 :: DiffTime) query       in actualIO >>= \x -> assertEqual (show x) (Right (10 :: DiffTime)) x     ,@@ -280,28 +299,28 @@         DSL.session $ do           let             query =-              Query.statement sql mempty Decoders.unit True+              Query.Query sql mempty Decoders.unit True               where                 sql =                   "drop type if exists mood"             in DSL.query () query           let             query =-              Query.statement sql mempty Decoders.unit True+              Query.Query sql mempty Decoders.unit True               where                 sql =                   "create type mood as enum ('sad', 'ok', 'happy')"             in DSL.query () query           let             query =-              Query.statement sql encoder decoder True+              Query.Query sql encoder decoder True               where                 sql =                   "select $1 = ('ok' :: mood)"                 decoder =-                  (Decoders.singleRow (Decoders.value (Decoders.bool)))+                  (Decoders.singleRow (Decoders.column (Decoders.bool)))                 encoder =-                  Encoders.value (Encoders.unknown)+                  Encoders.param (Encoders.unknown)             in DSL.query "ok" query       in actualIO >>= assertEqual "" (Right True)     ,@@ -311,28 +330,28 @@         DSL.session $ do           let             query =-              Query.statement sql mempty Decoders.unit True+              Query.Query 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           let             query =-              Query.statement sql mempty Decoders.unit True+              Query.Query 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           let             query =-              Query.statement sql encoder decoder True+              Query.Query sql encoder decoder True               where                 sql =                   "select overloaded($1, $2) || overloaded($3, $4, $5)"                 decoder =-                  (Decoders.singleRow (Decoders.value (Decoders.text)))+                  (Decoders.singleRow (Decoders.column (Decoders.text)))                 encoder =-                  contramany (Encoders.value Encoders.unknown)+                  contramany (Encoders.param Encoders.unknown)             in DSL.query ["1", "2", "4", "5", "6"] query       in actualIO >>= assertEqual "" (Right "3456")     ,@@ -342,28 +361,28 @@         DSL.session $ do           let             query =-              Query.statement sql mempty Decoders.unit True+              Query.Query sql mempty Decoders.unit True               where                 sql =                   "drop type if exists mood"             in DSL.query () query           let             query =-              Query.statement sql mempty Decoders.unit True+              Query.Query sql mempty Decoders.unit True               where                 sql =                   "create type mood as enum ('sad', 'ok', 'happy')"             in DSL.query () query           let             query =-              Query.statement sql encoder decoder True+              Query.Query sql encoder decoder True               where                 sql =                   "select ($1 :: mood)"                 decoder =-                  (Decoders.singleRow (Decoders.value (Decoders.enum (Just . id))))+                  (Decoders.singleRow (Decoders.column (Decoders.enum (Just . id))))                 encoder =-                  Encoders.value (Encoders.enum id)+                  Encoders.param (Encoders.enum id)             in DSL.query "ok" query       in actualIO >>= assertEqual "" (Right "ok")     ,@@ -376,26 +395,26 @@               DSL.query "ok" query               where                 query =-                  Query.statement sql encoder decoder True+                  Query.Query sql encoder decoder True                   where                     sql =                       "select $1"                     encoder =-                      Encoders.value Encoders.text+                      Encoders.param Encoders.text                     decoder =-                      (Decoders.singleRow (Decoders.value (Decoders.text)))+                      (Decoders.singleRow (Decoders.column (Decoders.text)))             effect2 =               DSL.query 1 query               where                 query =-                  Query.statement sql encoder decoder True+                  Query.Query sql encoder decoder True                   where                     sql =                       "select $1"                     encoder =-                      Encoders.value Encoders.int8+                      Encoders.param Encoders.int8                     decoder =-                      (Decoders.singleRow (Decoders.value Decoders.int8))+                      (Decoders.singleRow (Decoders.column Decoders.int8))             in (,) <$> effect1 <*> effect2       in actualIO >>= assertEqual "" (Right ("ok", 1))     ,@@ -419,7 +438,7 @@             DSL.query () $ Queries.plain $             "insert into a (name) values ('a')"             deleteRows =-            DSL.query () $ Query.statement sql def decoder False+            DSL.query () $ Query.Query sql def decoder False             where               sql =                 "delete from a"@@ -433,8 +452,8 @@         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.statement "insert into a (v) values ('a') returning id" def (Decoders.singleRow (Decoders.value Decoders.int4)) False-          id2 <- DSL.query () $ Query.statement "insert into a (v) values ('b') returning id" def (Decoders.singleRow (Decoders.value Decoders.int4)) False+          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"           pure (id1, id2)       in assertEqual "" (Right (1, 2)) =<< actualIO

@@ -21,7 +21,7 @@  data SessionError =   ConnectionError (HC.ConnectionError) |-  SessionError (Hasql.Session.Error)+  SessionError (Hasql.Session.QueryError)   deriving (Show, Eq)  session :: Session a -> IO (Either SessionError a)

@@ -9,11 +9,11 @@  def :: ByteString -> HQ.Query () () def sql =-  HQ.statement sql Prelude.def Prelude.def False+  HQ.Query sql Prelude.def Prelude.def False  plain :: ByteString -> HQ.Query () () plain sql =-  HQ.statement sql mempty HD.unit False+  HQ.Query sql mempty HD.unit False  dropType :: ByteString -> HQ.Query () () dropType name =@@ -28,9 +28,9 @@  selectList :: HQ.Query () ([] (Int64, Int64)) selectList =-  HQ.statement sql mempty decoder True+  HQ.Query sql mempty decoder True   where     sql =       "values (1,2), (3,4), (5,6)"     decoder =-      HD.rowsList ((,) <$> HD.value HD.int8 <*> HD.value HD.int8)+      HD.rowList ((,) <$> HD.column HD.int8 <*> HD.column HD.int8)

@@ -8,12 +8,12 @@  selectSleep :: Query Double () selectSleep =-  statement sql encoder decoder True+  Query sql encoder decoder True   where     sql =       "select pg_sleep($1)"     encoder =-      E.value E.float8+      E.param E.float8     decoder =       D.unit