hasql 1.3.0.6 → 1.4

raw patch · 18 files changed

+1118/−1427 lines, 18 filesdep −data-default-classPVP ok

version bump matches the API change (PVP)

Dependencies removed: data-default-class

API changes (from Hackage documentation)

Files

• benchmarks/Main.hs +2/−2
• hasql.cabal +73/−131
• library/Hasql/Decoders.hs +11/−658
• library/Hasql/Encoders.hs +15/−522
• library/Hasql/Private/Decoders.hs +459/−0
• library/Hasql/Private/Decoders/Result.hs +3/−3
• library/Hasql/Private/Decoders/Results.hs +1/−1
• library/Hasql/Private/Encoders.hs +371/−0
• library/Hasql/Private/Encoders/Array.hs +4/−0
• library/Hasql/Private/IO.hs +1/−1
• library/Hasql/Private/Prelude.hs +4/−4
• library/Hasql/Private/Session.hs +5/−4
• library/Hasql/Statement.hs +92/−36
• profiling/Main.hs +2/−2
• tasty/Main.hs +70/−50
• tasty/Main/Prelude.hs +0/−4
• tasty/Main/Statements.hs +3/−7
• threads-test/Main/Statements.hs +2/−2

@@ -79,7 +79,7 @@       D.singleRow row       where         row =-          tuple <$> D.column D.int8 <*> D.column D.int8+          tuple <$> (D.column . D.nonNullable) D.int8 <*> (D.column . D.nonNullable) D.int8           where             tuple !a !b =               (a, b)@@ -93,7 +93,7 @@     encoder =       conquer     rowDecoder =-      tuple <$> D.column D.int8 <*> D.column D.int8+      tuple <$> (D.column . D.nonNullable) D.int8 <*> (D.column . D.nonNullable) D.int8       where         tuple !a !b =           (a, b)

@@ -1,50 +1,29 @@-name:-  hasql-version:-  1.3.0.6-category:-  Hasql, Database, PostgreSQL-synopsis:-  An efficient PostgreSQL driver and a flexible mapping API+name: hasql+version: 1.4+category: Hasql, Database, PostgreSQL+synopsis: An efficient PostgreSQL driver with a flexible mapping API description:   This package is the root of the \"hasql\" ecosystem.   .   The API comes free from all kinds of exceptions. All error-reporting is explicit and is presented using the 'Either' type.-homepage:-  https://github.com/nikita-volkov/hasql -bug-reports:-  https://github.com/nikita-volkov/hasql/issues -author:-  Nikita Volkov <nikita.y.volkov@mail.ru>-maintainer:-  Nikita Volkov <nikita.y.volkov@mail.ru>-copyright:-  (c) 2014, Nikita Volkov-license:-  MIT-license-file:-  LICENSE-build-type:-  Simple-cabal-version:-  >=1.10-+homepage: https://github.com/nikita-volkov/hasql+bug-reports: https://github.com/nikita-volkov/hasql/issues+author: Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer: Nikita Volkov <nikita.y.volkov@mail.ru>+copyright: (c) 2014, Nikita Volkov+license: MIT+license-file: LICENSE+build-type: Simple+cabal-version: >=1.10  source-repository head-  type:-    git-  location:-    git://github.com/nikita-volkov/hasql.git-+  type: git+  location: git://github.com/nikita-volkov/hasql.git  library-  hs-source-dirs:-    library-  ghc-options:-  default-extensions:-    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples-  default-language:-    Haskell2010+  hs-source-dirs: library+  default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language: Haskell2010   exposed-modules:     Hasql.Decoders     Hasql.Encoders@@ -61,143 +40,106 @@     Hasql.Private.PreparedStatementRegistry     Hasql.Private.Settings     Hasql.Private.Commands+    Hasql.Private.Decoders     Hasql.Private.Decoders.Array     Hasql.Private.Decoders.Composite     Hasql.Private.Decoders.Value     Hasql.Private.Decoders.Row     Hasql.Private.Decoders.Result     Hasql.Private.Decoders.Results+    Hasql.Private.Encoders     Hasql.Private.Encoders.Array     Hasql.Private.Encoders.Value     Hasql.Private.Encoders.Params   build-depends:-    -- parsing:-    attoparsec >= 0.10 && < 0.14,-    -- database:-    postgresql-binary >= 0.12.1 && < 0.13,-    postgresql-libpq == 0.9.*,-    -- builders:-    bytestring-strict-builder >= 0.4.5.1 && < 0.5,-    -- data:-    dlist >= 0.7 && < 0.9,-    vector >= 0.10 && < 0.13,-    hashtables >= 1.1 && < 2,-    text >= 1 && < 2,-    text-builder >= 0.6.1.2 && < 0.7,-    bytestring >= 0.10 && < 0.11,-    hashable >= 1.2 && < 2,-    -- control:-    data-default-class >= 0.0.1 && < 0.2,-    profunctors >= 5.1 && < 6,-    contravariant-extras == 0.3.*,-    contravariant >= 1.3 && < 2,-    mtl >= 2 && < 3,-    transformers >= 0.3 && < 0.6,-    -- errors:-    loch-th == 0.2.*,-    placeholders == 0.1.*,-    -- general:-    base-prelude >= 0.1.19 && < 2,-    base >= 4.9 && < 5-+    attoparsec >=0.10 && <0.14,+    base >=4.9 && <5,+    base-prelude >=0.1.19 && <2,+    bytestring >=0.10 && <0.11,+    bytestring-strict-builder >=0.4.5.1 && <0.5,+    contravariant >=1.3 && <2,+    contravariant-extras ==0.3.*,+    dlist >=0.7 && <0.9,+    hashable >=1.2 && <2,+    hashtables >=1.1 && <2,+    loch-th ==0.2.*,+    mtl >=2 && <3,+    placeholders ==0.1.*,+    postgresql-binary >=0.12.1 && <0.13,+    postgresql-libpq ==0.9.*,+    profunctors >=5.1 && <6,+    text >=1 && <2,+    text-builder >=0.6.1.2 && <0.7,+    transformers >=0.3 && <0.6,+    vector >=0.10 && <0.13  test-suite tasty-  type:-    exitcode-stdio-1.0-  hs-source-dirs:-    tasty-  main-is:-    Main.hs+  type: exitcode-stdio-1.0+  hs-source-dirs: tasty+  main-is: Main.hs+  default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language: Haskell2010   other-modules:     Main.DSL     Main.Connection     Main.Statements     Main.Prelude-  default-extensions:-    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples-  default-language:-    Haskell2010   build-depends:-    -- database:     hasql,-    -- testing:-    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:-    data-default-class,-    -- -    rerebase < 2-+    QuickCheck >=2.8.1 && <3,+    quickcheck-instances >=0.3.11 && <0.4,+    rerebase <2,+    tasty >=0.12 && <2,+    tasty-hunit >=0.9 && <0.11,+    tasty-quickcheck >=0.9 && <0.11  test-suite threads-test-  type:-    exitcode-stdio-1.0-  hs-source-dirs:-    threads-test-  main-is:-    Main.hs+  type: exitcode-stdio-1.0+  hs-source-dirs: threads-test+  main-is: Main.hs+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010   other-modules:     Main.Statements   ghc-options:     -O2     -threaded     "-with-rtsopts=-N"-  default-extensions:-    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples-  default-language:-    Haskell2010   build-depends:-    -- database:     hasql,-    --      rebase - benchmark benchmarks-  type: -    exitcode-stdio-1.0-  hs-source-dirs:-    benchmarks-  main-is:-    Main.hs+  type: exitcode-stdio-1.0+  hs-source-dirs: benchmarks+  main-is: Main.hs+  default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language: Haskell2010   ghc-options:     -O2     -threaded     "-with-rtsopts=-N"     -rtsopts     -funbox-strict-fields-  default-extensions:-    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples-  default-language:-    Haskell2010   build-depends:+    bug ==1.*,+    criterion >=1.1 && <2,     hasql,-    -- benchmarking:-    criterion >= 1.1 && < 2,-    -- general:-    bug == 1.*,-    rerebase < 2-+    rerebase <2  test-suite profiling-  type:-    exitcode-stdio-1.0-  hs-source-dirs:-    profiling-  main-is:-    Main.hs+  type: exitcode-stdio-1.0+  hs-source-dirs: profiling+  main-is: Main.hs+  default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language: Haskell2010   ghc-options:     -O2     -threaded     -rtsopts-  default-extensions:-    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples-  default-language:-    Haskell2010   build-depends:+    bug ==1.*,     hasql,-    bug == 1.*,-    rerebase == 1.*+    rerebase ==1.*

@@ -1,10 +1,11 @@--- |--- A DSL for declaration of result decoders.+{-|+A DSL for declaration of result decoders.+-} module Hasql.Decoders (   -- * Result   Result,-  unit,+  noResult,   rowsAffected,   singleRow,   -- ** Specialized multi-row results@@ -17,7 +18,10 @@   -- * Row   Row,   column,-  nullableColumn,+  -- * Nullability+  NullableOrNot,+  nonNullable,+  nullable,   -- * Value   Value,   bool,@@ -43,6 +47,8 @@   jsonb,   jsonbBytes,   array,+  listArray,+  vectorArray,   composite,   hstore,   enum,@@ -51,663 +57,10 @@   Array,   dimension,   element,-  nullableElement,   -- * Composite   Composite,   field,-  nullableField, ) where -import Hasql.Private.Prelude hiding (maybe, bool)-import qualified Data.Vector as Vector-import qualified PostgreSQL.Binary.Decoding as A-import qualified PostgreSQL.Binary.Data as B-import qualified Hasql.Private.Decoders.Results as Results-import qualified Hasql.Private.Decoders.Result as Result-import qualified Hasql.Private.Decoders.Row as Row-import qualified Hasql.Private.Decoders.Value as Value-import qualified Hasql.Private.Decoders.Array as Array-import qualified Hasql.Private.Decoders.Composite as Composite-import qualified Hasql.Private.Prelude as Prelude---- * Result------------------------------ |--- Decoder of a query result.--- -newtype Result a =-  Result (Results.Results a)-  deriving (Functor)---- |--- Decode no value from the result.--- --- Useful for statements like @INSERT@ or @CREATE@.--- -{-# INLINABLE unit #-}-unit :: Result ()-unit =-  Result (Results.single Result.unit)---- |--- Get the amount of rows affected by such statements as--- @UPDATE@ or @DELETE@.--- -{-# INLINABLE rowsAffected #-}-rowsAffected :: Result Int64-rowsAffected =-  Result (Results.single Result.rowsAffected)---- |--- Exactly one row.--- Will raise the 'Hasql.Errors.UnexpectedAmountOfRows' error if it's any other.--- -{-# INLINABLE singleRow #-}-singleRow :: Row a -> Result a-singleRow (Row row) =-  Result (Results.single (Result.single row))---- ** Multi-row traversers------------------------------ |--- Foldl multiple rows.--- -{-# INLINABLE foldlRows #-}-foldlRows :: (a -> b -> a) -> a -> Row b -> Result a-foldlRows step init (Row row) =-  Result (Results.single (Result.foldl step init row))---- |--- Foldr multiple rows.--- -{-# INLINABLE foldrRows #-}-foldrRows :: (b -> a -> a) -> a -> Row b -> Result a-foldrRows step init (Row row) =-  Result (Results.single (Result.foldr step init row))---- ** Specialized multi-row results------------------------------ |--- Maybe one row or none.--- -{-# 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 'rowList',--- since it performs notably better.--- -{-# 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 rowList #-}-rowList :: Row a -> Result [a]-rowList =-  foldrRows strictCons []----- ** Instances------------------------------ | Maps to 'unit'.-instance Default (Result ()) where-  {-# INLINE def #-}-  def =-    unit---- | Maps to 'rowsAffected'.-instance Default (Result Int64) where-  {-# INLINE def #-}-  def =-    rowsAffected---- | Maps to @('rowMaybe' def)@.-instance Default (Row a) => Default (Result (Maybe a)) where-  {-# INLINE def #-}-  def =-    rowMaybe def---- | Maps to @('rowVector' def)@.-instance Default (Row a) => Default (Result (Vector a)) where-  {-# INLINE def #-}-  def =-    rowVector def---- | Maps to @('rowList' def)@.-instance Default (Row a) => Default (Result ([] a)) where-  {-# INLINE def #-}-  def =-    rowList def---- | Maps to @(fmap Identity ('singleRow' def)@.-instance Default (Row a) => Default (Result (Identity a)) where-  {-# INLINE def #-}-  def =-    fmap Identity (singleRow def)----- * Row------------------------------ |--- Decoder of an individual row,--- which gets composed of column value decoders.--- --- E.g.:--- --- >x :: Row (Maybe Int64, Text, TimeOfDay)--- >x =--- >  (,,) <$> 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.--- -{-# 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.--- -{-# INLINABLE nullableColumn #-}-nullableColumn :: Value a -> Row (Maybe a)-nullableColumn (Value imp) =-  Row (Row.value imp)----- ** Instances----------------------------instance Default (Value a) => Default (Row (Identity a)) where-  {-# INLINE def #-}-  def =-    fmap Identity (column def)--instance Default (Value a) => Default (Row (Maybe a)) where-  {-# INLINE def #-}-  def =-    nullableColumn def--instance (Default (Value a1), Default (Value a2)) => Default (Row (a1, a2)) where-  {-# INLINE def #-}-  def =-    ap (fmap (,) (column def)) (column def)----- * Value------------------------------ |--- Decoder of an individual value.--- -newtype Value a =-  Value (Value.Value a)-  deriving (Functor)----- ** Plain value decoders------------------------------ |--- Decoder of the @BOOL@ values.--- -{-# INLINABLE bool #-}-bool :: Value Bool-bool =-  Value (Value.decoder (const A.bool))---- |--- Decoder of the @INT2@ values.--- -{-# INLINABLE int2 #-}-int2 :: Value Int16-int2 =-  Value (Value.decoder (const A.int))---- |--- Decoder of the @INT4@ values.--- -{-# INLINABLE int4 #-}-int4 :: Value Int32-int4 =-  Value (Value.decoder (const A.int))---- |--- Decoder of the @INT8@ values.--- -{-# INLINABLE int8 #-}-int8 :: Value Int64-int8 =-  {-# SCC "int8" #-} -  Value (Value.decoder (const ({-# SCC "int8.int" #-} A.int)))---- |--- Decoder of the @FLOAT4@ values.--- -{-# INLINABLE float4 #-}-float4 :: Value Float-float4 =-  Value (Value.decoder (const A.float4))---- |--- Decoder of the @FLOAT8@ values.--- -{-# INLINABLE float8 #-}-float8 :: Value Double-float8 =-  Value (Value.decoder (const A.float8))---- |--- Decoder of the @NUMERIC@ values.--- -{-# INLINABLE numeric #-}-numeric :: Value B.Scientific-numeric =-  Value (Value.decoder (const A.numeric))---- |--- Decoder of the @CHAR@ values.--- Note that it supports UTF-8 values.-{-# INLINABLE char #-}-char :: Value Char-char =-  Value (Value.decoder (const A.char))---- |--- Decoder of the @TEXT@ values.--- -{-# INLINABLE text #-}-text :: Value Text-text =-  Value (Value.decoder (const A.text_strict))---- |--- Decoder of the @BYTEA@ values.--- -{-# INLINABLE bytea #-}-bytea :: Value ByteString-bytea =-  Value (Value.decoder (const A.bytea_strict))---- |--- Decoder of the @DATE@ values.--- -{-# INLINABLE date #-}-date :: Value B.Day-date =-  Value (Value.decoder (const A.date))---- |--- Decoder of the @TIMESTAMP@ values.--- -{-# INLINABLE timestamp #-}-timestamp :: Value B.LocalTime-timestamp =-  Value (Value.decoder (Prelude.bool A.timestamp_float A.timestamp_int))---- |--- Decoder of the @TIMESTAMPTZ@ values.--- --- /NOTICE/--- --- Postgres does not store the timezone information of @TIMESTAMPTZ@.--- Instead it stores a UTC value 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.-{-# INLINABLE timestamptz #-}-timestamptz :: Value B.UTCTime-timestamptz =-  Value (Value.decoder (Prelude.bool A.timestamptz_float A.timestamptz_int))---- |--- Decoder of the @TIME@ values.--- -{-# INLINABLE time #-}-time :: Value B.TimeOfDay-time =-  Value (Value.decoder (Prelude.bool A.time_float A.time_int))---- |--- Decoder of the @TIMETZ@ values.--- --- 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.-{-# 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.--- -{-# INLINABLE interval #-}-interval :: Value B.DiffTime-interval =-  Value (Value.decoder (Prelude.bool A.interval_float A.interval_int))---- |--- Decoder of the @UUID@ values.--- -{-# INLINABLE uuid #-}-uuid :: Value B.UUID-uuid =-  Value (Value.decoder (const A.uuid))---- |--- Decoder of the @INET@ values.----{-# INLINABLE inet #-}-inet :: Value (B.NetAddr B.IP)-inet =-  Value (Value.decoder (const A.inet))---- |--- Decoder of the @JSON@ values into a JSON AST.--- -{-# INLINABLE json #-}-json :: Value B.Value-json =-  Value (Value.decoder (const A.json_ast))---- |--- Decoder of the @JSON@ values into a raw JSON 'ByteString'.--- -{-# INLINABLE jsonBytes #-}-jsonBytes :: (ByteString -> Either Text a) -> Value a-jsonBytes fn =-  Value (Value.decoder (const (A.json_bytes fn)))---- |--- Decoder of the @JSONB@ values into a JSON AST.--- -{-# INLINABLE jsonb #-}-jsonb :: Value B.Value-jsonb =-  Value (Value.decoder (const A.jsonb_ast))---- |--- Decoder of the @JSONB@ values into a raw JSON 'ByteString'.--- -{-# INLINABLE jsonbBytes #-}-jsonbBytes :: (ByteString -> Either Text a) -> Value a-jsonbBytes fn =-  Value (Value.decoder (const (A.jsonb_bytes fn)))---- |--- Lifts a custom value decoder function to a 'Value' decoder.--- -{-# INLINABLE custom #-}-custom :: (Bool -> ByteString -> Either Text a) -> Value a-custom fn =-  Value (Value.decoderFn fn)----- ** Composite value decoders------------------------------ |--- Lifts the 'Array' decoder to the 'Value' decoder.--- -{-# INLINABLE array #-}-array :: Array a -> Value a-array (Array imp) =-  Value (Value.decoder (Array.run imp))---- |--- Lifts the 'Composite' decoder to the 'Value' decoder.--- -{-# INLINABLE composite #-}-composite :: Composite a -> Value a-composite (Composite imp) =-  Value (Value.decoder (Composite.run imp))---- |--- A generic decoder of @HSTORE@ values.--- --- Here's how you can use it to construct a specific value:--- --- @--- x :: Value [(Text, Maybe Text)]--- x =---   hstore 'replicateM'--- @--- -{-# INLINABLE hstore #-}-hstore :: (forall m. Monad m => Int -> m (Text, Maybe Text) -> m a) -> Value a-hstore replicateM =-  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.-enum :: (Text -> Maybe a) -> Value a-enum mapping =-  Value (Value.decoder (const (A.enum mapping)))----- ** Instances------------------------------ |--- Maps to 'bool'.-instance Default (Value Bool) where-  {-# INLINE def #-}-  def =-    bool---- |--- Maps to 'int2'.-instance Default (Value Int16) where-  {-# INLINE def #-}-  def =-    int2---- |--- Maps to 'int4'.-instance Default (Value Int32) where-  {-# INLINE def #-}-  def =-    int4---- |--- Maps to 'int8'.-instance Default (Value Int64) where-  {-# INLINE def #-}-  def =-    int8---- |--- Maps to 'float4'.-instance Default (Value Float) where-  {-# INLINE def #-}-  def =-    float4---- |--- Maps to 'float8'.-instance Default (Value Double) where-  {-# INLINE def #-}-  def =-    float8---- |--- Maps to 'numeric'.-instance Default (Value B.Scientific) where-  {-# INLINE def #-}-  def =-    numeric---- |--- Maps to 'char'.-instance Default (Value Char) where-  {-# INLINE def #-}-  def =-    char---- |--- Maps to 'text'.-instance Default (Value Text) where-  {-# INLINE def #-}-  def =-    text---- |--- Maps to 'bytea'.-instance Default (Value ByteString) where-  {-# INLINE def #-}-  def =-    bytea---- |--- Maps to 'date'.-instance Default (Value B.Day) where-  {-# INLINE def #-}-  def =-    date---- |--- Maps to 'timestamp'.-instance Default (Value B.LocalTime) where-  {-# INLINE def #-}-  def =-    timestamp---- |--- Maps to 'timestamptz'.-instance Default (Value B.UTCTime) where-  {-# INLINE def #-}-  def =-    timestamptz---- |--- Maps to 'time'.-instance Default (Value B.TimeOfDay) where-  {-# INLINE def #-}-  def =-    time---- |--- Maps to 'timetz'.-instance Default (Value (B.TimeOfDay, B.TimeZone)) where-  {-# INLINE def #-}-  def =-    timetz---- |--- Maps to 'interval'.-instance Default (Value B.DiffTime) where-  {-# INLINE def #-}-  def =-    interval---- |--- Maps to 'uuid'.-instance Default (Value B.UUID) where-  {-# INLINE def #-}-  def =-    uuid---- |--- Maps to 'json'.-instance Default (Value B.Value) where-  {-# INLINE def #-}-  def =-    json----- * Array decoders------------------------------ |--- A generic array decoder.--- --- Here's how you can use it to produce a specific array value decoder:--- --- @--- x :: Value [[Text]]--- x =---   array (dimension 'replicateM' (dimension 'replicateM' (element text)))--- @--- -newtype Array a =-  Array (Array.Array a)-  deriving (Functor)---- |--- A function for parsing a dimension of an array.--- Provides support for multi-dimensional arrays.--- --- Accepts:--- --- * An implementation of the @replicateM@ function--- (@Control.Monad.'Control.Monad.replicateM'@, @Data.Vector.'Data.Vector.replicateM'@),--- which determines the output value.--- --- * A decoder of its components, which can be either another 'dimension',--- 'element' or 'nullableElement'.--- -{-# 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 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 nullableElement #-}-nullableElement :: Value a -> Array (Maybe a)-nullableElement (Value imp) =-  Array (Array.value (Value.run imp))----- * Composite decoders------------------------------ |--- Composable decoder of composite values (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 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 nullableField #-}-nullableField :: Value a -> Composite (Maybe a)-nullableField (Value imp) =-  Composite (Composite.value (Value.run imp))-+import Hasql.Private.Decoders

@@ -1,12 +1,19 @@--- |--- A DSL for declaration of query parameter encoders.+{-|+A DSL for declaration of statement parameter encoders.++For compactness of names all the types defined here imply being an encoder.+E.g., the `Array` type is an __encoder__ of arrays, not the data-structure itself.+-} module Hasql.Encoders (-  -- * Params+  -- * Parameters product   Params,-  unit,+  noParams,   param,-  nullableParam,+  -- * Nullability+  NullableOrNot,+  nonNullable,+  nullable,   -- * Value   Value,   bool,@@ -31,529 +38,15 @@   jsonBytes,   jsonb,   jsonbBytes,-  array,   enum,   unknown,+  array,+  foldableArray,   -- * Array   Array,   element,-  nullableElement,   dimension,-  -- ** Insert Many-  -- $insertMany ) where -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-import qualified Hasql.Private.PTI as PTI-import qualified Hasql.Private.Prelude as Prelude---- * Parameters Product Encoder------------------------------ |--- Encoder of some representation of the parameters product.--- --- Has instances of 'Contravariant', 'Divisible' and 'Monoid',--- which you can use to compose multiple parameters together.--- E.g.,--- --- @--- someParamsEncoder :: 'Params' (Int64, Maybe Text)--- someParamsEncoder =---   'contramap' 'fst' ('param' 'int8') '<>'---   'contramap' 'snd' ('nullableParam' 'text')--- @--- --- As a general solution for tuples of any arity, instead of 'fst' and 'snd',--- consider the functions of the @contrazip@ family--- from the \"contravariant-extras\" package.--- E.g., here's how you can achieve the same as the above:--- --- @--- someParamsEncoder :: 'Params' (Int64, Maybe Text)--- someParamsEncoder =---   'contrazip2' ('param' 'int8') ('nullableParam' 'text')--- @--- --- Here's how you can implement encoders for custom composite types:--- --- @--- data Person =---   Person { name :: Text, gender :: Gender, age :: Int }--- --- data Gender =---   Male | Female--- --- personParams :: 'Params' Person--- personParams =---   'contramap' name ('param' 'text') '<>'---   'contramap' gender ('param' genderValue) '<>'---   'contramap' (fromIntegral . age) ('param' 'int8')--- --- genderValue :: 'Value' Gender--- genderValue =---   'contramap' genderText 'text'---   where---     genderText gender =---       case gender of---         Male -> "male"---         Female -> "female"--- @--- -newtype Params a =-  Params (Params.Params a)-  deriving (Contravariant, Divisible, Decidable, Monoid, Semigroup)---- |--- Encode no parameters.--- -{-# INLINABLE unit #-}-unit :: Params ()-unit =-  Params mempty---- |--- Lift an individual value encoder to a parameters encoder.--- -{-# 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 nullableParam #-}-nullableParam :: Value a -> Params (Maybe a)-nullableParam (Value x) =-  Params (Params.nullableValue x)----- ** Instances------------------------------ |--- Maps to 'unit'.-instance Default (Params ()) where-  {-# INLINE def #-}-  def =-    unit--instance Default (Value a) => Default (Params (Identity a)) where-  {-# INLINE def #-}-  def =-    contramap runIdentity (param def)--instance (Default (Value a1), Default (Value a2)) => Default (Params (a1, a2)) where-  {-# INLINE def #-}-  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 (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 (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 (param def) (param def) (param def) (param def) (param def)----- * Value Encoder------------------------------ |--- An individual value encoder.--- Will be mapped to a single placeholder in the query.--- -newtype Value a =-  Value (Value.Value a)-  deriving (Contravariant)---- |--- Encoder of @BOOL@ values.-{-# INLINABLE bool #-}-bool :: Value Bool-bool =-  Value (Value.unsafePTIWithShow PTI.bool (const A.bool))---- |--- Encoder of @INT2@ values.-{-# INLINABLE int2 #-}-int2 :: Value Int16-int2 =-  Value (Value.unsafePTIWithShow PTI.int2 (const A.int2_int16))---- |--- Encoder of @INT4@ values.-{-# INLINABLE int4 #-}-int4 :: Value Int32-int4 =-  Value (Value.unsafePTIWithShow PTI.int4 (const A.int4_int32))---- |--- Encoder of @INT8@ values.-{-# INLINABLE int8 #-}-int8 :: Value Int64-int8 =-  Value (Value.unsafePTIWithShow PTI.int8 (const A.int8_int64))---- |--- Encoder of @FLOAT4@ values.-{-# INLINABLE float4 #-}-float4 :: Value Float-float4 =-  Value (Value.unsafePTIWithShow PTI.float4 (const A.float4))---- |--- Encoder of @FLOAT8@ values.-{-# INLINABLE float8 #-}-float8 :: Value Double-float8 =-  Value (Value.unsafePTIWithShow PTI.float8 (const A.float8))---- |--- Encoder of @NUMERIC@ values.-{-# INLINABLE numeric #-}-numeric :: Value B.Scientific-numeric =-  Value (Value.unsafePTIWithShow PTI.numeric (const A.numeric))---- |--- Encoder of @CHAR@ values.--- Note that it supports UTF-8 values and--- identifies itself under the @TEXT@ OID because of that.-{-# INLINABLE char #-}-char :: Value Char-char =-  Value (Value.unsafePTIWithShow PTI.text (const A.char_utf8))---- |--- Encoder of @TEXT@ values.-{-# INLINABLE text #-}-text :: Value Text-text =-  Value (Value.unsafePTIWithShow PTI.text (const A.text_strict))---- |--- Encoder of @BYTEA@ values.-{-# INLINABLE bytea #-}-bytea :: Value ByteString-bytea =-  Value (Value.unsafePTIWithShow PTI.bytea (const A.bytea_strict))---- |--- Encoder of @DATE@ values.-{-# INLINABLE date #-}-date :: Value B.Day-date =-  Value (Value.unsafePTIWithShow PTI.date (const A.date))---- |--- Encoder of @TIMESTAMP@ values.-{-# INLINABLE timestamp #-}-timestamp :: Value B.LocalTime-timestamp =-  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.unsafePTIWithShow PTI.timestamptz (Prelude.bool A.timestamptz_float A.timestamptz_int))---- |--- Encoder of @TIME@ values.-{-# INLINABLE time #-}-time :: Value B.TimeOfDay-time =-  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.unsafePTIWithShow PTI.timetz (Prelude.bool A.timetz_float A.timetz_int))---- |--- Encoder of @INTERVAL@ values.-{-# INLINABLE interval #-}-interval :: Value B.DiffTime-interval =-  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.unsafePTIWithShow PTI.uuid (const A.uuid))---- |--- Encoder of @INET@ values.-{-# INLINABLE inet #-}-inet :: Value (B.NetAddr B.IP)-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.unsafePTIWithShow PTI.json (const A.json_ast))---- |--- Encoder of @JSON@ values from raw JSON.-{-# INLINABLE jsonBytes #-}-jsonBytes :: Value ByteString-jsonBytes =-  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.unsafePTIWithShow PTI.jsonb (const A.jsonb_ast))---- |--- Encoder of @JSONB@ values from raw JSON.-{-# INLINABLE jsonbBytes #-}-jsonbBytes :: Value ByteString-jsonbBytes =-  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 (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,--- which maps the value into the textual enum label from the DB side,--- produces a encoder of that value.-{-# INLINABLE enum #-}-enum :: (a -> Text) -> Value a-enum mapping =-  Value (Value.unsafePTI PTI.text (const (A.text_strict . mapping)) (C.text . mapping))---- |--- Identifies the value with the PostgreSQL's \"unknown\" type,--- thus leaving it up to Postgres to infer the actual type of the value.--- --- The value transimitted is any value encoded in the Postgres' Text data format.--- For reference, see the--- <https://www.postgresql.org/docs/10/static/protocol-overview.html#protocol-format-codes Formats and Format Codes>--- section of the Postgres' documentation.-{-# INLINABLE unknown #-}-unknown :: Value ByteString-unknown =-  Value (Value.unsafePTIWithShow PTI.unknown (const A.bytea_strict))----- ** Instances------------------------------ | Maps to 'bool'.-instance Default (Value Bool) where-  {-# INLINE def #-}-  def =-    bool---- | Maps to 'int2'.-instance Default (Value Int16) where-  {-# INLINE def #-}-  def =-    int2---- | Maps to 'int4'.-instance Default (Value Int32) where-  {-# INLINE def #-}-  def =-    int4---- | Maps to 'int8'.-instance Default (Value Int64) where-  {-# INLINE def #-}-  def =-    int8---- | Maps to 'float4'.-instance Default (Value Float) where-  {-# INLINE def #-}-  def =-    float4---- | Maps to 'float8'.-instance Default (Value Double) where-  {-# INLINE def #-}-  def =-    float8---- | Maps to 'numeric'.-instance Default (Value B.Scientific) where-  {-# INLINE def #-}-  def =-    numeric---- | Maps to 'char'.-instance Default (Value Char) where-  {-# INLINE def #-}-  def =-    char---- | Maps to 'text'.-instance Default (Value Text) where-  {-# INLINE def #-}-  def =-    text---- | Maps to 'bytea'.-instance Default (Value ByteString) where-  {-# INLINE def #-}-  def =-    bytea---- | Maps to 'date'.-instance Default (Value B.Day) where-  {-# INLINE def #-}-  def =-    date---- | Maps to 'timestamp'.-instance Default (Value B.LocalTime) where-  {-# INLINE def #-}-  def =-    timestamp---- | Maps to 'timestamptz'.-instance Default (Value B.UTCTime) where-  {-# INLINE def #-}-  def =-    timestamptz---- | Maps to 'time'.-instance Default (Value B.TimeOfDay) where-  {-# INLINE def #-}-  def =-    time---- | Maps to 'timetz'.-instance Default (Value (B.TimeOfDay, B.TimeZone)) where-  {-# INLINE def #-}-  def =-    timetz---- | Maps to 'interval'.-instance Default (Value B.DiffTime) where-  {-# INLINE def #-}-  def =-    interval---- | Maps to 'uuid'.-instance Default (Value B.UUID) where-  {-# INLINE def #-}-  def =-    uuid---- | Maps to 'json'.-instance Default (Value B.Value) where-  {-# INLINE def #-}-  def =-    json----- * Array------------------------------ |--- A generic array encoder.--- --- Here's an example of its usage:--- --- >x :: Value [[Int64]]--- >x =--- >  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.----newtype Array a =-  Array (Array.Array a)---- |--- Lifts the 'Value' encoder into the 'Array' encoder of a non-nullable value.-{-# 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 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,--- which thus provides support for multidimensional arrays.--- --- Accepts:--- --- * An implementation of the left-fold operation,--- such as @Data.Foldable.'foldl''@,--- which determines the input value.--- --- * A component encoder, which can be either another 'dimension',--- 'element' or 'nullableElement'.--- -{-# 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--- It is not currently possible to pass in an array of encodable values--- to use in an 'insert many' statement using Hasql. Instead, PostgreSQL's---  (9.4 or later) `unnest` function can be used to in an analogous way--- to haskell's `zip` function by passing in multiple arrays of values--- to be zipped into the rows we want to insert:------ @---   insertMultipleLocations :: Statement (Vector (UUID, Double, Double)) ()---   insertMultipleLocations =---     statement sql encoder decoder True---     where---       sql =---         "insert into location (id, x, y) select * from unnest ($1, $2, $3)"---       encoder =---         contramap Vector.unzip3 $---         contrazip3 (vector Encoders.uuid) (vector Encoders.float8) (vector Encoders.float8)---         where---           vector value =---             Encoders.param (Encoders.array (Encoders.dimension foldl' (Encoders.element value)))---       decoder =---         Decoders.unit--- @+import Hasql.Private.Encoders

@@ -0,0 +1,459 @@+{-|+A DSL for declaration of result decoders.+-}+module Hasql.Private.Decoders+where++import Hasql.Private.Prelude hiding (maybe, bool)+import qualified Data.Vector as Vector+import qualified PostgreSQL.Binary.Decoding as A+import qualified PostgreSQL.Binary.Data as B+import qualified Hasql.Private.Decoders.Results as Results+import qualified Hasql.Private.Decoders.Result as Result+import qualified Hasql.Private.Decoders.Row as Row+import qualified Hasql.Private.Decoders.Value as Value+import qualified Hasql.Private.Decoders.Array as Array+import qualified Hasql.Private.Decoders.Composite as Composite+import qualified Hasql.Private.Prelude as Prelude+import qualified Data.Vector.Generic as GenericVector++-- * Result+-------------------------++{-|+Decoder of a query result.+-}+newtype Result a = Result (Results.Results a) deriving (Functor)++{-|+Decode no value from the result.++Useful for statements like @INSERT@ or @CREATE@.+-}+{-# INLINABLE noResult #-}+noResult :: Result ()+noResult = Result (Results.single Result.noResult)++{-|+Get the amount of rows affected by such statements as+@UPDATE@ or @DELETE@.+-}+{-# INLINABLE rowsAffected #-}+rowsAffected :: Result Int64+rowsAffected = Result (Results.single Result.rowsAffected)++{-|+Exactly one row.+Will raise the 'Hasql.Errors.UnexpectedAmountOfRows' error if it's any other.+-}+{-# INLINABLE singleRow #-}+singleRow :: Row a -> Result a+singleRow (Row row) = Result (Results.single (Result.single row))++-- ** Multi-row traversers+-------------------------++{-|+Foldl multiple rows.+-}+{-# INLINABLE foldlRows #-}+foldlRows :: (a -> b -> a) -> a -> Row b -> Result a+foldlRows step init (Row row) = Result (Results.single (Result.foldl step init row))++{-|+Foldr multiple rows.+-}+{-# INLINABLE foldrRows #-}+foldrRows :: (b -> a -> a) -> a -> Row b -> Result a+foldrRows step init (Row row) = Result (Results.single (Result.foldr step init row))++-- ** Specialized multi-row results+-------------------------++{-|+Maybe one row or none.+-}+{-# 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 'rowList',+since it performs notably better.+-}+{-# 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 rowList #-}+rowList :: Row a -> Result [a]+rowList = foldrRows strictCons []+++-- * Row+-------------------------++{-|+Decoder of an individual row,+which gets composed of column value decoders.++E.g.:++@+x :: 'Row' (Maybe Int64, Text, TimeOfDay)+x = (,,) '<$>' ('column' . 'nullable') 'int8' '<*>' ('column' . 'nonNullable') 'text' '<*>' ('column' . 'nonNullable') 'time'+@+-}+newtype Row a = Row (Row.Row a)+  deriving (Functor, Applicative, Monad)++{-|+Lift an individual non-nullable value decoder to a composable row decoder.+-}+{-# INLINABLE column #-}+column :: NullableOrNot Value a -> Row a+column = \ case+  NonNullable (Value imp) -> Row (Row.nonNullValue imp)+  Nullable (Value imp) -> Row (Row.value imp)+++-- * Nullability+-------------------------++{-|+Extensional specification of nullability over a generic decoder.+-}+data NullableOrNot decoder a where+  NonNullable :: decoder a -> NullableOrNot decoder a+  Nullable :: decoder a -> NullableOrNot decoder (Maybe a)++{-|+Specify that a decoder produces a non-nullable value.+-}+nonNullable :: decoder a -> NullableOrNot decoder a+nonNullable = NonNullable++{-|+Specify that a decoder produces a nullable value.+-}+nullable :: decoder a -> NullableOrNot decoder (Maybe a)+nullable = Nullable+++-- * Value+-------------------------++{-|+Decoder of a value.+-}+newtype Value a = Value (Value.Value a)+  deriving (Functor)++{-|+Decoder of the @BOOL@ values.+-}+{-# INLINABLE bool #-}+bool :: Value Bool+bool = Value (Value.decoder (const A.bool))++{-|+Decoder of the @INT2@ values.+-}+{-# INLINABLE int2 #-}+int2 :: Value Int16+int2 = Value (Value.decoder (const A.int))++{-|+Decoder of the @INT4@ values.+-}+{-# INLINABLE int4 #-}+int4 :: Value Int32+int4 = Value (Value.decoder (const A.int))++{-|+Decoder of the @INT8@ values.+-}+{-# INLINABLE int8 #-}+int8 :: Value Int64+int8 = {-# SCC "int8" #-}+  Value (Value.decoder (const ({-# SCC "int8.int" #-} A.int)))++{-|+Decoder of the @FLOAT4@ values.+-}+{-# INLINABLE float4 #-}+float4 :: Value Float+float4 = Value (Value.decoder (const A.float4))++{-|+Decoder of the @FLOAT8@ values.+-}+{-# INLINABLE float8 #-}+float8 :: Value Double+float8 = Value (Value.decoder (const A.float8))++{-|+Decoder of the @NUMERIC@ values.+-}+{-# INLINABLE numeric #-}+numeric :: Value B.Scientific+numeric = Value (Value.decoder (const A.numeric))++{-|+Decoder of the @CHAR@ values.+Note that it supports Unicode values.+-}+{-# INLINABLE char #-}+char :: Value Char+char = Value (Value.decoder (const A.char))++{-|+Decoder of the @TEXT@ values.+-}+{-# INLINABLE text #-}+text :: Value Text+text = Value (Value.decoder (const A.text_strict))++{-|+Decoder of the @BYTEA@ values.+-}+{-# INLINABLE bytea #-}+bytea :: Value ByteString+bytea = Value (Value.decoder (const A.bytea_strict))++{-|+Decoder of the @DATE@ values.+-}+{-# INLINABLE date #-}+date :: Value B.Day+date = Value (Value.decoder (const A.date))++{-|+Decoder of the @TIMESTAMP@ values.+-}+{-# INLINABLE timestamp #-}+timestamp :: Value B.LocalTime+timestamp = Value (Value.decoder (Prelude.bool A.timestamp_float A.timestamp_int))++{-|+Decoder of the @TIMESTAMPTZ@ values.++/NOTICE/++Postgres does not store the timezone information of @TIMESTAMPTZ@.+Instead it stores a UTC value 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.+-}+{-# INLINABLE timestamptz #-}+timestamptz :: Value B.UTCTime+timestamptz = Value (Value.decoder (Prelude.bool A.timestamptz_float A.timestamptz_int))++{-|+Decoder of the @TIME@ values.+-}+{-# INLINABLE time #-}+time :: Value B.TimeOfDay+time = Value (Value.decoder (Prelude.bool A.time_float A.time_int))++{-|+Decoder of the @TIMETZ@ values.++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.+-}+{-# 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.+-}+{-# INLINABLE interval #-}+interval :: Value B.DiffTime+interval = Value (Value.decoder (Prelude.bool A.interval_float A.interval_int))++{-|+Decoder of the @UUID@ values.+-}+{-# INLINABLE uuid #-}+uuid :: Value B.UUID+uuid = Value (Value.decoder (const A.uuid))++{-|+Decoder of the @INET@ values.+-}+{-# INLINABLE inet #-}+inet :: Value (B.NetAddr B.IP)+inet = Value (Value.decoder (const A.inet))++{-|+Decoder of the @JSON@ values into a JSON AST.+-}+{-# INLINABLE json #-}+json :: Value B.Value+json = Value (Value.decoder (const A.json_ast))++{-|+Decoder of the @JSON@ values into a raw JSON 'ByteString'.+-}+{-# INLINABLE jsonBytes #-}+jsonBytes :: (ByteString -> Either Text a) -> Value a+jsonBytes fn = Value (Value.decoder (const (A.json_bytes fn)))++{-|+Decoder of the @JSONB@ values into a JSON AST.+-}+{-# INLINABLE jsonb #-}+jsonb :: Value B.Value+jsonb = Value (Value.decoder (const A.jsonb_ast))++{-|+Decoder of the @JSONB@ values into a raw JSON 'ByteString'.+-}+{-# INLINABLE jsonbBytes #-}+jsonbBytes :: (ByteString -> Either Text a) -> Value a+jsonbBytes fn = Value (Value.decoder (const (A.jsonb_bytes fn)))++{-|+Lift a custom value decoder function to a 'Value' decoder.+-}+{-# INLINABLE custom #-}+custom :: (Bool -> ByteString -> Either Text a) -> Value a+custom fn = Value (Value.decoderFn fn)++{-|+A generic decoder of @HSTORE@ values.++Here's how you can use it to construct a specific value:++@+x :: Value [(Text, Maybe Text)]+x = hstore 'replicateM'+@+-}+{-# INLINABLE hstore #-}+hstore :: (forall m. Monad m => Int -> m (Text, Maybe Text) -> m a) -> Value a+hstore replicateM = 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.+-}+enum :: (Text -> Maybe a) -> Value a+enum mapping = Value (Value.decoder (const (A.enum mapping)))++{-|+Lift an 'Array' decoder to a 'Value' decoder.+-}+{-# INLINABLE array #-}+array :: Array a -> Value a+array (Array imp) = Value (Value.decoder (Array.run imp))++{-|+Lift a value decoder of element into a unidimensional array decoder producing a list.++This function is merely a shortcut to the following expression:++@+('array' . 'dimension' Control.Monad.'replicateM' . 'element')+@++Please notice that in case of multidimensional arrays nesting 'listArray' decoder+won't work. You have to explicitly construct the array decoder using 'array'.+-}+{-# INLINE listArray #-}+listArray :: NullableOrNot Value element -> Value [element]+listArray = array . dimension replicateM . element++{-|+Lift a value decoder of element into a unidimensional array decoder producing a generic vector.++This function is merely a shortcut to the following expression:++@+('array' . 'dimension' Data.Vector.Generic.'GenericVector.replicateM' . 'element')+@++Please notice that in case of multidimensional arrays nesting 'vectorArray' decoder+won't work. You have to explicitly construct the array decoder using 'array'.+-}+{-# INLINE vectorArray #-}+vectorArray :: GenericVector.Vector vector element => NullableOrNot Value element -> Value (vector element)+vectorArray = array . dimension GenericVector.replicateM . element++{-|+Lift a 'Composite' decoder to a 'Value' decoder.+-}+{-# INLINABLE composite #-}+composite :: Composite a -> Value a+composite (Composite imp) = Value (Value.decoder (Composite.run imp))+++-- * Array decoders+-------------------------++{-|+A generic array decoder.++Here's how you can use it to produce a specific array value decoder:++@+x :: 'Value' [[Text]]+x = 'array' ('dimension' 'replicateM' ('dimension' 'replicateM' ('element' ('nonNullable' 'text'))))+@+-}+newtype Array a = Array (Array.Array a)+  deriving (Functor)++{-|+A function for parsing a dimension of an array.+Provides support for multi-dimensional arrays.++Accepts:++* An implementation of the @replicateM@ function+(@Control.Monad.'Control.Monad.replicateM'@, @Data.Vector.'Data.Vector.replicateM'@),+which determines the output value.++* A decoder of its components, which can be either another 'dimension' or 'element'.+-}+{-# 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 leaf values.+-}+{-# INLINABLE element #-}+element :: NullableOrNot Value a -> Array a+element = \ case+  NonNullable (Value imp) -> Array (Array.nonNullValue (Value.run imp))+  Nullable (Value imp) -> Array (Array.value (Value.run imp))+++-- * Composite decoders+-------------------------++{-|+Composable decoder of composite values (rows, records).+-}+newtype Composite a = Composite (Composite.Composite a)+  deriving (Functor, Applicative, Monad)++{-|+Lift a 'Value' decoder into a 'Composite' decoder for parsing of component values.+-}+field :: NullableOrNot Value a -> Composite a+field = \ case+  NonNullable (Value imp) -> Composite (Composite.nonNullValue (Value.run imp))+  Nullable (Value imp) -> Composite (Composite.value (Value.run imp))

@@ -20,9 +20,9 @@ run (Result reader) env =   runExceptT (runReaderT reader env) -{-# INLINE unit #-}-unit :: Result ()-unit =+{-# INLINE noResult #-}+noResult :: Result ()+noResult =   checkExecStatus $ \case     LibPQ.CommandOk -> True     LibPQ.TuplesOk -> True

@@ -81,4 +81,4 @@           loop integerDatetimes connection <* checkErrors           where             checkErrors =-              ExceptT $ fmap (mapLeft ResultError) $ Result.run Result.unit (integerDatetimes, result)+              ExceptT $ fmap (mapLeft ResultError) $ Result.run Result.noResult (integerDatetimes, result)

@@ -0,0 +1,371 @@+{-|+A DSL for declaration of query parameter encoders.+-}+module Hasql.Private.Encoders+where++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+import qualified Hasql.Private.PTI as PTI+import qualified Hasql.Private.Prelude as Prelude+++-- * Parameters Product Encoder+-------------------------++{-|+Encoder of some representation of a parameters product.++Has instances of 'Contravariant', 'Divisible' and 'Monoid',+which you can use to compose multiple parameters together.+E.g.,++@+someParamsEncoder :: 'Params' (Int64, Maybe Text)+someParamsEncoder =+  ('fst' '>$<' 'param' ('nonNullable' 'int8')) '<>'+  ('snd' '>$<' 'param' ('nullable' 'text'))+@++As a general solution for tuples of any arity, instead of 'fst' and 'snd',+consider the functions of the @contrazip@ family+from the \"contravariant-extras\" package.+E.g., here's how you can achieve the same as the above:++@+someParamsEncoder :: 'Params' (Int64, Maybe Text)+someParamsEncoder =+  'contrazip2' ('param' ('nonNullable' 'int8')) ('param' ('nullable' 'text'))+@++Here's how you can implement encoders for custom composite types:++@+data Person = Person { name :: Text, gender :: Gender, age :: Int }++data Gender = Male | Female++personParams :: 'Params' Person+personParams =+  (name '>$<' 'param' ('nonNullable' 'text')) '<>'+  (gender '>$<' 'param' ('nonNullable' genderValue)) '<>'+  ('fromIntegral' . age '>$<' 'param' ('nonNullable' 'int8'))++genderValue :: 'Value' Gender+genderValue = 'enum' genderText 'text' where+  genderText gender = case gender of+    Male -> "male"+    Female -> "female"+@+-}+newtype Params a = Params (Params.Params a)+  deriving (Contravariant, Divisible, Decidable, Monoid, Semigroup)++{-|+No parameters. Same as `mempty` and `conquered`.+-}+noParams :: Params ()+noParams = mempty++{-|+Lift a single parameter encoder, with its nullability specified,+associating it with a single placeholder.+-}+param :: NullableOrNot Value a -> Params a+param = \ case+  NonNullable (Value valueEnc) -> Params (Params.value valueEnc)+  Nullable (Value valueEnc) -> Params (Params.nullableValue valueEnc)+++-- * Nullability+-------------------------++{-|+Extensional specification of nullability over a generic encoder.+-}+data NullableOrNot encoder a where+  NonNullable :: encoder a -> NullableOrNot encoder a+  Nullable :: encoder a -> NullableOrNot encoder (Maybe a)++{-|+Specify that an encoder produces a non-nullable value.+-}+nonNullable :: encoder a -> NullableOrNot encoder a+nonNullable = NonNullable++{-|+Specify that an encoder produces a nullable value.+-}+nullable :: encoder a -> NullableOrNot encoder (Maybe a)+nullable = Nullable+++-- * Value+-------------------------++{-|+Value encoder.+-}+newtype Value a = Value (Value.Value a)+  deriving (Contravariant)++{-|+Encoder of @BOOL@ values.+-}+{-# INLINABLE bool #-}+bool :: Value Bool+bool = Value (Value.unsafePTIWithShow PTI.bool (const A.bool))++{-|+Encoder of @INT2@ values.+-}+{-# INLINABLE int2 #-}+int2 :: Value Int16+int2 = Value (Value.unsafePTIWithShow PTI.int2 (const A.int2_int16))++{-|+Encoder of @INT4@ values.+-}+{-# INLINABLE int4 #-}+int4 :: Value Int32+int4 = Value (Value.unsafePTIWithShow PTI.int4 (const A.int4_int32))++{-|+Encoder of @INT8@ values.+-}+{-# INLINABLE int8 #-}+int8 :: Value Int64+int8 = Value (Value.unsafePTIWithShow PTI.int8 (const A.int8_int64))++{-|+Encoder of @FLOAT4@ values.+-}+{-# INLINABLE float4 #-}+float4 :: Value Float+float4 = Value (Value.unsafePTIWithShow PTI.float4 (const A.float4))++{-|+Encoder of @FLOAT8@ values.+-}+{-# INLINABLE float8 #-}+float8 :: Value Double+float8 = Value (Value.unsafePTIWithShow PTI.float8 (const A.float8))++{-|+Encoder of @NUMERIC@ values.+-}+{-# INLINABLE numeric #-}+numeric :: Value B.Scientific+numeric = Value (Value.unsafePTIWithShow PTI.numeric (const A.numeric))++{-|+Encoder of @CHAR@ values.++Note that it supports Unicode values and+identifies itself under the @TEXT@ OID because of that.+-}+{-# INLINABLE char #-}+char :: Value Char+char = Value (Value.unsafePTIWithShow PTI.text (const A.char_utf8))++{-|+Encoder of @TEXT@ values.+-}+{-# INLINABLE text #-}+text :: Value Text+text = Value (Value.unsafePTIWithShow PTI.text (const A.text_strict))++{-|+Encoder of @BYTEA@ values.+-}+{-# INLINABLE bytea #-}+bytea :: Value ByteString+bytea = Value (Value.unsafePTIWithShow PTI.bytea (const A.bytea_strict))++{-|+Encoder of @DATE@ values.+-}+{-# INLINABLE date #-}+date :: Value B.Day+date = Value (Value.unsafePTIWithShow PTI.date (const A.date))++{-|+Encoder of @TIMESTAMP@ values.+-}+{-# INLINABLE timestamp #-}+timestamp :: Value B.LocalTime+timestamp = 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.unsafePTIWithShow PTI.timestamptz (Prelude.bool A.timestamptz_float A.timestamptz_int))++{-|+Encoder of @TIME@ values.+-}+{-# INLINABLE time #-}+time :: Value B.TimeOfDay+time = 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.unsafePTIWithShow PTI.timetz (Prelude.bool A.timetz_float A.timetz_int))++{-|+Encoder of @INTERVAL@ values.+-}+{-# INLINABLE interval #-}+interval :: Value B.DiffTime+interval = 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.unsafePTIWithShow PTI.uuid (const A.uuid))++{-|+Encoder of @INET@ values.+-}+{-# INLINABLE inet #-}+inet :: Value (B.NetAddr B.IP)+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.unsafePTIWithShow PTI.json (const A.json_ast))++{-|+Encoder of @JSON@ values from raw JSON.+-}+{-# INLINABLE jsonBytes #-}+jsonBytes :: Value ByteString+jsonBytes = 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.unsafePTIWithShow PTI.jsonb (const A.jsonb_ast))++{-|+Encoder of @JSONB@ values from raw JSON.+-}+{-# INLINABLE jsonbBytes #-}+jsonbBytes :: Value ByteString+jsonbBytes = Value (Value.unsafePTIWithShow PTI.jsonb (const A.jsonb_bytes))++{-|+Given a function,+which maps a value into a textual enum label used on the DB side,+produces an encoder of that value.+-}+{-# INLINABLE enum #-}+enum :: (a -> Text) -> Value a+enum mapping = Value (Value.unsafePTI PTI.text (const (A.text_strict . mapping)) (C.text . mapping))++{-|+Identifies the value with the PostgreSQL's \"unknown\" type,+thus leaving it up to Postgres to infer the actual type of the value.++The value transimitted is any value encoded in the Postgres' Text data format.+For reference, see the+<https://www.postgresql.org/docs/10/static/protocol-overview.html#protocol-format-codes Formats and Format Codes>+section of the Postgres' documentation.+-}+{-# INLINABLE unknown #-}+unknown :: Value ByteString+unknown = Value (Value.unsafePTIWithShow PTI.unknown (const A.bytea_strict))++{-|+Lift an array encoder into a parameter encoder.+-}+array :: Array a -> Value a+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)++{-|+Lift a value encoder of element into a unidimensional array encoder of a foldable value.++E.g.,++@+vectorOfInts :: Value (Vector Int64)+vectorOfInts = 'foldableArray' ('nonNullable' 'int8')+@++This function is merely a shortcut to the following expression:++@+('array' . 'dimension' 'foldl'' . 'element')+@++Please notice that in case of multidimensional arrays nesting 'foldableArray' encoder+won't work. You have to explicitly construct the array encoder using 'array'.+-}+{-# INLINE foldableArray #-}+foldableArray :: Foldable foldable => NullableOrNot Value element -> Value (foldable element)+foldableArray = array . dimension foldl' . element+++-- * Array+-------------------------++{-|+Generic array encoder.++Here's an example of its usage:++@+someParamsEncoder :: 'Params' [[Int64]]+someParamsEncoder = 'param' ('nonNullable' ('array' ('dimension' 'foldl'' ('dimension' 'foldl'' ('element' ('nonNullable' '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 @value = ANY($1)@ condition instead.+-}+newtype Array a = Array (Array.Array a)+  deriving (Contravariant)++{-|+Lifts a 'Value' encoder into an 'Array' encoder.+-}+element :: NullableOrNot Value a -> Array a+element = \ case+  NonNullable (Value (Value.Value elementOID arrayOID encoder renderer)) ->+    Array (Array.value elementOID arrayOID encoder renderer)+  Nullable (Value (Value.Value elementOID arrayOID encoder renderer)) ->+    Array (Array.nullableValue elementOID arrayOID encoder renderer)++{-|+Encoder of an array dimension,+which thus provides support for multidimensional arrays.++Accepts:++* An implementation of the left-fold operation,+such as @Data.Foldable.'foldl''@,+which determines the input value.++* A component encoder, which can be either another 'dimension' or 'element'.+-}+{-# INLINABLE dimension #-}+dimension :: (forall a. (a -> b -> a) -> a -> c -> a) -> Array b -> Array c+dimension foldl (Array imp) = Array (Array.dimension foldl imp)

@@ -9,6 +9,10 @@ data Array a =   Array B.OID B.OID (Bool -> a -> A.Array) (a -> C.Builder) +instance Contravariant Array where+  contramap fn (Array valueOid arrayOid encoder renderer) =+    Array valueOid arrayOid (\ intDateTimes -> encoder intDateTimes . fn) (renderer . fn)+ {-# INLINE value #-} value :: B.OID -> B.OID -> (Bool -> a -> A.Encoding) -> (a -> C.Builder) -> Array a value valueOID arrayOID encoder =

@@ -88,7 +88,7 @@         sent <- LibPQ.sendPrepare connection key template (mfilter (not . null) (Just oidList))         let resultsDecoder =                if sent-                then ResultsDecoders.single ResultDecoders.unit+                then ResultsDecoders.single ResultDecoders.noResult                 else ResultsDecoders.clientError         fmap resultsMapping $ getResults connection undefined resultsDecoder       where

@@ -36,10 +36,6 @@ ------------------------- import Control.Monad.Error.Class as Exports (MonadError (..)) --- data-default-class---------------------------import Data.Default.Class as Exports- -- profunctors ------------------------- import Data.Profunctor.Unsafe as Exports@@ -84,6 +80,10 @@ -- loch-th ------------------------- import Debug.Trace.LocationTH as Exports++-- postgresql-binary+-------------------------+import PostgreSQL.Binary.Data as Exports (UUID)  -- custom -------------------------

@@ -7,6 +7,7 @@ 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.Encoders as Encoders import qualified Hasql.Private.Settings as Settings import qualified Hasql.Private.IO as IO import qualified Hasql.Statement as Statement@@ -39,21 +40,21 @@       return $ r1 *> r2   where     decoder =-      Decoders.Results.single Decoders.Result.unit+      Decoders.Results.single Decoders.Result.noResult  -- | -- Parameters and a specification of a parametric single-statement query to apply them to. statement :: params -> Statement.Statement params result -> Session result-statement input (Statement.Statement template encoder decoder preparable) =+statement input (Statement.Statement template (Encoders.Params paramsEncoder) decoder preparable) =   Session $ ReaderT $ \(Connection.Connection pqConnectionRef integerDatetimes registry) ->     ExceptT $ fmap (mapLeft (QueryError template inputReps)) $ withMVar pqConnectionRef $ \pqConnection -> do-      r1 <- IO.sendParametricStatement pqConnection integerDatetimes registry template (unsafeCoerce encoder) preparable input+      r1 <- IO.sendParametricStatement pqConnection integerDatetimes registry template paramsEncoder preparable input       r2 <- IO.getResults pqConnection integerDatetimes (unsafeCoerce decoder)       return $ r1 *> r2   where     inputReps =       let-        Encoders.Params.Params (Op encoderOp) = (unsafeCoerce encoder)+        Encoders.Params.Params (Op encoderOp) = paramsEncoder         step (_, _, _, rendering) acc =           rendering : acc         in foldr step [] (encoderOp input)

@@ -1,47 +1,53 @@ module Hasql.Statement+(+  Statement(..),+  -- * Recipies++  -- ** Insert many+  -- $insertMany++  -- ** IN and NOT IN+  -- $inAndNotIn+) where  import Hasql.Private.Prelude import qualified Hasql.Decoders as Decoders import qualified Hasql.Encoders as Encoders +{-|+Specification of a strictly single-statement query, which can be parameterized and prepared. --- |--- A specification of a strictly single-statement query, which can be parameterized and prepared.--- --- Consists of the following:--- --- * SQL template,--- * params encoder,--- * result decoder,--- * a flag, determining whether it should be prepared.--- --- The SQL template must be formatted according to Postgres' standard,--- with any non-ASCII characters of the template encoded using UTF-8.--- According to the format,--- parameters must be referred to using the positional notation, as in the following:--- @$1@, @$2@, @$3@ and etc.--- Those references must be used to refer to the values of the 'Encoders.Params' encoder.--- --- Following is an example of the declaration of a prepared statement with its associated codecs.--- --- @--- selectSum :: Hasql.Statement.'Statement' (Int64, Int64) Int64--- selectSum =---   Hasql.Statement.'Statement' sql encoder decoder True---   where---     sql =---       "select ($1 + $2)"---     encoder =---       'contramap' 'fst' (Hasql.Encoders.'Hasql.Encoders.param' Hasql.Encoders.'Hasql.Encoders.int8') '<>'---       'contramap' 'snd' (Hasql.Encoders.'Hasql.Encoders.param' Hasql.Encoders.'Hasql.Encoders.int8')---     decoder =---       Hasql.Decoders.'Hasql.Decoders.singleRow' (Hasql.Decoders.'Hasql.Decoders.column' Hasql.Decoders.'Hasql.Decoders.int8')--- @--- --- The statement above accepts a product of two parameters of type 'Int64'--- and produces a single result of type 'Int64'.--- +Consists of the following:++* SQL template,+* params encoder,+* result decoder,+* a flag, determining whether it should be prepared.++The SQL template must be formatted according to Postgres' standard,+with any non-ASCII characters of the template encoded using UTF-8.+According to the format,+parameters must be referred to using a positional notation, as in the following:+@$1@, @$2@, @$3@ and etc.+Those references must be used in accordance to the order in which the according+value encoders are specified in 'Encoders.Params'.++Following is an example of a declaration of a prepared statement with its associated codecs.++@+selectSum :: 'Statement' (Int64, Int64) Int64+selectSum = 'Statement' sql encoder decoder True where+  sql = "select ($1 + $2)"+  encoder =+    ('fst' '>$<' Encoders.'Hasql.Encoders.param' (Encoders.'Hasql.Encoders.nonNullable' Encoders.'Hasql.Encoders.int8')) '<>'+    ('snd' '>$<' Encoders.'Hasql.Encoders.param' (Encoders.'Hasql.Encoders.nullable' Encoders.'Hasql.Encoders.text'))+  decoder = Decoders.'Hasql.Decoders.singleRow' (Decoders.'Hasql.Decoders.column' (Decoders.'Hasql.Decoders.nonNullable' Decoders.'Hasql.Decoders.int8'))+@++The statement above accepts a product of two parameters of type 'Int64'+and produces a single result of type 'Int64'.+-} data Statement a b =   Statement ByteString (Encoders.Params a) (Decoders.Result b) Bool @@ -53,3 +59,53 @@   {-# INLINE dimap #-}   dimap f1 f2 (Statement template encoder decoder preparable) =     Statement template (contramap f1 encoder) (fmap f2 decoder) preparable+++{- $insertMany++It is not currently possible to pass in an array of encodable values+to use in an insert many statement. Instead, PostgreSQL's+(9.4 or later) @unnest@ function can be used in an analogous way+to haskell's `zip` function by passing in multiple arrays of values+to be zipped into the rows we want to insert:++@+insertMultipleLocations :: 'Statement' (Vector (UUID, Double, Double)) ()+insertMultipleLocations = 'Statement' sql encoder decoder True where+  sql = "insert into location (id, x, y) select * from unnest ($1, $2, $3)"+  encoder =+    contramap Vector.'Data.Vector.unzip3' $+    contrazip3 (vector Encoders.'Encoders.uuid') (vector Encoders.'Encoders.float8') (vector Encoders.'Encoders.float8')+    where+      vector =+        Encoders.'Encoders.param' .+        Encoders.'Encoders.nonNullable' .+        Encoders.'Encoders.array' .+        Encoders.'Encoders.dimension' 'foldl'' .+        Encoders.'Encoders.element' .+        Encoders.'Encoders.nonNullable'+  decoder = Decoders.'Decoders.noResult'+@++This approach is much more efficient than executing a single-row Insert+statement multiple times.+-}++{- $inAndNotIn++There is a common misconception that Postgresql supports array+as a parameter for the @IN@ operator.+However Postgres only supports a syntactical list of values with it,+i.e., you have to specify each option as an individual parameter+(@something IN ($1, $2, $3)@).++Clearly it would be much more convenient to provide an array as a single parameter,+but the @IN@ operator does not support that.+Fortunately, Postgres does provide such functionality with other operators:++* Use @something = ANY($1)@ instead of @something IN ($1)@+* Use @something <> ALL($1)@ instead of @something NOT IN ($1)@++For details see+<https://www.postgresql.org/docs/9.6/static/functions-comparisons.html#AEN20944 the Postgresql docs>.+-}

@@ -70,7 +70,7 @@       D.singleRow row       where         row =-          tuple <$> D.column D.int8 <*> D.column D.int8+          tuple <$> (D.column . D.nonNullable) D.int8 <*> (D.column . D.nonNullable) D.int8           where             tuple !a !b =               (a, b)@@ -84,7 +84,7 @@     encoder =       conquer     rowDecoder =-      tuple <$> D.column D.int8 <*> D.column D.int8+      tuple <$> (D.column . D.nonNullable) D.int8 <*> (D.column . D.nonNullable) D.int8       where         tuple !a !b =           (a, b)

@@ -22,6 +22,26 @@   localOption (NumThreads 1) $   testGroup "All tests"   [+    testGroup "Roundtrips" $ let+      roundtrip encoder decoder input = let+        session = let+          statement = Statement.Statement "select $1" encoder decoder True+          in Session.statement input statement+        in unsafePerformIO $ do+          x <- Connection.with (Session.run session)+          return (Right (Right input) === x)+      in [+          testProperty "Array" $ let+            encoder = Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8)))))+            decoder = Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.array (Decoders.dimension replicateM (Decoders.element (Decoders.nonNullable Decoders.int8))))))+            in roundtrip encoder decoder+          ,+          testProperty "2D Array" $ let+            encoder = Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8))))))+            decoder = Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.array (Decoders.dimension replicateM (Decoders.dimension replicateM (Decoders.element (Decoders.nonNullable Decoders.int8)))))))+            in \ list -> list /= [] ==> roundtrip encoder decoder (replicate 3 list)+        ]+    ,     testCase "Failed query" $     let       statement =@@ -29,10 +49,10 @@         where           encoder =             contrazip2-              (Encoders.param (Encoders.array (Encoders.dimension foldl' (Encoders.element Encoders.int8))))-              (Encoders.param Encoders.text)+              (Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8))))))+              (Encoders.param (Encoders.nonNullable (Encoders.text)))           decoder =-            fmap (maybe False (const True)) (Decoders.rowMaybe (Decoders.column Decoders.bool))+            fmap (maybe False (const True)) (Decoders.rowMaybe ((Decoders.column . Decoders.nonNullable) Decoders.bool))       session =         Session.statement ([3, 7], "a") statement       in do@@ -47,9 +67,9 @@         Statement.Statement "select true where 1 = any ($1)" encoder decoder True         where           encoder =-            Encoders.param (Encoders.array (Encoders.dimension foldl' (Encoders.element Encoders.int8)))+            Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8)))))           decoder =-            fmap (maybe False (const True)) (Decoders.rowMaybe (Decoders.column Decoders.bool))+            fmap (maybe False (const True)) (Decoders.rowMaybe ((Decoders.column . Decoders.nonNullable) Decoders.bool))       session =         do           result1 <- Session.statement [1, 2] statement@@ -65,9 +85,9 @@         Statement.Statement "select true where 3 <> all ($1)" encoder decoder True         where           encoder =-            Encoders.param (Encoders.array (Encoders.dimension foldl' (Encoders.element Encoders.int8)))+            Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8)))))           decoder =-            fmap (maybe False (const True)) (Decoders.rowMaybe (Decoders.column Decoders.bool))+            fmap (maybe False (const True)) (Decoders.rowMaybe ((Decoders.column . Decoders.nonNullable) Decoders.bool))       session =         do           result1 <- Session.statement [1, 2] statement@@ -85,9 +105,9 @@           sql =             "select (1, true)"           encoder = -            Encoders.unit+            mempty           decoder =-            Decoders.singleRow (Decoders.column (Decoders.composite ((,) <$> Decoders.field Decoders.int8 <*> Decoders.field Decoders.bool)))+            Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.composite ((,) <$> (Decoders.field . Decoders.nonNullable) Decoders.int8 <*> (Decoders.field . Decoders.nonNullable) Decoders.bool)))       session =         Session.statement () statement       in do@@ -102,17 +122,17 @@           sql =             "select (1, true) as entity1, ('hello', 3) as entity2"           encoder =-            Encoders.unit+            mempty           decoder =             Decoders.singleRow $-            (,) <$> Decoders.column entity1 <*> Decoders.column entity2+            (,) <$> (Decoders.column . Decoders.nonNullable) entity1 <*> (Decoders.column . Decoders.nonNullable) entity2             where               entity1 =                 Decoders.composite $-                (,) <$> Decoders.field Decoders.int8 <*> Decoders.field Decoders.bool+                (,) <$> (Decoders.field . Decoders.nonNullable) Decoders.int8 <*> (Decoders.field . Decoders.nonNullable) Decoders.bool               entity2 =                 Decoders.composite $-                (,) <$> Decoders.field Decoders.text <*> Decoders.field Decoders.int8+                (,) <$> (Decoders.field . Decoders.nonNullable) Decoders.text <*> (Decoders.field . Decoders.nonNullable) Decoders.int8       session =         Session.statement () statement       in do@@ -135,9 +155,9 @@                   sql =                     "select array[]::int8[]"                   encoder =-                    Encoders.unit+                    mempty                   decoder =-                    Decoders.singleRow (Decoders.column (Decoders.array (Decoders.dimension replicateM (Decoders.element Decoders.int8))))+                    Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.array (Decoders.dimension replicateM (Decoders.element (Decoders.nonNullable Decoders.int8)))))       in io     ,     testCase "Failing prepared statements" $@@ -162,9 +182,9 @@                       sql =                         "absurd"                       encoder =-                        Encoders.unit+                        mempty                       decoder =-                        Decoders.unit+                        Decoders.noResult       in io     ,     testCase "Prepared statements after error" $@@ -185,9 +205,9 @@                       sql =                         "select $1 :: int8"                       encoder =-                        Encoders.param Encoders.int8+                        Encoders.param (Encoders.nonNullable (Encoders.int8))                       decoder =-                        Decoders.singleRow $ Decoders.column Decoders.int8+                        Decoders.singleRow $ (Decoders.column . Decoders.nonNullable) Decoders.int8               fail =                 catchError (Session.sql "absurd") (const (pure ()))       in io@@ -201,10 +221,10 @@           sql =             "select ($1 + $2)"           encoder =-            contramap fst (Encoders.param Encoders.int8) <>-            contramap snd (Encoders.param Encoders.int8)+            contramap fst (Encoders.param (Encoders.nonNullable (Encoders.int8))) <>+            contramap snd (Encoders.param (Encoders.nonNullable (Encoders.int8)))           decoder =-            Decoders.singleRow (Decoders.column Decoders.int8)+            Decoders.singleRow ((Decoders.column . Decoders.nonNullable) Decoders.int8)       sumSession :: Session.Session Int64       sumSession =         Session.sql "begin" *> Session.statement (1, 1) sumStatement <* Session.sql "end"@@ -226,10 +246,10 @@           sql =             "select ($1 + $2)"           encoder =-            contramap fst (Encoders.param Encoders.int8) <>-            contramap snd (Encoders.param Encoders.int8)+            contramap fst (Encoders.param (Encoders.nonNullable (Encoders.int8))) <>+            contramap snd (Encoders.param (Encoders.nonNullable (Encoders.int8)))           decoder =-            Decoders.singleRow (Decoders.column Decoders.int8)+            Decoders.singleRow ((Decoders.column . Decoders.nonNullable) Decoders.int8)       session :: Session.Session Int64       session =         do@@ -253,9 +273,9 @@                 sql =                   "select $1 = interval '10 seconds'"                 decoder =-                  (Decoders.singleRow (Decoders.column (Decoders.bool)))+                  (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.bool)))                 encoder =-                  Encoders.param (Encoders.interval)+                  Encoders.param (Encoders.nonNullable (Encoders.interval))             in DSL.statement (10 :: DiffTime) statement       in actualIO >>= \x -> assertEqual (show x) (Right True) x     ,@@ -270,9 +290,9 @@                 sql =                   "select interval '10 seconds'"                 decoder =-                  (Decoders.singleRow (Decoders.column (Decoders.interval)))+                  (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.interval)))                 encoder =-                  Encoders.unit+                  Encoders.noParams             in DSL.statement () statement       in actualIO >>= \x -> assertEqual (show x) (Right (10 :: DiffTime)) x     ,@@ -287,9 +307,9 @@                 sql =                   "select $1"                 decoder =-                  (Decoders.singleRow (Decoders.column (Decoders.interval)))+                  (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.interval)))                 encoder =-                  Encoders.param (Encoders.interval)+                  Encoders.param (Encoders.nonNullable (Encoders.interval))             in DSL.statement (10 :: DiffTime) statement       in actualIO >>= \x -> assertEqual (show x) (Right (10 :: DiffTime)) x     ,@@ -299,14 +319,14 @@         DSL.session $ do           let             statement =-              Statement.Statement sql mempty Decoders.unit True+              Statement.Statement sql mempty Decoders.noResult True               where                 sql =                   "drop type if exists mood"             in DSL.statement () statement           let             statement =-              Statement.Statement sql mempty Decoders.unit True+              Statement.Statement sql mempty Decoders.noResult True               where                 sql =                   "create type mood as enum ('sad', 'ok', 'happy')"@@ -318,9 +338,9 @@                 sql =                   "select $1 = ('ok' :: mood)"                 decoder =-                  (Decoders.singleRow (Decoders.column (Decoders.bool)))+                  (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.bool)))                 encoder =-                  Encoders.param (Encoders.unknown)+                  Encoders.param (Encoders.nonNullable (Encoders.unknown))             in DSL.statement "ok" statement       in actualIO >>= assertEqual "" (Right True)     ,@@ -330,14 +350,14 @@         DSL.session $ do           let             statement =-              Statement.Statement sql mempty Decoders.unit True+              Statement.Statement sql mempty Decoders.noResult True               where                 sql =                   "create or replace function overloaded(a int, b int) returns int as $$ select a + b $$ language sql;"             in DSL.statement () statement           let             statement =-              Statement.Statement sql mempty Decoders.unit True+              Statement.Statement sql mempty Decoders.noResult True               where                 sql =                   "create or replace function overloaded(a text, b text, c text) returns text as $$ select a || b || c $$ language sql;"@@ -349,9 +369,9 @@                 sql =                   "select overloaded($1, $2) || overloaded($3, $4, $5)"                 decoder =-                  (Decoders.singleRow (Decoders.column (Decoders.text)))+                  (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.text)))                 encoder =-                  contramany (Encoders.param Encoders.unknown)+                  contramany (Encoders.param (Encoders.nonNullable (Encoders.unknown)))             in DSL.statement ["1", "2", "4", "5", "6"] statement       in actualIO >>= assertEqual "" (Right "3456")     ,@@ -361,14 +381,14 @@         DSL.session $ do           let             statement =-              Statement.Statement sql mempty Decoders.unit True+              Statement.Statement sql mempty Decoders.noResult True               where                 sql =                   "drop type if exists mood"             in DSL.statement () statement           let             statement =-              Statement.Statement sql mempty Decoders.unit True+              Statement.Statement sql mempty Decoders.noResult True               where                 sql =                   "create type mood as enum ('sad', 'ok', 'happy')"@@ -380,9 +400,9 @@                 sql =                   "select ($1 :: mood)"                 decoder =-                  (Decoders.singleRow (Decoders.column (Decoders.enum (Just . id))))+                  (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.enum (Just . id))))                 encoder =-                  Encoders.param (Encoders.enum id)+                  Encoders.param (Encoders.nonNullable ((Encoders.enum id)))             in DSL.statement "ok" statement       in actualIO >>= assertEqual "" (Right "ok")     ,@@ -400,9 +420,9 @@                     sql =                       "select $1"                     encoder =-                      Encoders.param Encoders.text+                      Encoders.param (Encoders.nonNullable (Encoders.text))                     decoder =-                      (Decoders.singleRow (Decoders.column (Decoders.text)))+                      (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.text)))             effect2 =               DSL.statement 1 statement               where@@ -412,9 +432,9 @@                     sql =                       "select $1"                     encoder =-                      Encoders.param Encoders.int8+                      Encoders.param (Encoders.nonNullable (Encoders.int8))                     decoder =-                      (Decoders.singleRow (Decoders.column Decoders.int8))+                      (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) Decoders.int8))             in (,) <$> effect1 <*> effect2       in actualIO >>= assertEqual "" (Right ("ok", 1))     ,@@ -438,7 +458,7 @@             DSL.statement () $ Statements.plain $             "insert into a (name) values ('a')"             deleteRows =-            DSL.statement () $ Statement.Statement sql def decoder False+            DSL.statement () $ Statement.Statement sql mempty decoder False             where               sql =                 "delete from a"@@ -452,8 +472,8 @@         DSL.session $ do           DSL.statement () $ Statements.plain $ "drop table if exists a"           DSL.statement () $ Statements.plain $ "create table a (id serial not null, v char not null, primary key (id))"-          id1 <- DSL.statement () $ Statement.Statement "insert into a (v) values ('a') returning id" def (Decoders.singleRow (Decoders.column Decoders.int4)) False-          id2 <- DSL.statement () $ Statement.Statement "insert into a (v) values ('b') returning id" def (Decoders.singleRow (Decoders.column Decoders.int4)) False+          id1 <- DSL.statement () $ Statement.Statement "insert into a (v) values ('a') returning id" mempty (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) Decoders.int4)) False+          id2 <- DSL.statement () $ Statement.Statement "insert into a (v) values ('b') returning id" mempty (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) Decoders.int4)) False           DSL.statement () $ Statements.plain $ "drop table if exists a"           pure (id1, id2)       in assertEqual "" (Right (1, 2)) =<< actualIO

@@ -8,7 +8,3 @@ -- rerebase ------------------------- import Prelude as Exports---- data-default-class---------------------------import Data.Default.Class as Exports

@@ -1,19 +1,15 @@ module Main.Statements where -import Main.Prelude hiding (def)+import Main.Prelude import qualified Hasql.Statement as HQ import qualified Hasql.Encoders as HE import qualified Hasql.Decoders as HD import qualified Main.Prelude as Prelude  -def :: ByteString -> HQ.Statement () ()-def sql =-  HQ.Statement sql Prelude.def Prelude.def False- plain :: ByteString -> HQ.Statement () () plain sql =-  HQ.Statement sql mempty HD.unit False+  HQ.Statement sql mempty HD.noResult False  dropType :: ByteString -> HQ.Statement () () dropType name =@@ -33,4 +29,4 @@     sql =       "values (1,2), (3,4), (5,6)"     decoder =-      HD.rowList ((,) <$> HD.column HD.int8 <*> HD.column HD.int8)+      HD.rowList ((,) <$> (HD.column . HD.nonNullable) HD.int8 <*> (HD.column . HD.nonNullable) HD.int8)

@@ -13,8 +13,8 @@     sql =       "select pg_sleep($1)"     encoder =-      E.param E.float8+      E.param (E.nonNullable E.float8)     decoder =-      D.unit+      D.noResult