packages feed

hasql 1.10.3.7 → 2.0.0.0

raw patch · 173 files changed

+12019/−12232 lines, 173 filesdep +pqidep +pqi-ffidep +pqi-nativedep −postgresql-libpqPVP ok

version bump matches the API change (PVP)

Dependencies added: pqi, pqi-ffi, pqi-native

Dependencies removed: postgresql-libpq

API changes (from Hackage documentation)

- Hasql.Connection.Settings: instance GHC.Internal.Base.Monoid Hasql.Connection.Settings.Settings
- Hasql.Connection.Settings: instance GHC.Internal.Base.Semigroup Hasql.Connection.Settings.Settings
- Hasql.Connection.Settings: instance GHC.Internal.Classes.Eq Hasql.Connection.Settings.Settings
- Hasql.Connection.Settings: instance GHC.Internal.Data.String.IsString Hasql.Connection.Settings.Settings
- Hasql.Connection.Settings: instance GHC.Internal.Show.Show Hasql.Connection.Settings.Settings
+ Hasql.Connection.Settings: instance Data.String.IsString Hasql.Connection.Settings.Settings
+ Hasql.Connection.Settings: instance GHC.Base.Monoid Hasql.Connection.Settings.Settings
+ Hasql.Connection.Settings: instance GHC.Base.Semigroup Hasql.Connection.Settings.Settings
+ Hasql.Connection.Settings: instance GHC.Classes.Eq Hasql.Connection.Settings.Settings
+ Hasql.Connection.Settings: instance GHC.Show.Show Hasql.Connection.Settings.Settings
- Hasql.Connection: acquire :: Settings -> IO (Either ConnectionError Connection)
+ Hasql.Connection: acquire :: Adapter -> Settings -> IO (Either ConnectionError Connection)

Files

CHANGELOG.md view
@@ -1,3 +1,11 @@+# v2.0.0.0++New era: the transport layer is now pluggable via [`pqi`](https://github.com/nikita-volkov/pqi), and an alpha pure-Haskell backend, [`pqi-native`](https://github.com/nikita-volkov/pqi-native), is available for early adopters. Goal: a reliable, performant, no-C-dependency replacement for libpq.++## Breaking++- `Hasql.Connection.acquire` now takes an explicit adapter as its first argument, ahead of `Settings`. To keep prior behaviour, depend on [`pqi-ffi`](https://hackage.haskell.org/package/pqi-ffi) and pass `Pqi.Ffi.adapter`. To try the native backend, depend on [`pqi-native`](https://hackage.haskell.org/package/pqi-native) and pass `Pqi.Native.adapter`.+ # 1.10  Major revision happened.
README.md view
@@ -13,6 +13,21 @@  Hasql is production-ready, actively maintained and the API is moderately stable. It's used by many companies and most notably by the [Postgrest](https://github.com/PostgREST/postgrest) project. +# A New Era: Pluggable Transport++Hasql's transport is now pluggable via [`pqi`](https://github.com/nikita-volkov/pqi). `Hasql.Connection.acquire` takes an adapter explicitly:++```haskell+import Pqi.Ffi qualified    -- the existing C-backed libpq transport+import Pqi.Native qualified -- alpha: pure-Haskell, no C dependency, interchangeable with Pqi.Ffi++connection <- Hasql.Connection.acquire Pqi.Ffi.adapter settings+-- or+connection <- Hasql.Connection.acquire Pqi.Native.adapter settings+```++[`pqi-native`](https://github.com/nikita-volkov/pqi-native) is the goal of this new era: a from-scratch, pure-Haskell implementation of the Postgres wire protocol, verified byte-for-byte against `libpq` via [`pqi-conformance`](https://github.com/nikita-volkov/pqi-conformance). **It's alpha** - not yet proven at production scale - while [`pqi-ffi`](https://github.com/nikita-volkov/pqi-ffi) remains the stable, production-proven default. The two adapters are fully interchangeable: swapping between them is a one-line change (a different `Adapter` value, nothing else), so early adopters can try `pqi-native` today with no lock-in and no rewrite to fall back if needed. Feedback welcome on [GitHub Discussions](https://github.com/nikita-volkov/hasql/discussions).+ # Ecosystem  Hasql is not just a single library, it is a granular ecosystem of composable libraries, each isolated to perform its own task and stay simple.@@ -92,10 +107,11 @@ import qualified Hasql.Encoders as Encoders import qualified Hasql.Session as Session import qualified Hasql.Statement as Statement+import qualified Pqi.Ffi -- from "pqi-ffi" (stable); swap for "Pqi.Native" from "pqi-native" (alpha, fully interchangeable) to try the pure-Haskell backend  main :: IO () main = do-  Right connection <- Connection.acquire connectionSettings+  Right connection <- Connection.acquire Pqi.Ffi.adapter connectionSettings   result <- Connection.use connection (sumAndDivModSession 3 8 3)   print result   where
hasql.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: hasql-version: 1.10.3.7+version: 2.0.0.0 category: Hasql, Database, PostgreSQL synopsis: Fast PostgreSQL driver with a flexible mapping API description:@@ -112,6 +112,52 @@     Hasql.Statement    other-modules:+    Hasql.Connection.Config+    Hasql.Connection.ServerVersion++  build-depends:+    hasql:codecs,+    hasql:comms,+    hasql:engine,+    hasql:platform,+    postgresql-connection-string ^>=0.1,+    pqi ^>=1.0,+    text >=1 && <3,+    text-builder >=1 && <1.1,+    unordered-containers >=0.2 && <0.3,++library platform+  import: base+  hs-source-dirs: src/platform+  exposed-modules:+    Hasql.Platform.Prelude++  other-modules:+    Hasql.Platform.Prelude.Text++  build-depends:+    base >=4.14 && <5,+    bytestring >=0.10 && <0.13,+    comonad ^>=5,+    contravariant >=1.3 && <2,+    dlist >=0.8 && <0.9 || >=1 && <2,+    hashable >=1.2 && <2,+    mtl >=2 && <3,+    profunctors >=5.1 && <6,+    scientific >=0.3 && <0.4,+    text >=1 && <3,+    text-builder >=1 && <1.1,+    time >=1.9 && <2,+    transformers >=0.5 && <0.7,+    unordered-containers >=0.2 && <0.3,+    uuid >=1.3 && <2,+    vector >=0.10 && <0.14,+    witherable >=0.5 && <0.6,++library codecs+  import: base+  hs-source-dirs: src/codecs+  exposed-modules:     Hasql.Codecs.Decoders     Hasql.Codecs.Decoders.Array     Hasql.Codecs.Decoders.Composite@@ -131,6 +177,23 @@     Hasql.Codecs.Vocab.QualifiedTypeName     Hasql.Codecs.Vocab.TypeInfo     Hasql.Codecs.Vocab.TypeRef++  build-depends:+    aeson >=2 && <3,+    base >=4.14 && <5,+    bytestring >=0.10 && <0.13,+    bytestring-strict-builder >=0.4.5.4 && <0.5,+    hasql:platform,+    iproute >=1.7 && <1.8,+    postgresql-binary ^>=0.15,+    text-builder >=1 && <1.1,+    unordered-containers >=0.2 && <0.3,+    vector >=0.10 && <0.14,++library comms+  import: base+  hs-source-dirs: src/comms+  exposed-modules:     Hasql.Comms.Recv     Hasql.Comms.ResultDecoder     Hasql.Comms.Roundtrip@@ -138,8 +201,18 @@     Hasql.Comms.RowReader     Hasql.Comms.Send     Hasql.Comms.Session-    Hasql.Connection.Config-    Hasql.Connection.ServerVersion++  build-depends:+    attoparsec >=0.10 && <0.15,+    bytestring >=0.10 && <0.13,+    hasql:platform,+    pqi ^>=1.0,+    vector >=0.10 && <0.14,++library engine+  import: base+  hs-source-dirs: src/engine+  exposed-modules:     Hasql.Engine.Contexts.Pipeline     Hasql.Engine.Contexts.Session     Hasql.Engine.Decoders.Result@@ -149,37 +222,17 @@     Hasql.Engine.Statement     Hasql.Engine.Structures.ConnectionState     Hasql.Engine.Structures.StatementCache-    Hasql.Platform.Prelude-    Hasql.Platform.Prelude.Text-    Hasql.Pq-    Hasql.Pq.Ffi-    Hasql.Pq.Mappings    build-depends:-    aeson >=2 && <3,-    attoparsec >=0.10 && <0.15,-    base >=4.14 && <5,-    bytestring >=0.10 && <0.13,-    bytestring-strict-builder >=0.4.5.4 && <0.5,-    comonad ^>=5,-    contravariant >=1.3 && <2,-    dlist >=0.8 && <0.9 || >=1 && <2,-    hashable >=1.2 && <2,-    iproute >=1.7 && <1.8,-    mtl >=2 && <3,+    hasql:codecs,+    hasql:comms,+    hasql:platform,     postgresql-binary ^>=0.15,-    postgresql-connection-string ^>=0.1,-    postgresql-libpq >=0.10.1 && <0.12,-    profunctors >=5.1 && <6,-    scientific >=0.3 && <0.4,+    pqi ^>=1.0,     text >=1 && <3,     text-builder >=1 && <1.1,-    time >=1.9 && <2,-    transformers >=0.5 && <0.7,     unordered-containers >=0.2 && <0.3,-    uuid >=1.3 && <2,     vector >=0.10 && <0.14,-    witherable >=0.5 && <0.6,  benchmark benchmarks   import: executable@@ -189,6 +242,8 @@   build-depends:     criterion >=1.6 && <2,     hasql,+    pqi-ffi ^>=1.0,+    pqi-native ^>=1.0,     rerebase <2,  test-suite profiling@@ -203,106 +258,49 @@    build-depends:     hasql,+    pqi-ffi ^>=1.0,     rerebase >=1 && <2,     testcontainers-postgresql ^>=0.2,  test-suite comms-tests   import: test   type: exitcode-stdio-1.0-  hs-source-dirs:-    src/comms-tests-    src/library-+  hs-source-dirs: src/comms-tests   main-is: Main.hs   other-modules:-    Hasql.Comms.Recv-    Hasql.Comms.ResultDecoder-    Hasql.Comms.Roundtrip-    Hasql.Comms.RowDecoder-    Hasql.Comms.RowReader-    Hasql.Comms.Send-    Hasql.Comms.Session     Hasql.Comms.Session.CleanUpAfterInterruptionSpec     Hasql.Comms.SpecHook-    Hasql.Platform.Prelude-    Hasql.Platform.Prelude.Text-    Hasql.Pq-    Hasql.Pq.Ffi-    Hasql.Pq.Mappings    build-tool-depends:     hspec-discover:hspec-discover ^>=2.11.12    build-depends:-    attoparsec >=0.10 && <0.15,-    base >=4.14 && <5,-    bytestring >=0.10 && <0.13,-    comonad ^>=5,-    contravariant >=1.3 && <2,-    dlist >=0.8 && <0.9 || >=1 && <2,-    hashable >=1.2 && <2,+    hasql:comms,+    hasql:platform,     hspec ^>=2.11.12,-    mtl >=2 && <3,-    postgresql-libpq >=0.10.1 && <0.12,-    profunctors >=5.1 && <6,-    scientific >=0.3 && <0.4,+    pqi ^>=1.0,+    pqi-ffi ^>=1.0,     testcontainers-postgresql ^>=0.2,-    text >=1 && <3,     text-builder >=1 && <1.1,-    time >=1.9 && <2,-    transformers >=0.5 && <0.7,-    unordered-containers >=0.2 && <0.3,-    uuid >=1.3 && <2,-    vector >=0.10 && <0.14,-    witherable >=0.5 && <0.6,  test-suite engine-tests   import: test   type: exitcode-stdio-1.0-  hs-source-dirs:-    src/engine-tests-    src/library-+  hs-source-dirs: src/engine-tests   main-is: Main.hs   other-modules:-    Hasql.Codecs.Vocab-    Hasql.Codecs.Vocab.OidCache-    Hasql.Codecs.Vocab.ParamMeta-    Hasql.Codecs.Vocab.QualifiedTypeName-    Hasql.Codecs.Vocab.TypeInfo-    Hasql.Codecs.Vocab.TypeRef     Hasql.Engine.Structures.OidCacheSpec-    Hasql.Engine.Structures.StatementCache     Hasql.Engine.Structures.StatementCacheSpec-    Hasql.Platform.Prelude-    Hasql.Platform.Prelude.Text-    Hasql.Pq-    Hasql.Pq.Ffi-    Hasql.Pq.Mappings    build-tool-depends:     hspec-discover:hspec-discover ^>=2.11.12    build-depends:     base >=4.14 && <5,-    bytestring >=0.10 && <0.13,-    comonad ^>=5,-    contravariant >=1.3 && <2,-    dlist >=0.8 && <0.9 || >=1 && <2,-    hashable >=1.2 && <2,+    hasql:codecs,+    hasql:engine,     hspec ^>=2.11.12,-    mtl >=2 && <3,-    postgresql-libpq >=0.10.1 && <0.12,-    profunctors >=5.1 && <6,-    scientific >=0.3 && <0.4,-    text >=1 && <3,-    text-builder >=1 && <1.1,-    time >=1.9 && <2,-    transformers >=0.5 && <0.7,     unordered-containers >=0.2 && <0.3,-    uuid >=1.3 && <2,-    vector >=0.10 && <0.14,-    witherable >=0.5 && <0.6,  test-suite library-tests   import: test@@ -310,6 +308,7 @@   hs-source-dirs: src/library-tests   main-is: Main.hs   other-modules:+    Helpers.Adapters     Helpers.Dsls.Execution     Helpers.Dsls.Statement     Helpers.Scripts@@ -323,50 +322,45 @@     Helpers.Statements.SetConfig     Helpers.Statements.Sleep     Helpers.Statements.WrongDecoder-    Isolated.ByUnit.Connection.AcquireSpec-    Pure.ByUnit.ErrorsSpec-    Sharing.ByBug.ExceptionConnectionResetRaceSpec-    Sharing.ByBug.PipelineAbortedInterruptionCleanupSpec-    Sharing.ByFeature.ConcurrencySpec-    Sharing.ByFeature.DecoderCompatibilityCacheSpec-    Sharing.ByFeature.DecoderCompatibilityCheckSpec-    Sharing.ByFeature.PreparedStatementCacheSpec-    Sharing.ByFeature.PreparedStatementsSpec-    Sharing.ByFeature.SyntaxErrorsSpec-    Sharing.ByUnit.Connection.UseSpec-    Sharing.ByUnit.Decoders.CitextSpec-    Sharing.ByUnit.Decoders.Composite.OidMismatchSpec-    Sharing.ByUnit.Decoders.CompositeSpec-    Sharing.ByUnit.Decoders.CustomSpec-    Sharing.ByUnit.Decoders.DomainSpec-    Sharing.ByUnit.Decoders.EnumSpec-    Sharing.ByUnit.Decoders.Float8Spec-    Sharing.ByUnit.Decoders.HstoreSpec-    Sharing.ByUnit.Decoders.InetSpec-    Sharing.ByUnit.Decoders.IntervalSpec-    Sharing.ByUnit.Decoders.JsonSpec-    Sharing.ByUnit.Decoders.RecordSpec-    Sharing.ByUnit.Decoders.UuidSpec-    Sharing.ByUnit.Encoders.ArraySpec-    Sharing.ByUnit.Encoders.CitextSpec-    Sharing.ByUnit.Encoders.Composite.OidMismatchSpec-    Sharing.ByUnit.Encoders.CompositeSpec-    Sharing.ByUnit.Encoders.CustomSpec-    Sharing.ByUnit.Encoders.DomainSpec-    Sharing.ByUnit.Encoders.EnumSpec-    Sharing.ByUnit.Encoders.HstoreSpec-    Sharing.ByUnit.Encoders.InetSpec-    Sharing.ByUnit.Encoders.IntervalSpec-    Sharing.ByUnit.Encoders.JsonSpec-    Sharing.ByUnit.Encoders.UnknownSpec-    Sharing.ByUnit.Encoders.UuidSpec-    Sharing.ByUnit.PipelineSpec-    Sharing.ByUnit.Session.CatchErrorSpec-    Sharing.ByUnit.Session.ScriptSpec-    Sharing.ByUnit.Session.StatementSpec-    Sharing.ByUnit.SessionSpec-    Sharing.ByUnit.StatementSpec-    Sharing.SpecHook+    Integration.Isolated.Connection.AcquireSpec+    Integration.Sharing.Connection.Use.PipelineAbortedInterruptionCleanupSpec+    Integration.Sharing.Connection.UseSpec+    Integration.Sharing.Decoders.CitextSpec+    Integration.Sharing.Decoders.Composite.OidMismatchSpec+    Integration.Sharing.Decoders.CompositeSpec+    Integration.Sharing.Decoders.CustomSpec+    Integration.Sharing.Decoders.DomainSpec+    Integration.Sharing.Decoders.EnumSpec+    Integration.Sharing.Decoders.Float8Spec+    Integration.Sharing.Decoders.HstoreSpec+    Integration.Sharing.Decoders.InetSpec+    Integration.Sharing.Decoders.IntervalSpec+    Integration.Sharing.Decoders.JsonSpec+    Integration.Sharing.Decoders.RecordSpec+    Integration.Sharing.Decoders.UuidSpec+    Integration.Sharing.Encoders.ArraySpec+    Integration.Sharing.Encoders.CitextSpec+    Integration.Sharing.Encoders.Composite.OidMismatchSpec+    Integration.Sharing.Encoders.CompositeSpec+    Integration.Sharing.Encoders.CustomSpec+    Integration.Sharing.Encoders.DomainSpec+    Integration.Sharing.Encoders.EnumSpec+    Integration.Sharing.Encoders.HstoreSpec+    Integration.Sharing.Encoders.InetSpec+    Integration.Sharing.Encoders.IntervalSpec+    Integration.Sharing.Encoders.JsonSpec+    Integration.Sharing.Encoders.UnknownSpec+    Integration.Sharing.Encoders.UuidSpec+    Integration.Sharing.ErrorsSpec+    Integration.Sharing.PipelineSpec+    Integration.Sharing.Session.CatchErrorSpec+    Integration.Sharing.Session.ScriptSpec+    Integration.Sharing.Session.StatementSpec+    Integration.Sharing.SessionSpec+    Integration.Sharing.SpecHook+    Integration.Sharing.StatementSpec+    Integration.SpecHook+    Pure.ErrorsSpec    build-tool-depends:     hspec-discover:hspec-discover ^>=2.11.12@@ -376,6 +370,9 @@     hasql,     hspec ^>=2.11.12,     iproute,+    pqi ^>=1.0,+    pqi-ffi ^>=1.0,+    pqi-native ^>=1.0,     QuickCheck,     quickcheck-instances >=0.3.11 && <0.4,     random >=1.3 && <1.4,
src/benchmarks/Main.hs view
@@ -7,21 +7,26 @@ import Hasql.Pipeline qualified as E import Hasql.Session qualified as B import Hasql.Statement qualified as C+import Pqi.Ffi qualified+import Pqi.Native qualified import Prelude  main :: IO () main =   do-    connection <- acquireConnection-    connection <- case connection of-      Left err -> fail (show err)-      Right connection -> pure connection-    useConnection connection+    ffiConnection <- acquireConnection Pqi.Ffi.adapter+    nativeConnection <- acquireConnection Pqi.Native.adapter+    defaultMain+      [ adapterGroup "ffi" ffiConnection,+        adapterGroup "native" nativeConnection+      ]   where-    acquireConnection =-      A.acquire mempty-    useConnection connection =-      defaultMain+    acquireConnection adapter =+      A.acquire adapter mempty >>= either (fail . show) pure+    adapterGroup :: String -> A.Connection -> Benchmark+    adapterGroup groupName connection =+      bgroup+        groupName         [ sessionBench "largeResultInVector" sessionWithSingleLargeResultInVector,           sessionBench "largeResultInList" sessionWithSingleLargeResultInList,           sessionBench "manyLargeResults" sessionWithManyLargeResults,
+ src/codecs/Hasql/Codecs/Decoders.hs view
@@ -0,0 +1,147 @@+module Hasql.Codecs.Decoders+  ( -- * Nullability+    NullableOrNot.NullableOrNot (..),+    NullableOrNot.nonNullable,+    NullableOrNot.nullable,++    -- * Value+    Value.Value (..),+    Value.bool,+    Value.int2,+    Value.int4,+    Value.int8,+    Value.float4,+    Value.float8,+    Value.numeric,+    Value.char,+    Value.text,+    Value.varchar,+    Value.bpchar,+    Value.bytea,+    Value.date,+    Value.timestamp,+    Value.timestamptz,+    Value.time,+    Value.timetz,+    Value.interval,+    Value.uuid,+    Value.inet,+    Value.macaddr,+    Value.json,+    Value.jsonBytes,+    Value.jsonb,+    Value.jsonbBytes,+    Value.int4range,+    Value.int8range,+    Value.numrange,+    Value.tsrange,+    Value.tstzrange,+    Value.daterange,+    Value.int4multirange,+    Value.int8multirange,+    Value.nummultirange,+    Value.tsmultirange,+    Value.tstzmultirange,+    Value.datemultirange,+    Value.citext,+    array,+    listArray,+    vectorArray,+    composite,+    record,+    Value.hstore,+    Value.enum,+    Value.custom,+    Value.refine,++    -- * Array+    Array.Array,+    Array.dimension,+    Array.element,++    -- * Composite+    Composite.Composite (..),+    Composite.field,+  )+where++import Data.Vector.Generic qualified as GenericVector+import Hasql.Codecs.Decoders.Array qualified as Array+import Hasql.Codecs.Decoders.Composite qualified as Composite+import Hasql.Codecs.Decoders.NullableOrNot qualified as NullableOrNot+import Hasql.Codecs.Decoders.Value qualified as Value+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo+import Hasql.Platform.Prelude++-- * Value++-- |+-- Lift an 'Array.Array' decoder to a 'Value.Value' decoder.+{-# INLINEABLE array #-}+array :: Array.Array a -> Value.Value a+array decoder = Value.Value (Array.toSchema decoder) (Array.toTypeName decoder) (Array.toBaseOid decoder) (Array.toArrayOid decoder) (Array.toDimensionality decoder) (Array.toValueDecoder decoder)++-- |+-- 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.NullableOrNot Value.Value element -> Value.Value [element]+listArray = array . Array.dimension replicateM . Array.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.NullableOrNot Value.Value element -> Value.Value (vector element)+vectorArray = array . Array.dimension GenericVector.replicateM . Array.element++-- |+-- Lift a 'Composite.Composite' decoder to a 'Value.Value' decoder for named composite types.+--+-- This function is for named composite types where the type name is known.+-- For anonymous composite types (like those created with ROW constructor),+-- use 'record' instead.+{-# INLINEABLE composite #-}+composite :: Maybe Text -> Text -> Composite.Composite a -> Value.Value a+composite schema typeName composite =+  Value.Value+    schema+    typeName+    Nothing+    Nothing+    0+    (Composite.toValueDecoder composite)++-- |+-- Lift a 'Composite.Composite' decoder to a 'Value.Value' decoder for unnamed composite types.+--+-- This is useful for decoding anonymous composites (like those created with ROW constructor)+-- where no type name is required. Postgres will handle the type automatically.+{-# INLINEABLE record #-}+record :: Composite.Composite a -> Value.Value a+record composite =+  Value.Value+    Nothing+    "record"+    (Just (Vocab.TypeInfo.toBaseOid typeInfo))+    (Just (Vocab.TypeInfo.toArrayOid typeInfo))+    0+    (Composite.toValueDecoder composite)+  where+    typeInfo = Vocab.TypeInfo.record
+ src/codecs/Hasql/Codecs/Decoders/Array.hs view
@@ -0,0 +1,139 @@+module Hasql.Codecs.Decoders.Array+  ( Array,+    toValueDecoder,+    toTypeSig,+    toSchema,+    toTypeName,+    toBaseOid,+    toArrayOid,+    toDimensionality,+    dimension,+    element,+  )+where++import Hasql.Codecs.Decoders.NullableOrNot qualified as NullableOrNot+import Hasql.Codecs.Decoders.Value qualified as Value+import Hasql.Codecs.RequestingOid qualified as RequestingOid+import Hasql.Platform.Prelude+import PostgreSQL.Binary.Decoding qualified as Binary+import TextBuilder qualified++-- |+-- Binary generic array decoder.+--+-- Here's how you can use it to produce a specific array value decoder:+--+-- @+-- x :: 'Value.Value' [[Text]]+-- x = 'array' ('dimension' 'replicateM' ('dimension' 'replicateM' ('element' ('nonNullable' 'text'))))+-- @+data Array a+  = Array+      -- | Schema name.+      (Maybe Text)+      -- | Type name for the array element.+      Text+      -- | Statically known OID for the base (element) type.+      (Maybe Word32)+      -- | Statically known OID for the array type.+      (Maybe Word32)+      -- | Number of dimensions.+      Word+      -- | Decoding function+      (RequestingOid.RequestingOid (Binary.Array a))+  deriving (Functor)++{-# INLINE toValueDecoder #-}+toValueDecoder :: Array a -> RequestingOid.RequestingOid (Binary.Value a)+toValueDecoder (Array _ _ _ _ _ decoder) =+  fmap Binary.array decoder++-- | Get the type signature for the array based on element type name+{-# INLINE toTypeSig #-}+toTypeSig :: Array a -> Text+toTypeSig (Array schemaName elementTypeName _ _ ndims _) =+  TextBuilder.toText+    ( mconcat+        ( mconcat+            [ foldMap+                (\s -> [TextBuilder.text s, TextBuilder.char '.'])+                schemaName,+              [ TextBuilder.text elementTypeName+              ],+              replicate+                (fromIntegral ndims)+                (TextBuilder.text "[]")+            ]+        )+    )++toSchema :: Array a -> Maybe Text+toSchema (Array schema _ _ _ _ _) = schema++-- | Get the type name for the array based on element type name+{-# INLINE toTypeName #-}+toTypeName :: Array a -> Text+toTypeName (Array _ elementTypeName _ _ _ _) =+  elementTypeName++-- | Get the base OID if statically known+{-# INLINE toBaseOid #-}+toBaseOid :: Array a -> Maybe Word32+toBaseOid (Array _ _ baseOid _ _ _) = baseOid++-- | Get the array OID if statically known+{-# INLINE toArrayOid #-}+toArrayOid :: Array a -> Maybe Word32+toArrayOid (Array _ _ _ arrayOid _ _) = arrayOid++-- | Get the dimensionality of the array+{-# INLINE toDimensionality #-}+toDimensionality :: Array a -> Word+toDimensionality (Array _ _ _ _ ndims _) = ndims++-- * Public API++-- |+-- Binary 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.+--+-- * Binary decoder of its components, which can be either another 'dimension' or 'element'.+{-# INLINEABLE dimension #-}+dimension :: (forall m. (Monad m) => Int -> m a -> m b) -> Array a -> Array b+dimension replicateM (Array schema typeName baseOid arrayOid ndims decoder) =+  Array+    schema+    typeName+    baseOid+    arrayOid+    (succ ndims)+    (fmap (Binary.dimensionArray replicateM) decoder)++-- |+-- Lift a 'Value.Value' decoder into an 'Array' decoder for parsing of leaf values.+{-# INLINEABLE element #-}+element :: NullableOrNot.NullableOrNot Value.Value a -> Array a+element = \case+  NullableOrNot.NonNullable imp ->+    Array+      (Value.toSchema imp)+      (Value.toTypeName imp)+      (Value.toBaseOid imp)+      (Value.toArrayOid imp)+      1+      (fmap Binary.valueArray (Value.toDecoder imp))+  NullableOrNot.Nullable imp ->+    Array+      (Value.toSchema imp)+      (Value.toTypeName imp)+      (Value.toBaseOid imp)+      (Value.toArrayOid imp)+      1+      (fmap Binary.nullableValueArray (Value.toDecoder imp))
+ src/codecs/Hasql/Codecs/Decoders/Composite.hs view
@@ -0,0 +1,52 @@+module Hasql.Codecs.Decoders.Composite where++import Hasql.Codecs.Decoders.NullableOrNot qualified as NullableOrNot+import Hasql.Codecs.Decoders.Value qualified as Value+import Hasql.Codecs.RequestingOid qualified as RequestingOid+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo+import Hasql.Platform.Prelude+import PostgreSQL.Binary.Decoding qualified as Binary++-- |+-- Composable decoder of composite values (rows, records).+newtype Composite a+  = Composite (RequestingOid.RequestingOid (Binary.Composite a))+  deriving+    (Functor, Applicative)+    via (Compose RequestingOid.RequestingOid Binary.Composite)++toValueDecoder :: Composite a -> RequestingOid.RequestingOid (Binary.Value a)+toValueDecoder (Composite imp) =+  fmap Binary.composite imp++-- |+-- Lift a 'Value.Value' decoder into a 'Composite' decoder for parsing of component values.+field :: NullableOrNot.NullableOrNot Value.Value a -> Composite a+field = \case+  NullableOrNot.NonNullable imp ->+    let dimensionality = Value.toDimensionality imp+        staticOid = if dimensionality == 0 then Value.toBaseOid imp else Value.toArrayOid imp+     in case staticOid of+          Just oid ->+            Composite (fmap (Binary.typedValueComposite oid) (Value.toDecoder imp))+          Nothing ->+            Composite+              ( RequestingOid.hoistLookingUp+                  (Vocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema imp) (Value.toTypeName imp))+                  (\typeInfo decoder -> Binary.typedValueComposite (if dimensionality == 0 then Vocab.TypeInfo.toBaseOid typeInfo else Vocab.TypeInfo.toArrayOid typeInfo) decoder)+                  (Value.toDecoder imp)+              )+  NullableOrNot.Nullable imp ->+    let dimensionality = Value.toDimensionality imp+        staticOid = if dimensionality == 0 then Value.toBaseOid imp else Value.toArrayOid imp+     in case staticOid of+          Just oid ->+            Composite (fmap (Binary.typedNullableValueComposite oid) (Value.toDecoder imp))+          Nothing ->+            Composite+              ( RequestingOid.hoistLookingUp+                  (Vocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema imp) (Value.toTypeName imp))+                  (\typeInfo decoder -> Binary.typedNullableValueComposite (if dimensionality == 0 then Vocab.TypeInfo.toBaseOid typeInfo else Vocab.TypeInfo.toArrayOid typeInfo) decoder)+                  (Value.toDecoder imp)+              )
+ src/codecs/Hasql/Codecs/Decoders/NullableOrNot.hs view
@@ -0,0 +1,27 @@+module Hasql.Codecs.Decoders.NullableOrNot+  ( -- * Nullability+    NullableOrNot (..),+    nonNullable,+    nullable,+  )+where++import Hasql.Platform.Prelude++-- * 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
+ src/codecs/Hasql/Codecs/Decoders/Value.hs view
@@ -0,0 +1,461 @@+module Hasql.Codecs.Decoders.Value+  ( Value (..),+    bool,+    int2,+    int4,+    int8,+    float4,+    float8,+    numeric,+    char,+    text,+    varchar,+    bpchar,+    bytea,+    date,+    timestamp,+    timestamptz,+    time,+    timetz,+    interval,+    uuid,+    inet,+    macaddr,+    json,+    jsonBytes,+    jsonb,+    jsonbBytes,+    int4range,+    int8range,+    numrange,+    tsrange,+    tstzrange,+    daterange,+    int4multirange,+    int8multirange,+    nummultirange,+    tsmultirange,+    tstzmultirange,+    datemultirange,+    citext,+    custom,+    refine,+    hstore,+    enum,+    toDimensionality,+    toDecoder,+    toSchema,+    toTypeName,+    toOid,+    toBaseOid,+    toArrayOid,+    toHandler,+    toByteStringParser,+    isArray,+  )+where++import Data.Aeson qualified as Aeson+import Data.IP qualified as Iproute+import Hasql.Codecs.RequestingOid qualified as RequestingOid+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo+import Hasql.Platform.Prelude hiding (bool)+import PostgreSQL.Binary.Decoding qualified as Binary+import PostgreSQL.Binary.Range qualified as R++-- |+-- Value decoder.+data Value a+  = Value+      -- | Schema name.+      (Maybe Text)+      -- | Type name.+      Text+      -- | Statically known OID for the type.+      (Maybe Word32)+      -- | Statically known OID for the array-type with this type as the element.+      (Maybe Word32)+      -- | Dimensionality. If 0 then it is a scalar value, otherwise it is an array with that many dimensions.+      Word+      -- | Decoding function on a registry of OIDs by type name.+      (RequestingOid.RequestingOid (Binary.Value a))+  deriving (Functor)++type role Value representational++instance Filterable Value where+  {-# INLINE mapMaybe #-}+  mapMaybe fn =+    refine (maybe (Left "Invalid value") Right . fn)++-- |+-- Create a decoder from TypeInfo metadata and a decoding function.+{-# INLINE primitive #-}+primitive :: Text -> Vocab.TypeInfo.TypeInfo -> Binary.Value a -> Value a+primitive typeName pti decoder =+  Value Nothing typeName (Just (Vocab.TypeInfo.toBaseOid pti)) (Just (Vocab.TypeInfo.toArrayOid pti)) 0 (RequestingOid.lift decoder)++-- * Static types++-- |+-- Decoder of the @BOOL@ values.+{-# INLINEABLE bool #-}+bool :: Value Bool+bool = primitive "bool" Vocab.TypeInfo.bool Binary.bool++-- |+-- Decoder of the @INT2@ values.+{-# INLINEABLE int2 #-}+int2 :: Value Int16+int2 = primitive "int2" Vocab.TypeInfo.int2 Binary.int++-- |+-- Decoder of the @INT4@ values.+{-# INLINEABLE int4 #-}+int4 :: Value Int32+int4 = primitive "int4" Vocab.TypeInfo.int4 Binary.int++-- |+-- Decoder of the @INT8@ values.+{-# INLINEABLE int8 #-}+int8 :: Value Int64+int8 =+  {-# SCC "int8" #-}+  primitive "int8" Vocab.TypeInfo.int8 ({-# SCC "int8.int" #-} Binary.int)++-- |+-- Decoder of the @FLOAT4@ values.+{-# INLINEABLE float4 #-}+float4 :: Value Float+float4 = primitive "float4" Vocab.TypeInfo.float4 Binary.float4++-- |+-- Decoder of the @FLOAT8@ values.+{-# INLINEABLE float8 #-}+float8 :: Value Double+float8 = primitive "float8" Vocab.TypeInfo.float8 Binary.float8++-- |+-- Decoder of the @NUMERIC@ values.+{-# INLINEABLE numeric #-}+numeric :: Value Scientific+numeric = primitive "numeric" Vocab.TypeInfo.numeric Binary.numeric++-- |+-- Decoder of the @CHAR@ values.+-- Note that it supports Unicode values.+{-# INLINEABLE char #-}+char :: Value Char+char = primitive "char" Vocab.TypeInfo.char Binary.char++-- |+-- Decoder of the @TEXT@ values.+{-# INLINEABLE text #-}+text :: Value Text+text = primitive "text" Vocab.TypeInfo.text Binary.text_strict++-- |+-- Decoder of the @VARCHAR@ values.+{-# INLINEABLE varchar #-}+varchar :: Value Text+varchar = primitive "varchar" Vocab.TypeInfo.varchar Binary.text_strict++-- |+-- Decoder of @BPCHAR@ or @CHAR(n)@, @CHARACTER(n)@ values.+{-# INLINEABLE bpchar #-}+bpchar :: Value Text+bpchar = primitive "bpchar" Vocab.TypeInfo.bpchar Binary.text_strict++-- |+-- Decoder of the @BYTEA@ values.+{-# INLINEABLE bytea #-}+bytea :: Value ByteString+bytea = primitive "bytea" Vocab.TypeInfo.bytea Binary.bytea_strict++-- |+-- Decoder of the @DATE@ values.+{-# INLINEABLE date #-}+date :: Value Day+date = primitive "date" Vocab.TypeInfo.date Binary.date++-- |+-- Decoder of the @TIMESTAMP@ values.+{-# INLINEABLE timestamp #-}+timestamp :: Value LocalTime+timestamp = primitive "timestamp" Vocab.TypeInfo.timestamp Binary.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.+{-# INLINEABLE timestamptz #-}+timestamptz :: Value UTCTime+timestamptz = primitive "timestamptz" Vocab.TypeInfo.timestamptz Binary.timestamptz_int++-- |+-- Decoder of the @TIME@ values.+{-# INLINEABLE time #-}+time :: Value TimeOfDay+time = primitive "time" Vocab.TypeInfo.time Binary.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.+{-# INLINEABLE timetz #-}+timetz :: Value (TimeOfDay, TimeZone)+timetz = primitive "timetz" Vocab.TypeInfo.timetz Binary.timetz_int++-- |+-- Decoder of the @INTERVAL@ values.+{-# INLINEABLE interval #-}+interval :: Value DiffTime+interval = primitive "interval" Vocab.TypeInfo.interval Binary.interval_int++-- |+-- Decoder of the @UUID@ values.+{-# INLINEABLE uuid #-}+uuid :: Value UUID+uuid = primitive "uuid" Vocab.TypeInfo.uuid Binary.uuid++-- |+-- Decoder of the @INET@ values.+{-# INLINEABLE inet #-}+inet :: Value Iproute.IPRange+inet = primitive "inet" Vocab.TypeInfo.inet Binary.inet++-- |+-- Decoder of the @MACADDR@ values.+--+-- Represented as a 6-tuple of Word8 values in big endian order. If+-- you use `ip` library consider using it with `fromOctets`.+--+-- > (\(a,b,c,d,e,f) -> fromOctets a b c d e f) <$> macaddr+{-# INLINEABLE macaddr #-}+macaddr :: Value (Word8, Word8, Word8, Word8, Word8, Word8)+macaddr = primitive "macaddr" Vocab.TypeInfo.macaddr Binary.macaddr++-- |+-- Decoder of the @JSON@ values into a JSON AST.+{-# INLINEABLE json #-}+json :: Value Aeson.Value+json = primitive "json" Vocab.TypeInfo.json Binary.json_ast++-- |+-- Decoder of the @JSON@ values into a raw JSON 'ByteString'.+{-# INLINEABLE jsonBytes #-}+jsonBytes :: (ByteString -> Either Text a) -> Value a+jsonBytes fn = primitive "json" Vocab.TypeInfo.json (Binary.json_bytes fn)++-- |+-- Decoder of the @JSONB@ values into a JSON AST.+{-# INLINEABLE jsonb #-}+jsonb :: Value Aeson.Value+jsonb = primitive "jsonb" Vocab.TypeInfo.jsonb Binary.jsonb_ast++-- |+-- Decoder of the @JSONB@ values into a raw JSON 'ByteString'.+{-# INLINEABLE jsonbBytes #-}+jsonbBytes :: (ByteString -> Either Text a) -> Value a+jsonbBytes fn = primitive "jsonb" Vocab.TypeInfo.jsonb (Binary.jsonb_bytes fn)++-- |+-- Decoder of the @INT4RANGE@ values.+{-# INLINEABLE int4range #-}+int4range :: Value (R.Range Int32)+int4range = primitive "int4range" Vocab.TypeInfo.int4range Binary.int4range++-- |+-- Decoder of the @INT8RANGE@ values.+{-# INLINEABLE int8range #-}+int8range :: Value (R.Range Int64)+int8range = primitive "int8range" Vocab.TypeInfo.int8range Binary.int8range++-- |+-- Decoder of the @NUMRANGE@ values.+{-# INLINEABLE numrange #-}+numrange :: Value (R.Range Scientific)+numrange = primitive "numrange" Vocab.TypeInfo.numrange Binary.numrange++-- |+-- Decoder of the @TSRANGE@ values.+{-# INLINEABLE tsrange #-}+tsrange :: Value (R.Range LocalTime)+tsrange = primitive "tsrange" Vocab.TypeInfo.tsrange Binary.tsrange_int++-- |+-- Decoder of the @TSTZRANGE@ values.+{-# INLINEABLE tstzrange #-}+tstzrange :: Value (R.Range UTCTime)+tstzrange = primitive "tstzrange" Vocab.TypeInfo.tstzrange Binary.tstzrange_int++-- |+-- Decoder of the @DATERANGE@ values.+{-# INLINEABLE daterange #-}+daterange :: Value (R.Range Day)+daterange = primitive "daterange" Vocab.TypeInfo.daterange Binary.daterange++-- |+-- Decoder of the @INT4MULTIRANGE@ values.+{-# INLINEABLE int4multirange #-}+int4multirange :: Value (R.Multirange Int32)+int4multirange = primitive "int4multirange" Vocab.TypeInfo.int4multirange Binary.int4multirange++-- |+-- Decoder of the @INT8MULTIRANGE@ values.+{-# INLINEABLE int8multirange #-}+int8multirange :: Value (R.Multirange Int64)+int8multirange = primitive "int8multirange" Vocab.TypeInfo.int8multirange Binary.int8multirange++-- |+-- Decoder of the @NUMMULTIRANGE@ values.+{-# INLINEABLE nummultirange #-}+nummultirange :: Value (R.Multirange Scientific)+nummultirange = primitive "nummultirange" Vocab.TypeInfo.nummultirange Binary.nummultirange++-- |+-- Decoder of the @TSMULTIRANGE@ values.+{-# INLINEABLE tsmultirange #-}+tsmultirange :: Value (R.Multirange LocalTime)+tsmultirange = primitive "tsmultirange" Vocab.TypeInfo.tsmultirange Binary.tsmultirange_int++-- |+-- Decoder of the @TSTZMULTIRANGE@ values.+{-# INLINEABLE tstzmultirange #-}+tstzmultirange :: Value (R.Multirange UTCTime)+tstzmultirange = primitive "tstzmultirange" Vocab.TypeInfo.tstzmultirange Binary.tstzmultirange_int++-- |+-- Decoder of the @DATEMULTIRANGE@ values.+{-# INLINEABLE datemultirange #-}+datemultirange :: Value (R.Multirange Day)+datemultirange = primitive "datemultirange" Vocab.TypeInfo.datemultirange Binary.datemultirange++-- |+-- Decoder of the @CITEXT@ values.+--+-- Requires the @citext@ extension to be installed in the database.+{-# INLINEABLE citext #-}+citext :: Value Text+citext = Value Nothing "citext" Nothing Nothing 0 (RequestingOid.lift Binary.text_strict)++-- |+-- Low level API for defining custom value decoders.+{-# INLINEABLE custom #-}+custom ::+  -- | Schema name.+  Maybe Text ->+  -- | Type name.+  Text ->+  -- | Possible static OIDs for the type. The first is for scalar values the second is for arrays.+  --+  -- When unspecified, the OIDs will be automatically determined at runtime by looking up by name.+  Maybe (Word32, Word32) ->+  -- | Other named types whose OIDs are needed for deserializing.+  --+  -- E.g., when decoding composite types you can check the OIDs of its fields against the ones specified by Postgres.+  --+  -- When any of the requested types is missing in the database an error will be raised upon the statement execution.+  [(Maybe Text, Text)] ->+  -- | Deserialization function in the context of resolved OIDs of the types requested in the previous parameter.+  --+  -- It's safe to assume that all of the requested types will be present.+  -- In case you run the provided lookup function with unmentioned type names it will produce OID of 0 for them, standing for unknown type in Postgres.+  ( ((Maybe Text, Text) -> (Word32, Word32)) ->+    ByteString ->+    Either Text a+  ) ->+  Value a+custom schema typeName staticOids requestedTypes fn =+  Value+    schema+    typeName+    (fmap fst staticOids)+    (fmap snd staticOids)+    0+    (RequestingOid.requestAndHandle (fmap Vocab.QualifiedTypeName.fromNameTuple requestedTypes) (\lookup -> Binary.fn (fn (toTuple . lookup . Vocab.QualifiedTypeName.fromNameTuple))))+  where+    toTuple typeInfo = (Vocab.TypeInfo.toBaseOid typeInfo, Vocab.TypeInfo.toArrayOid typeInfo)++-- |+-- Refine a value decoder, lifting the possible error to the session level.+{-# INLINE refine #-}+refine :: (a -> Either Text b) -> Value a -> Value b+refine fn (Value schema typeName typeOid arrayOid dimensionality decoder) =+  Value schema typeName typeOid arrayOid dimensionality (fmap (Binary.refine fn) decoder)++-- |+-- Binary 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'+-- @+{-# INLINEABLE hstore #-}+hstore :: (forall m. (Monad m) => Int -> m (Text, Maybe Text) -> m a) -> Value a+hstore replicateM =+  Value Nothing "hstore" Nothing Nothing 0 (RequestingOid.lift (Binary.hstore replicateM Binary.text_strict Binary.text_strict))++-- |+-- Given a partial mapping from text to value, produces a decoder of that value for a named enum type.+enum ::+  -- | Schema name.+  Maybe Text ->+  -- | Type name.+  Text ->+  -- | Mapping from text to value.+  (Text -> Maybe a) ->+  Value a+enum schema typeName mapping =+  Value schema typeName Nothing Nothing 0 (RequestingOid.lift (Binary.enum mapping))++-- * Relations++toDimensionality :: Value a -> Word+toDimensionality (Value _ _ _ _ dimensionality _) = dimensionality++toSchema :: Value a -> Maybe Text+toSchema (Value schema _ _ _ _ _) = schema++toTypeName :: Value a -> Text+toTypeName (Value _ typeName _ _ _ _) = typeName++toOid :: Value a -> Maybe Word32+toOid (Value _ _ baseOid arrayOid dimensionality _) =+  if dimensionality > 0+    then arrayOid+    else baseOid++toBaseOid :: Value a -> Maybe Word32+toBaseOid (Value _ _ baseOid _ _ _) = baseOid++toArrayOid :: Value a -> Maybe Word32+toArrayOid (Value _ _ _ oid _ _) = oid++toDecoder :: Value a -> RequestingOid.RequestingOid (Binary.Value a)+toDecoder (Value _ _ _ _ _ decoder) = decoder++{-# INLINE toHandler #-}+toHandler :: Value a -> Vocab.OidCache -> Binary.Value a+toHandler (Value _ _ _ _ _ decoder) = RequestingOid.toBase decoder++{-# INLINE toByteStringParser #-}+toByteStringParser :: Value a -> (Vocab.OidCache -> ByteString -> Either Text a)+toByteStringParser (Value _ _ _ _ _ decoder) oidCache = Binary.valueParser (RequestingOid.toBase decoder oidCache)++isArray :: Value a -> Bool+isArray (Value _ _ _ _ dimensionality _) = dimensionality > 0
+ src/codecs/Hasql/Codecs/Encoders.hs view
@@ -0,0 +1,152 @@+-- |+-- 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.Codecs.Encoders+  ( -- * Parameters product+    Params.Params,+    Params.noParams,+    Params.param,++    -- * Nullability+    NullableOrNot.NullableOrNot,+    NullableOrNot.nonNullable,+    NullableOrNot.nullable,++    -- * Value+    Value.Value,+    Value.bool,+    Value.int2,+    Value.int4,+    Value.int8,+    Value.float4,+    Value.float8,+    Value.numeric,+    Value.char,+    Value.text,+    Value.varchar,+    Value.bpchar,+    Value.bytea,+    Value.date,+    Value.timestamp,+    Value.timestamptz,+    Value.time,+    Value.timetz,+    Value.interval,+    Value.uuid,+    Value.inet,+    Value.macaddr,+    Value.json,+    Value.jsonBytes,+    Value.jsonLazyBytes,+    Value.jsonb,+    Value.jsonbBytes,+    Value.jsonbLazyBytes,+    Value.int4range,+    Value.int8range,+    Value.numrange,+    Value.tsrange,+    Value.tstzrange,+    Value.daterange,+    Value.int4multirange,+    Value.int8multirange,+    Value.nummultirange,+    Value.tsmultirange,+    Value.tstzmultirange,+    Value.datemultirange,+    Value.citext,+    Value.name,+    Value.oid,+    foldableArray,+    array,+    Value.hstore,+    Value.enum,+    composite,+    Value.unknown,+    Value.custom,++    -- * Array+    Array.Array,+    Array.element,+    Array.dimension,++    -- * Composite+    Composite.Composite,+    Composite.field,+  )+where++import Data.HashMap.Strict qualified as HashMap+import Hasql.Codecs.Encoders.Array qualified as Array+import Hasql.Codecs.Encoders.Composite qualified as Composite+import Hasql.Codecs.Encoders.NullableOrNot qualified as NullableOrNot+import Hasql.Codecs.Encoders.Params qualified as Params+import Hasql.Codecs.Encoders.Value qualified as Value+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo+import Hasql.Platform.Prelude hiding (bool)+import PostgreSQL.Binary.Encoding qualified as Binary+import TextBuilder qualified++-- * Recursive definitions++-- |+-- Lift a value encoder of element into a unidimensional array encoder of a foldable value.+--+-- This function is merely a shortcut to the following expression:+--+-- @+-- ('array' . 'Array.dimension' 'foldl'' . 'Array.element')+-- @+--+-- You can use it like this:+--+-- @+-- vectorOfInts :: Value (Vector Int64)+-- vectorOfInts = 'foldableArray' ('nonNullable' 'int8')+-- @+--+-- 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.NullableOrNot Value.Value element -> Value.Value (foldable element)+foldableArray = array . Array.dimension foldl' . Array.element++-- |+-- Lift an array encoder into a value encoder.+array :: Array.Array a -> Value.Value a+array (Array.Array baseTypeSchema baseTypeName _isText dimensionality scalarOidIfKnown arrayOidIfKnown unknownTypes arrayEncoder renderer) =+  let encoder oidCache input =+        let resolvedOid =+              asum+                [ scalarOidIfKnown,+                  oidCache+                    & HashMap.lookup (Vocab.QualifiedTypeName.QualifiedTypeName baseTypeSchema baseTypeName)+                    & fmap Vocab.TypeInfo.toBaseOid+                ]+                -- Should only happen on a bug.+                & fromMaybe (Vocab.TypeInfo.toBaseOid Vocab.TypeInfo.unknown)+         in Binary.array resolvedOid (arrayEncoder oidCache input)+   in Value.Value baseTypeSchema baseTypeName scalarOidIfKnown arrayOidIfKnown dimensionality False unknownTypes encoder renderer++-- |+-- Lift a composite encoder into a value encoder for named composite types.+--+-- This function is for named composite types where the type name is known.+-- If you need to encode an anonymous composite type (like those created with the ROW constructor),+-- PostgreSQL itself does not support that.+composite ::+  -- | Schema name where the composite type is defined.+  Maybe Text ->+  -- | Composite type name.+  Text ->+  Composite.Composite a ->+  Value.Value a+composite schema name (Composite.Composite unknownTypes encode print) =+  Value.Value schema name Nothing Nothing 0 False unknownTypes encodeValue printValue+  where+    encodeValue oidCache val =+      Binary.composite (encode oidCache val)+    printValue val =+      "ROW (" <> TextBuilder.intercalate ", " (print val) <> ")"
+ src/codecs/Hasql/Codecs/Encoders/Array.hs view
@@ -0,0 +1,104 @@+module Hasql.Codecs.Encoders.Array where++import Hasql.Codecs.Encoders.NullableOrNot qualified as NullableOrNot+import Hasql.Codecs.Encoders.Value qualified as Value+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Platform.Prelude+import PostgreSQL.Binary.Encoding qualified as Binary+import TextBuilder qualified as TextBuilder++-- |+-- 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.+data Array a+  = Array+      -- | Schema name, if any.+      (Maybe Text)+      -- | Type name.+      Text+      -- | Text format?+      Bool+      -- | Dimensionality. If 0 then it is not an array, but a scalar value.+      Word+      -- | OID of the element type.+      (Maybe Word32)+      -- | OID of the array type.+      (Maybe Word32)+      -- | Names of types that are not known statically and must be looked up at runtime collected from the nested composite and array encoders.+      (HashSet Vocab.QualifiedTypeName)+      -- | Serialization function given the dictionary of resolved OIDs.+      (HashMap Vocab.QualifiedTypeName Vocab.TypeInfo -> a -> Binary.Array)+      -- | Render function for error messages.+      (a -> TextBuilder.TextBuilder)++instance Contravariant Array where+  contramap fn (Array schemaName typeName textFormat dimensionality valueOid arrayOid unknownTypes elEncoder elRenderer) =+    Array schemaName typeName textFormat dimensionality valueOid arrayOid unknownTypes (\oidCache -> elEncoder oidCache . fn) (elRenderer . fn)++-- |+-- Lifts a 'Value.Value' encoder into an 'Array' encoder.+element :: NullableOrNot.NullableOrNot Value.Value a -> Array a+element = \case+  NullableOrNot.NonNullable (Value.Value schemaName typeName scalarOid arrayOid dimensionality textFormat unknownTypes serialize print) ->+    Array+      schemaName+      typeName+      textFormat+      dimensionality+      scalarOid+      arrayOid+      unknownTypes+      (\oidCache -> Binary.encodingArray . serialize oidCache)+      print+  NullableOrNot.Nullable (Value.Value schemaName typeName scalarOid arrayOid dimensionality textFormat unknownTypes serialize print) ->+    let maybeSerialize oidCache =+          maybe Binary.nullArray (Binary.encodingArray . serialize oidCache)+        maybePrint =+          maybe (TextBuilder.string "null") print+     in Array+          schemaName+          typeName+          textFormat+          dimensionality+          scalarOid+          arrayOid+          unknownTypes+          maybeSerialize+          maybePrint++-- |+-- 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'.+{-# INLINE dimension #-}+dimension :: (forall a. (a -> b -> a) -> a -> c -> a) -> Array b -> Array c+dimension fold (Array schemaName typeName textFormat dimensionality valueOid arrayOid unknownTypes elEncoder elRenderer) =+  let encoder oidCache =+        Binary.dimensionArray fold (elEncoder oidCache)+      renderer els =+        let folded =+              let step builder el =+                    if TextBuilder.isEmpty builder+                      then TextBuilder.char '[' <> elRenderer el+                      else builder <> TextBuilder.string ", " <> elRenderer el+               in fold step mempty els+         in if TextBuilder.isEmpty folded+              then TextBuilder.string "[]"+              else folded <> TextBuilder.char ']'+   in Array schemaName typeName textFormat (succ dimensionality) valueOid arrayOid unknownTypes encoder renderer
+ src/codecs/Hasql/Codecs/Encoders/Composite.hs view
@@ -0,0 +1,97 @@+module Hasql.Codecs.Encoders.Composite where++import Data.HashMap.Strict qualified as HashMap+import Data.HashSet qualified as HashSet+import Hasql.Codecs.Encoders.NullableOrNot qualified as NullableOrNot+import Hasql.Codecs.Encoders.Value qualified as Value+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo+import Hasql.Platform.Prelude hiding (bool)+import PostgreSQL.Binary.Encoding qualified as Binary+import TextBuilder qualified++-- |+-- Composite or row-types encoder.+data Composite a+  = Composite+      -- | Names of types that are not known statically and must be looked up at runtime collected from the nested composite and array encoders.+      (HashSet Vocab.QualifiedTypeName)+      -- | Serialization function given the dictionary of resolved OIDs.+      (HashMap Vocab.QualifiedTypeName Vocab.TypeInfo -> a -> Binary.Composite)+      -- | Render function for error messages.+      (a -> [TextBuilder.TextBuilder])++instance Contravariant Composite where+  contramap f (Composite unknownTypes encode print) =+    Composite unknownTypes (\oidCache -> encode oidCache . f) (print . f)++instance Divisible Composite where+  divide f (Composite unknownTypesL encodeL printL) (Composite unknownTypesR encodeR printR) =+    Composite+      (unknownTypesL <> unknownTypesR)+      (\oidCache val -> case f val of (lVal, rVal) -> encodeL oidCache lVal <> encodeR oidCache rVal)+      (\val -> case f val of (lVal, rVal) -> printL lVal <> printR rVal)+  conquer = mempty++instance Semigroup (Composite a) where+  Composite unknownTypesL encodeL printL <> Composite unknownTypesR encodeR printR =+    Composite+      (unknownTypesL <> unknownTypesR)+      (\oidCache val -> encodeL oidCache val <> encodeR oidCache val)+      (\val -> printL val <> printR val)++instance Monoid (Composite a) where+  mempty = Composite mempty mempty mempty++-- | Single field of a row-type.+field :: NullableOrNot.NullableOrNot Value.Value a -> Composite a+field = \case+  NullableOrNot.NonNullable (Value.Value schemaName typeName scalarOid arrayOid dimensionality _ unknownTypes encode print) ->+    let staticOid = if dimensionality == 0 then scalarOid else arrayOid+     in case staticOid of+          Just oid ->+            Composite+              unknownTypes+              (\oidCache val -> Binary.field oid (encode oidCache val))+              (\val -> [print val])+          Nothing ->+            Composite+              (HashSet.insert (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes)+              ( \oidCache val ->+                  let typeInfo = HashMap.lookup (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) oidCache+                      oid = if dimensionality == 0 then maybe 0 Vocab.TypeInfo.toBaseOid typeInfo else maybe 0 Vocab.TypeInfo.toArrayOid typeInfo+                   in Binary.field oid (encode oidCache val)+              )+              (\val -> [print val])+  NullableOrNot.Nullable (Value.Value schemaName typeName scalarOid arrayOid dimensionality _ unknownTypes encode print) ->+    let staticOid = if dimensionality == 0 then scalarOid else arrayOid+     in case staticOid of+          Just oid ->+            Composite+              unknownTypes+              ( \oidCache -> \case+                  Nothing -> Binary.nullField oid+                  Just val -> Binary.field oid (encode oidCache val)+              )+              ( \case+                  Nothing -> ["NULL"]+                  Just val -> [print val]+              )+          Nothing ->+            Composite+              (HashSet.insert (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes)+              ( \oidCache -> \case+                  Nothing ->+                    let typeInfo = HashMap.lookup (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) oidCache+                        oid = if dimensionality == 0 then maybe 0 Vocab.TypeInfo.toBaseOid typeInfo else maybe 0 Vocab.TypeInfo.toArrayOid typeInfo+                     in Binary.nullField oid+                  Just val ->+                    let typeInfo = HashMap.lookup (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) oidCache+                        oid = if dimensionality == 0 then maybe 0 Vocab.TypeInfo.toBaseOid typeInfo else maybe 0 Vocab.TypeInfo.toArrayOid typeInfo+                     in Binary.field oid (encode oidCache val)+              )+              ( \case+                  Nothing -> ["NULL"]+                  Just val -> [print val]+              )
+ src/codecs/Hasql/Codecs/Encoders/NullableOrNot.hs view
@@ -0,0 +1,19 @@+module Hasql.Codecs.Encoders.NullableOrNot where++import Hasql.Platform.Prelude++-- |+-- 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
+ src/codecs/Hasql/Codecs/Encoders/Params.hs view
@@ -0,0 +1,198 @@+module Hasql.Codecs.Encoders.Params+  ( Params,+    noParams,+    param,+    toColumnsMetadata,+    toUnknownTypes,+    toSerializer,+    toPrinter,+  )+where++import Data.HashSet qualified as HashSet+import Data.Vector qualified as Vector+import Hasql.Codecs.Encoders.NullableOrNot qualified as NullableOrNot+import Hasql.Codecs.Encoders.Value qualified as Value+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.OidCache qualified as Vocab.OidCache+import Hasql.Codecs.Vocab.ParamMeta (ParamMeta (..))+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeRef qualified as Vocab.TypeRef+import Hasql.Platform.Prelude+import PostgreSQL.Binary.Encoding qualified as Binary+import TextBuilder qualified++-- | Frozen per-parameter metadata: type reference, dimensionality, text-format flag.+toColumnsMetadata :: Params a -> Vector ParamMeta+toColumnsMetadata (Params _ _ columnsMetadata _ _) = freezeColumnsMetadata columnsMetadata+  where+    freezeColumnsMetadata =+      Vector.fromList . toList++toUnknownTypes :: Params a -> HashSet Vocab.QualifiedTypeName+toUnknownTypes (Params _ unknownTypes _ _ _) =+  unknownTypes++-- | Serialise params to encoded wire values given a resolved OID cache.+toSerializer :: Params a -> Vocab.OidCache -> a -> [Maybe ByteString]+toSerializer (Params _ _ _ serializer _) = serializer++-- | Render params in human-readable form (for error reporting).+toPrinter :: Params a -> a -> [Text]+toPrinter (Params _ _ _ _ printer) = toList . printer++-- |+-- 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.Value' Gender+-- genderValue = 'enum' Nothing (Just "gender") genderText where+--   genderText gender = case gender of+--     Male -> "male"+--     Female -> "female"+-- @+data Params a = Params+  { size :: Int,+    unknownTypes :: HashSet Vocab.QualifiedTypeName,+    -- | (Type reference, dimensionality, Text Format) for each parameter.+    columnsMetadata :: DList ParamMeta,+    serializer :: Vocab.OidCache -> a -> [Maybe ByteString],+    printer :: a -> DList Text+  }++instance Contravariant Params where+  contramap fn (Params size unknownTypes columnsMetadata oldSerializer oldPrinter) = Params {..}+    where+      serializer oidCache = oldSerializer oidCache . fn+      printer = oldPrinter . fn++instance Divisible Params where+  divide+    divisor+    (Params leftSize leftUnknownTypes leftColumnsMetadata leftSerializer leftPrinter)+    (Params rightSize rightUnknownTypes rightColumnsMetadata rightSerializer rightPrinter) =+      Params+        { size = leftSize + rightSize,+          unknownTypes = leftUnknownTypes <> rightUnknownTypes,+          columnsMetadata = leftColumnsMetadata <> rightColumnsMetadata,+          serializer = \oidCache input -> case divisor input of+            (leftInput, rightInput) -> leftSerializer oidCache leftInput <> rightSerializer oidCache rightInput,+          printer = \input -> case divisor input of+            (leftInput, rightInput) -> leftPrinter leftInput <> rightPrinter rightInput+        }+  conquer =+    Params+      { size = 0,+        unknownTypes = mempty,+        columnsMetadata = mempty,+        serializer = mempty,+        printer = mempty+      }++instance Semigroup (Params a) where+  Params leftSize leftUnknownTypes leftColumnsMetadata leftSerializer leftPrinter <> Params rightSize rightUnknownTypes rightColumnsMetadata rightSerializer rightPrinter =+    Params+      { size = leftSize + rightSize,+        unknownTypes = leftUnknownTypes <> rightUnknownTypes,+        columnsMetadata = leftColumnsMetadata <> rightColumnsMetadata,+        serializer = \oidCache input -> leftSerializer oidCache input <> rightSerializer oidCache input,+        printer = \input -> leftPrinter input <> rightPrinter input+      }++instance Monoid (Params a) where+  mempty = conquer++value :: Value.Value a -> Params a+value (Value.Value schemaName typeName scalarOid arrayOid dimensionality textFormat unknownTypes serialize print) =+  let staticOid = if dimensionality == 0 then scalarOid else arrayOid+      serializer oidCache = pure . Just . Binary.encodingBytes . serialize (Vocab.OidCache.toHashMap oidCache)+      printer = pure . TextBuilder.toText . print+      size = 1+   in case staticOid of+        Just oid ->+          Params+            { size,+              unknownTypes,+              columnsMetadata = pure (ParamMeta (Vocab.TypeRef.KnownOid oid) dimensionality textFormat),+              serializer,+              printer+            }+        Nothing ->+          Params+            { size,+              unknownTypes = HashSet.insert (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes,+              columnsMetadata = pure (ParamMeta (Vocab.TypeRef.NamedType (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName)) dimensionality textFormat),+              serializer,+              printer+            }++nullableValue :: Value.Value a -> Params (Maybe a)+nullableValue (Value.Value schemaName typeName scalarOid arrayOid dimensionality textFormat unknownTypes serialize print) =+  let staticOid = if dimensionality == 0 then scalarOid else arrayOid+      serializer oidCache = pure . fmap (Binary.encodingBytes . serialize (Vocab.OidCache.toHashMap oidCache))+      printer = pure . maybe "null" (TextBuilder.toText . print)+      size = 1+   in case staticOid of+        Just oid ->+          Params+            { size,+              unknownTypes,+              columnsMetadata = pure (ParamMeta (Vocab.TypeRef.KnownOid oid) dimensionality textFormat),+              serializer,+              printer+            }+        Nothing ->+          Params+            { size,+              unknownTypes = HashSet.insert (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes,+              columnsMetadata = pure (ParamMeta (Vocab.TypeRef.NamedType (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName)) dimensionality textFormat),+              serializer,+              printer+            }++-- |+-- 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.NullableOrNot Value.Value a -> Params a+param = \case+  NullableOrNot.NonNullable valueEnc -> value valueEnc+  NullableOrNot.Nullable valueEnc -> nullableValue valueEnc
+ src/codecs/Hasql/Codecs/Encoders/Value.hs view
@@ -0,0 +1,456 @@+module Hasql.Codecs.Encoders.Value where++import ByteString.StrictBuilder qualified+import Data.Aeson qualified as Aeson+import Data.ByteString.Lazy qualified as LazyByteString+import Data.HashMap.Strict qualified as HashMap+import Data.HashSet qualified as HashSet+import Data.IP qualified as Iproute+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo+import Hasql.Platform.Prelude+import PostgreSQL.Binary.Encoding qualified as Binary+import PostgreSQL.Binary.Range qualified as Range+import TextBuilder qualified as TextBuilder++-- |+-- Value encoder.+data Value a+  = Value+      -- | Schema name, if any.+      (Maybe Text)+      -- | Type name.+      Text+      -- | Statically known OID for the type.+      -- When unspecified, the OID may be determined at runtime by looking up by name.+      (Maybe Word32)+      -- | Statically known OID for the array-type with this type as the element.+      -- When unspecified, the OID may be determined at runtime by looking up by name.+      -- It may also mean that there may be no array type containing this type, which is the case in attempts to double-nest arrays.+      (Maybe Word32)+      -- | Dimensionality. If 0 then it is not an array, but a scalar value.+      Word+      -- | Text format?+      Bool+      -- | Names of types that are not known statically and must be looked up at runtime collected from the nested composite and array encoders.+      (HashSet Vocab.QualifiedTypeName)+      -- | Serialization function on the resolved OIDs.+      (HashMap Vocab.QualifiedTypeName Vocab.TypeInfo.TypeInfo -> a -> Binary.Encoding)+      -- | Render function for error messages.+      (a -> TextBuilder.TextBuilder)++instance Contravariant Value where+  {-# INLINE contramap #-}+  contramap f (Value schemaName typeName valueOid arrayOid dimensionality textFormat unknownTypes encode render) =+    Value schemaName typeName valueOid arrayOid dimensionality textFormat unknownTypes (\hashMap -> encode hashMap . f) (render . f)++{-# INLINE primitive #-}+primitive :: Text -> Bool -> Vocab.TypeInfo.TypeInfo -> (a -> Binary.Encoding) -> (a -> TextBuilder.TextBuilder) -> Value a+primitive typeName isText typeInfo encode render =+  Value+    Nothing+    typeName+    (Just (Vocab.TypeInfo.toBaseOid typeInfo))+    (Just (Vocab.TypeInfo.toArrayOid typeInfo))+    0+    isText+    HashSet.empty+    (const encode)+    render++-- |+-- Encoder of @BOOL@ values.+{-# INLINEABLE bool #-}+bool :: Value Bool+bool = primitive "bool" False Vocab.TypeInfo.bool Binary.bool (TextBuilder.string . show)++-- |+-- Encoder of @INT2@ values.+{-# INLINEABLE int2 #-}+int2 :: Value Int16+int2 = primitive "int2" False Vocab.TypeInfo.int2 Binary.int2_int16 (TextBuilder.string . show)++-- |+-- Encoder of @INT4@ values.+{-# INLINEABLE int4 #-}+int4 :: Value Int32+int4 = primitive "int4" False Vocab.TypeInfo.int4 Binary.int4_int32 (TextBuilder.string . show)++-- |+-- Encoder of @INT8@ values.+{-# INLINEABLE int8 #-}+int8 :: Value Int64+int8 = primitive "int8" False Vocab.TypeInfo.int8 Binary.int8_int64 (TextBuilder.string . show)++-- |+-- Encoder of @FLOAT4@ values.+{-# INLINEABLE float4 #-}+float4 :: Value Float+float4 = primitive "float4" False Vocab.TypeInfo.float4 Binary.float4 (TextBuilder.string . show)++-- |+-- Encoder of @FLOAT8@ values.+{-# INLINEABLE float8 #-}+float8 :: Value Double+float8 = primitive "float8" False Vocab.TypeInfo.float8 Binary.float8 (TextBuilder.string . show)++-- |+-- Encoder of @NUMERIC@ values.+{-# INLINEABLE numeric #-}+numeric :: Value Scientific+numeric = primitive "numeric" False Vocab.TypeInfo.numeric Binary.numeric (TextBuilder.string . show)++-- |+-- Encoder of @CHAR@ values.+--+-- Note that it supports Unicode values and+-- identifies itself under the @TEXT@ OID because of that.+{-# INLINEABLE char #-}+char :: Value Char+char = primitive "char" False Vocab.TypeInfo.text Binary.char_utf8 (TextBuilder.string . show)++-- |+-- Encoder of @TEXT@ values.+{-# INLINEABLE text #-}+text :: Value Text+text = primitive "text" False Vocab.TypeInfo.text Binary.text_strict (TextBuilder.string . show)++-- |+-- Encoder of @VARCHAR@ values.+{-# INLINEABLE varchar #-}+varchar :: Value Text+varchar = primitive "varchar" False Vocab.TypeInfo.varchar Binary.text_strict (TextBuilder.string . show)++-- |+-- Encoder of @BPCHAR@ or @CHAR(n)@, @CHARACTER(n)@ values.+{-# INLINEABLE bpchar #-}+bpchar :: Value Text+bpchar = primitive "bpchar" False Vocab.TypeInfo.bpchar Binary.text_strict (TextBuilder.string . show)++-- |+-- Encoder of @BYTEA@ values.+{-# INLINEABLE bytea #-}+bytea :: Value ByteString+bytea = primitive "bytea" False Vocab.TypeInfo.bytea Binary.bytea_strict (TextBuilder.string . show)++-- |+-- Encoder of @DATE@ values.+{-# INLINEABLE date #-}+date :: Value Day+date = primitive "date" False Vocab.TypeInfo.date Binary.date (TextBuilder.string . show)++-- |+-- Encoder of @TIMESTAMP@ values.+{-# INLINEABLE timestamp #-}+timestamp :: Value LocalTime+timestamp = primitive "timestamp" False Vocab.TypeInfo.timestamp Binary.timestamp_int (TextBuilder.string . show)++-- |+-- Encoder of @TIMESTAMPTZ@ values.+{-# INLINEABLE timestamptz #-}+timestamptz :: Value UTCTime+timestamptz = primitive "timestamptz" False Vocab.TypeInfo.timestamptz Binary.timestamptz_int (TextBuilder.string . show)++-- |+-- Encoder of @TIME@ values.+{-# INLINEABLE time #-}+time :: Value TimeOfDay+time = primitive "time" False Vocab.TypeInfo.time Binary.time_int (TextBuilder.string . show)++-- |+-- Encoder of @TIMETZ@ values.+{-# INLINEABLE timetz #-}+timetz :: Value (TimeOfDay, TimeZone)+timetz = primitive "timetz" False Vocab.TypeInfo.timetz Binary.timetz_int (TextBuilder.string . show)++-- |+-- Encoder of @INTERVAL@ values.+{-# INLINEABLE interval #-}+interval :: Value DiffTime+interval = primitive "interval" False Vocab.TypeInfo.interval Binary.interval_int (TextBuilder.string . show)++-- |+-- Encoder of @UUID@ values.+{-# INLINEABLE uuid #-}+uuid :: Value UUID+uuid = primitive "uuid" False Vocab.TypeInfo.uuid Binary.uuid (TextBuilder.string . show)++-- |+-- Encoder of @INET@ values.+{-# INLINEABLE inet #-}+inet :: Value Iproute.IPRange+inet = primitive "inet" False Vocab.TypeInfo.inet Binary.inet (TextBuilder.string . show)++-- |+-- Encoder of @MACADDR@ values.+--+-- Represented as a 6-tuple of Word8 values in big endian order. If+-- you use `ip` library you can convert using its `toOctets`.+--+-- > toOctets >$< macaddr+{-# INLINEABLE macaddr #-}+macaddr :: Value (Word8, Word8, Word8, Word8, Word8, Word8)+macaddr = primitive "macaddr" False Vocab.TypeInfo.macaddr Binary.macaddr (TextBuilder.string . show)++-- |+-- Encoder of @JSON@ values from JSON AST.+{-# INLINEABLE json #-}+json :: Value Aeson.Value+json = primitive "json" False Vocab.TypeInfo.json Binary.json_ast (TextBuilder.string . show)++-- |+-- Encoder of @JSON@ values from raw JSON.+{-# INLINEABLE jsonBytes #-}+jsonBytes :: Value ByteString+jsonBytes = primitive "json" False Vocab.TypeInfo.json Binary.json_bytes (TextBuilder.string . show)++-- |+-- Encoder of @JSON@ values from raw JSON as lazy ByteString.+{-# INLINEABLE jsonLazyBytes #-}+jsonLazyBytes :: Value LazyByteString.ByteString+jsonLazyBytes = primitive "json" False Vocab.TypeInfo.json Binary.json_bytes_lazy (TextBuilder.string . show)++-- |+-- Encoder of @JSONB@ values from JSON AST.+{-# INLINEABLE jsonb #-}+jsonb :: Value Aeson.Value+jsonb = primitive "jsonb" False Vocab.TypeInfo.jsonb Binary.jsonb_ast (TextBuilder.string . show)++-- |+-- Encoder of @JSONB@ values from raw JSON.+{-# INLINEABLE jsonbBytes #-}+jsonbBytes :: Value ByteString+jsonbBytes = primitive "jsonb" False Vocab.TypeInfo.jsonb Binary.jsonb_bytes (TextBuilder.string . show)++-- |+-- Encoder of @JSONB@ values from raw JSON as lazy ByteString.+{-# INLINEABLE jsonbLazyBytes #-}+jsonbLazyBytes :: Value LazyByteString.ByteString+jsonbLazyBytes = primitive "jsonb" False Vocab.TypeInfo.jsonb Binary.jsonb_bytes_lazy (TextBuilder.string . show)++-- |+-- Encoder of @OID@ values.+{-# INLINEABLE oid #-}+oid :: Value Int32+oid = primitive "oid" False Vocab.TypeInfo.oid Binary.int4_int32 (TextBuilder.string . show)++-- |+-- Encoder of @NAME@ values.+{-# INLINEABLE name #-}+name :: Value Text+name = primitive "name" False Vocab.TypeInfo.name Binary.text_strict (TextBuilder.string . show)++-- |+-- Encoder of @INT4RANGE@ values.+{-# INLINEABLE int4range #-}+int4range :: Value (Range.Range Int32)+int4range = primitive "int4range" False Vocab.TypeInfo.int4range Binary.int4range (TextBuilder.string . show)++-- |+-- Encoder of @INT8RANGE@ values.+{-# INLINEABLE int8range #-}+int8range :: Value (Range.Range Int64)+int8range = primitive "int8range" False Vocab.TypeInfo.int8range Binary.int8range (TextBuilder.string . show)++-- |+-- Encoder of @NUMRANGE@ values.+{-# INLINEABLE numrange #-}+numrange :: Value (Range.Range Scientific)+numrange = primitive "numrange" False Vocab.TypeInfo.numrange Binary.numrange (TextBuilder.string . show)++-- |+-- Encoder of @TSRANGE@ values.+{-# INLINEABLE tsrange #-}+tsrange :: Value (Range.Range LocalTime)+tsrange = primitive "tsrange" False Vocab.TypeInfo.tsrange Binary.tsrange_int (TextBuilder.string . show)++-- |+-- Encoder of @TSTZRANGE@ values.+{-# INLINEABLE tstzrange #-}+tstzrange :: Value (Range.Range UTCTime)+tstzrange = primitive "tstzrange" False Vocab.TypeInfo.tstzrange Binary.tstzrange_int (TextBuilder.string . show)++-- |+-- Encoder of @DATERANGE@ values.+{-# INLINEABLE daterange #-}+daterange :: Value (Range.Range Day)+daterange = primitive "daterange" False Vocab.TypeInfo.daterange Binary.daterange (TextBuilder.string . show)++-- |+-- Encoder of @INT4MULTIRANGE@ values.+{-# INLINEABLE int4multirange #-}+int4multirange :: Value (Range.Multirange Int32)+int4multirange = primitive "int4multirange" False Vocab.TypeInfo.int4multirange Binary.int4multirange (TextBuilder.string . show)++-- |+-- Encoder of @INT8MULTIRANGE@ values.+{-# INLINEABLE int8multirange #-}+int8multirange :: Value (Range.Multirange Int64)+int8multirange = primitive "int8multirange" False Vocab.TypeInfo.int8multirange Binary.int8multirange (TextBuilder.string . show)++-- |+-- Encoder of @NUMMULTIRANGE@ values.+{-# INLINEABLE nummultirange #-}+nummultirange :: Value (Range.Multirange Scientific)+nummultirange = primitive "nummultirange" False Vocab.TypeInfo.nummultirange Binary.nummultirange (TextBuilder.string . show)++-- |+-- Encoder of @TSMULTIRANGE@ values.+{-# INLINEABLE tsmultirange #-}+tsmultirange :: Value (Range.Multirange LocalTime)+tsmultirange = primitive "tsmultirange" False Vocab.TypeInfo.tsmultirange Binary.tsmultirange_int (TextBuilder.string . show)++-- |+-- Encoder of @TSTZMULTIRANGE@ values.+{-# INLINEABLE tstzmultirange #-}+tstzmultirange :: Value (Range.Multirange UTCTime)+tstzmultirange = primitive "tstzmultirange" False Vocab.TypeInfo.tstzmultirange Binary.tstzmultirange_int (TextBuilder.string . show)++-- |+-- Encoder of @DATEMULTIRANGE@ values.+{-# INLINEABLE datemultirange #-}+datemultirange :: Value (Range.Multirange Day)+datemultirange = primitive "datemultirange" False Vocab.TypeInfo.datemultirange Binary.datemultirange (TextBuilder.string . show)++-- |+-- Encoder of @CITEXT@ values.+--+-- Requires the @citext@ extension to be installed in the database.+{-# INLINEABLE citext #-}+citext :: Value Text+citext =+  Value+    Nothing+    "citext"+    Nothing+    Nothing+    0+    False+    HashSet.empty+    (const Binary.text_strict)+    (TextBuilder.string . show)++-- |+-- Given a function which maps a value into a textual enum label used on the DB side,+-- produces an encoder of that value for a named enum type.+{-# INLINEABLE enum #-}+enum ::+  -- | Schema name where the enum type is defined.+  Maybe Text ->+  -- | Enum type name.+  Text ->+  -- | Mapping function from value to enum label.+  (a -> Text) ->+  Value a+enum schemaName typeName mapping =+  Value+    schemaName+    typeName+    Nothing+    Nothing+    0+    False+    (HashSet.singleton (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName))+    (const (Binary.text_strict . mapping))+    (TextBuilder.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 transmitted 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.+--+-- __Warning:__ Do not use this as part of composite encoders like 'array' since+-- it is the only encoder that doesn't use the binary format.+{-# DEPRECATED unknown "Use 'custom' instead." #-}+{-# INLINEABLE unknown #-}+unknown :: Value ByteString+unknown = primitive "unknown" True Vocab.TypeInfo.unknown Binary.bytea_strict (TextBuilder.string . show)++-- |+-- Low level API for defining custom value encoders.+{-# INLINEABLE custom #-}+custom ::+  -- | Schema name where the type is defined.+  Maybe Text ->+  -- | Type name.+  Text ->+  -- | Possible static OIDs for the type. The first is for scalar values the second is for arrays.+  --+  -- When unspecified, the OIDs will be automatically determined at runtime by looking up by name.+  Maybe (Word32, Word32) ->+  -- | Other named types whose OIDs are needed for serializing.+  --+  -- E.g., when encoding composite types Postgres requires specifying OIDs of all of its fields.+  --+  -- When any of the requested types is missing in the database an error will be raised upon the statement execution.+  [(Maybe Text, Text)] ->+  -- | Serialization function in the context of resolved OIDs of the types requested in the previous parameter.+  --+  -- It's safe to assume that all of the requested types will be present.+  -- In case you run the provided lookup function with unmentioned type names it will produce OID of 0 for them, standing for unknown type in Postgres.+  ( ((Maybe Text, Text) -> (Word32, Word32)) ->+    a ->+    ByteString+  ) ->+  -- | Render function for error messages.+  (a -> Text) ->+  Value a+custom schemaName typeName staticOids requiredTypes encode render =+  Value+    schemaName+    typeName+    (fmap fst staticOids)+    (fmap snd staticOids)+    0+    False+    (HashSet.fromList (fmap Vocab.QualifiedTypeName.fromNameTuple requiredTypes))+    ( \hashMap ->+        ByteString.StrictBuilder.bytes+          . encode+            ( \name ->+                fromMaybe (0, 0)+                  $ HashMap.lookup (Vocab.QualifiedTypeName.fromNameTuple name) hashMap+                  <&> \typeInfo -> (Vocab.TypeInfo.toBaseOid typeInfo, Vocab.TypeInfo.toArrayOid typeInfo)+            )+    )+    (TextBuilder.text . render)++-- |+-- Encoder of @HSTORE@ values from a foldable container of key-value pairs.+--+-- The value part can be @Nothing@ to represent a NULL value in the hstore.+{-# INLINEABLE hstore #-}+hstore :: (Foldable foldable) => Value (foldable (Text, Maybe Text))+hstore =+  Value+    Nothing+    "hstore"+    Nothing+    Nothing+    0+    False+    HashSet.empty+    (const Binary.hStore_foldable)+    renderHstore+  where+    renderHstore items =+      mconcat+        [ TextBuilder.text "hstore(",+          TextBuilder.intercalate ", " (foldMap (\pair -> [renderPair pair]) items),+          TextBuilder.text ")"+        ]+    renderPair (key, maybeValue) =+      mconcat+        [ TextBuilder.text "(",+          TextBuilder.string (show key),+          TextBuilder.text ", ",+          case maybeValue of+            Nothing -> TextBuilder.text "NULL"+            Just value -> TextBuilder.string (show value),+          TextBuilder.text ")"+        ]
+ src/codecs/Hasql/Codecs/RequestingOid.hs view
@@ -0,0 +1,67 @@+module Hasql.Codecs.RequestingOid+  ( RequestingOid,+    toUnknownTypes,+    toBase,+    requestAndHandle,+    lift,+    hoist,+    lookup,+    lookingUp,+    hoistLookingUp,+  )+where++import Hasql.Codecs.RequestingOid.LookingUp qualified as LookingUp+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.OidCache qualified as Vocab.OidCache+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo+import Hasql.Platform.Prelude hiding (lift, lookup)++type RequestingOid =+  LookingUp.LookingUp+    Vocab.QualifiedTypeName+    Vocab.TypeInfo.TypeInfo++{-# INLINE toUnknownTypes #-}+toUnknownTypes ::+  RequestingOid a ->+  HashSet Vocab.QualifiedTypeName+toUnknownTypes (LookingUp.LookingUp unknownTypes _) =+  fromList unknownTypes++{-# INLINE toBase #-}+toBase ::+  RequestingOid a ->+  Vocab.OidCache ->+  a+toBase (LookingUp.LookingUp _unknownTypes decoder) oidCache =+  decoder \key ->+    Vocab.OidCache.lookupTypeInfo key oidCache+      & fromMaybe (Vocab.TypeInfo.TypeInfo 0 0)++{-# INLINE requestAndHandle #-}+requestAndHandle ::+  [Vocab.QualifiedTypeName] ->+  ((Vocab.QualifiedTypeName -> Vocab.TypeInfo.TypeInfo) -> a) ->+  RequestingOid a+requestAndHandle keys fn = LookingUp.LookingUp keys fn++{-# INLINE lift #-}+lift :: a -> RequestingOid a+lift = LookingUp.lift++{-# INLINE hoist #-}+hoist :: (a -> b) -> RequestingOid a -> RequestingOid b+hoist fn (LookingUp.LookingUp keys use) = LookingUp.LookingUp keys (fn . use)++{-# INLINE lookup #-}+lookup :: Vocab.QualifiedTypeName -> RequestingOid Vocab.TypeInfo.TypeInfo+lookup = LookingUp.lookup++{-# INLINE lookingUp #-}+lookingUp :: Vocab.QualifiedTypeName -> (Vocab.TypeInfo.TypeInfo -> a) -> RequestingOid a+lookingUp = LookingUp.lookingUp++{-# INLINE hoistLookingUp #-}+hoistLookingUp :: Vocab.QualifiedTypeName -> (Vocab.TypeInfo.TypeInfo -> a -> b) -> RequestingOid a -> RequestingOid b+hoistLookingUp = LookingUp.hoistLookingUp
+ src/codecs/Hasql/Codecs/RequestingOid/LookingUp.hs view
@@ -0,0 +1,45 @@+module Hasql.Codecs.RequestingOid.LookingUp where++import Control.Applicative+import Prelude++data LookingUp k v a+  = LookingUp+      -- | Keys requested to be available for lookup.+      [k]+      -- | Continuation that looks up values by keys.+      ((k -> v) -> a)++type role LookingUp _ _ representational++deriving stock instance Functor (LookingUp k v)++instance Applicative (LookingUp k v) where+  {-# INLINE pure #-}+  pure a =+    LookingUp [] (\_ -> a)+  {-# INLINE (<*>) #-}+  LookingUp lKeys lUse <*> LookingUp rKeys rUse =+    LookingUp+      (lKeys <> rKeys)+      (\lookup -> lUse lookup (rUse lookup))++{-# INLINE lookup #-}+lookup :: k -> LookingUp k v v+lookup key =+  LookingUp [key] (\lookupFn -> lookupFn key)++{-# INLINE lift #-}+lift :: a -> LookingUp k v a+lift fa =+  LookingUp [] (const fa)++{-# INLINE lookingUp #-}+lookingUp :: k -> (v -> a) -> LookingUp k v a+lookingUp key cont =+  LookingUp [key] (\lookupFn -> cont (lookupFn key))++{-# INLINE hoistLookingUp #-}+hoistLookingUp :: k -> (v -> a -> b) -> LookingUp k v a -> LookingUp k v b+hoistLookingUp k tx (LookingUp keys use) =+  LookingUp (k : keys) (\lookupFn -> tx (lookupFn k) (use lookupFn))
+ src/codecs/Hasql/Codecs/Vocab.hs view
@@ -0,0 +1,14 @@+module Hasql.Codecs.Vocab+  ( QualifiedTypeName,+    TypeInfo,+    TypeRef,+    ParamMeta,+    OidCache,+  )+where++import Hasql.Codecs.Vocab.OidCache (OidCache)+import Hasql.Codecs.Vocab.ParamMeta (ParamMeta)+import Hasql.Codecs.Vocab.QualifiedTypeName (QualifiedTypeName)+import Hasql.Codecs.Vocab.TypeInfo (TypeInfo)+import Hasql.Codecs.Vocab.TypeRef (TypeRef)
+ src/codecs/Hasql/Codecs/Vocab/OidCache.hs view
@@ -0,0 +1,91 @@+module Hasql.Codecs.Vocab.OidCache+  ( OidCache,++    -- * Accessors+    toHashMap,+    lookupScalar,+    lookupArray,+    lookupTypeNameScalar,+    lookupTypeNameArray,+    lookupTypeInfo,++    -- * Constructors+    fromHashMap,+    empty,+    selectUnknownNames,+    insertScalar,+  )+where++import Data.HashMap.Strict qualified as HashMap+import Data.HashSet qualified as HashSet+import Hasql.Codecs.Vocab.QualifiedTypeName (QualifiedTypeName)+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as TypeInfo+import Hasql.Platform.Prelude hiding (empty, insert, lookup, reset)++-- | Pure registry state containing the hash map and counter+newtype OidCache+  = OidCache+      -- | By name of the type.+      --+      -- > scalar name -> TypeInfo (scalar OID, array OID)+      (HashMap QualifiedTypeName TypeInfo.TypeInfo)+  deriving stock (Show, Eq)++instance Semigroup OidCache where+  OidCache byNameL <> OidCache byNameR =+    OidCache (HashMap.union byNameR byNameL)++instance Monoid OidCache where+  mempty = OidCache mempty++{-# INLINEABLE empty #-}+empty :: OidCache+empty =+  OidCache HashMap.empty++-- | Having a set of required type names, select those that are not present in the cache.+{-# INLINE selectUnknownNames #-}+selectUnknownNames :: HashSet QualifiedTypeName -> OidCache -> HashSet QualifiedTypeName+selectUnknownNames keys (OidCache byName) =+  HashSet.filter (\key -> not (HashMap.member key byName)) keys++insertScalar :: Maybe Text -> Text -> Word32 -> Word32 -> OidCache -> OidCache+insertScalar schema name scalar array (OidCache byName) =+  OidCache (HashMap.insert (QualifiedTypeName.QualifiedTypeName schema name) (TypeInfo.TypeInfo scalar array) byName)++{-# INLINE fromHashMap #-}+fromHashMap :: HashMap QualifiedTypeName TypeInfo.TypeInfo -> OidCache+fromHashMap byName = OidCache byName++-- * Accessors++{-# INLINE lookupScalar #-}+lookupScalar :: Maybe Text -> Text -> OidCache -> Maybe Word32+lookupScalar schema name (OidCache byName) =+  HashMap.lookup (QualifiedTypeName.QualifiedTypeName schema name) byName <&> \info -> TypeInfo.toBaseOid info++{-# INLINE lookupArray #-}+lookupArray :: Maybe Text -> Text -> OidCache -> Maybe Word32+lookupArray schema name (OidCache byName) =+  HashMap.lookup (QualifiedTypeName.QualifiedTypeName schema name) byName <&> \info -> TypeInfo.toArrayOid info++{-# INLINE lookupTypeNameScalar #-}+lookupTypeNameScalar :: QualifiedTypeName -> OidCache -> Maybe Word32+lookupTypeNameScalar name (OidCache byName) =+  HashMap.lookup name byName <&> TypeInfo.toBaseOid++{-# INLINE lookupTypeNameArray #-}+lookupTypeNameArray :: QualifiedTypeName -> OidCache -> Maybe Word32+lookupTypeNameArray name (OidCache byName) =+  HashMap.lookup name byName <&> TypeInfo.toArrayOid++{-# INLINE lookupTypeInfo #-}+lookupTypeInfo :: QualifiedTypeName -> OidCache -> Maybe TypeInfo.TypeInfo+lookupTypeInfo name (OidCache byName) =+  HashMap.lookup name byName++{-# INLINE toHashMap #-}+toHashMap :: OidCache -> HashMap QualifiedTypeName TypeInfo.TypeInfo+toHashMap (OidCache byName) = byName
+ src/codecs/Hasql/Codecs/Vocab/ParamMeta.hs view
@@ -0,0 +1,13 @@+module Hasql.Codecs.Vocab.ParamMeta+  ( ParamMeta (..),+  )+where++import Hasql.Codecs.Vocab.TypeRef (TypeRef)+import Hasql.Platform.Prelude++-- | Per-parameter metadata: type reference, array dimensionality, text-format flag.+data ParamMeta = ParamMeta TypeRef Word Bool+  deriving stock (Eq, Ord, Show, Generic)++instance Hashable ParamMeta
+ src/codecs/Hasql/Codecs/Vocab/QualifiedTypeName.hs view
@@ -0,0 +1,43 @@+module Hasql.Codecs.Vocab.QualifiedTypeName+  ( QualifiedTypeName (..),+    fromNameTuple,+    toNameTuple,+  )+where++import Hasql.Platform.Prelude++-- |+-- A Postgres type identified by name: an optional schema together with a+-- required type name.+--+-- A 'Nothing' schema means the name is unqualified and is resolved via the+-- server's search path.+--+-- Used as the key under which a type's OIDs are resolved and cached.+data QualifiedTypeName = QualifiedTypeName+  { schema :: Maybe Text,+    name :: Text+  }+  deriving stock (Eq, Ord, Show, Generic)++instance Hashable QualifiedTypeName++-- | An unqualified name constructor for convenience.+instance IsString QualifiedTypeName where+  fromString = QualifiedTypeName Nothing . fromString++-- |+-- Convert from the legacy @(schema, name)@ tuple representation.+--+-- Used at public-API boundaries (e.g. the @custom@ codecs and error types)+-- where the tuple is still exposed but internals operate on 'QualifiedTypeName'.+fromNameTuple :: (Maybe Text, Text) -> QualifiedTypeName+fromNameTuple (schema, name) = QualifiedTypeName schema name++-- |+-- Convert to the legacy @(schema, name)@ tuple representation.+--+-- See 'fromNameTuple'.+toNameTuple :: QualifiedTypeName -> (Maybe Text, Text)+toNameTuple (QualifiedTypeName schema name) = (schema, name)
+ src/codecs/Hasql/Codecs/Vocab/TypeInfo.hs view
@@ -0,0 +1,230 @@+module Hasql.Codecs.Vocab.TypeInfo where++import Hasql.Platform.Prelude hiding (bool)++-- | A Postgresql type info+data TypeInfo+  = TypeInfo {toBaseOid :: Word32, toArrayOid :: Word32}+  deriving (Eq, Ord, Show)++abstime :: TypeInfo+abstime = TypeInfo 702 1023++aclitem :: TypeInfo+aclitem = TypeInfo 1033 1034++bit :: TypeInfo+bit = TypeInfo 1560 1561++bool :: TypeInfo+bool = TypeInfo 16 1000++box :: TypeInfo+box = TypeInfo 603 1020++bpchar :: TypeInfo+bpchar = TypeInfo 1042 1014++bytea :: TypeInfo+bytea = TypeInfo 17 1001++char :: TypeInfo+char = TypeInfo 18 1002++cid :: TypeInfo+cid = TypeInfo 29 1012++cidr :: TypeInfo+cidr = TypeInfo 650 651++circle :: TypeInfo+circle = TypeInfo 718 719++cstring :: TypeInfo+cstring = TypeInfo 2275 1263++date :: TypeInfo+date = TypeInfo 1082 1182++daterange :: TypeInfo+daterange = TypeInfo 3912 3913++datemultirange :: TypeInfo+datemultirange = TypeInfo 4535 6155++float4 :: TypeInfo+float4 = TypeInfo 700 1021++float8 :: TypeInfo+float8 = TypeInfo 701 1022++gtsvector :: TypeInfo+gtsvector = TypeInfo 3642 3644++inet :: TypeInfo+inet = TypeInfo 869 1041++int2 :: TypeInfo+int2 = TypeInfo 21 1005++int2vector :: TypeInfo+int2vector = TypeInfo 22 1006++int4 :: TypeInfo+int4 = TypeInfo 23 1007++int4range :: TypeInfo+int4range = TypeInfo 3904 3905++int4multirange :: TypeInfo+int4multirange = TypeInfo 4451 6150++int8 :: TypeInfo+int8 = TypeInfo 20 1016++int8range :: TypeInfo+int8range = TypeInfo 3926 3927++int8multirange :: TypeInfo+int8multirange = TypeInfo 4536 6157++interval :: TypeInfo+interval = TypeInfo 1186 1187++json :: TypeInfo+json = TypeInfo 114 199++jsonb :: TypeInfo+jsonb = TypeInfo 3802 3807++line :: TypeInfo+line = TypeInfo 628 629++lseg :: TypeInfo+lseg = TypeInfo 601 1018++macaddr :: TypeInfo+macaddr = TypeInfo 829 1040++money :: TypeInfo+money = TypeInfo 790 791++name :: TypeInfo+name = TypeInfo 19 1003++numeric :: TypeInfo+numeric = TypeInfo 1700 1231++numrange :: TypeInfo+numrange = TypeInfo 3906 3907++nummultirange :: TypeInfo+nummultirange = TypeInfo 4532 6151++oid :: TypeInfo+oid = TypeInfo 26 1028++oidvector :: TypeInfo+oidvector = TypeInfo 30 1013++path :: TypeInfo+path = TypeInfo 602 1019++point :: TypeInfo+point = TypeInfo 600 1017++polygon :: TypeInfo+polygon = TypeInfo 604 1027++record :: TypeInfo+record = TypeInfo 2249 2287++refcursor :: TypeInfo+refcursor = TypeInfo 1790 2201++regclass :: TypeInfo+regclass = TypeInfo 2205 2210++regconfig :: TypeInfo+regconfig = TypeInfo 3734 3735++regdictionary :: TypeInfo+regdictionary = TypeInfo 3769 3770++regoper :: TypeInfo+regoper = TypeInfo 2203 2208++regoperator :: TypeInfo+regoperator = TypeInfo 2204 2209++regproc :: TypeInfo+regproc = TypeInfo 24 1008++regprocedure :: TypeInfo+regprocedure = TypeInfo 2202 2207++regtype :: TypeInfo+regtype = TypeInfo 2206 2211++reltime :: TypeInfo+reltime = TypeInfo 703 1024++text :: TypeInfo+text = TypeInfo 25 1009++tid :: TypeInfo+tid = TypeInfo 27 1010++time :: TypeInfo+time = TypeInfo 1083 1183++timestamp :: TypeInfo+timestamp = TypeInfo 1114 1115++timestamptz :: TypeInfo+timestamptz = TypeInfo 1184 1185++timetz :: TypeInfo+timetz = TypeInfo 1266 1270++tinterval :: TypeInfo+tinterval = TypeInfo 704 1025++tsquery :: TypeInfo+tsquery = TypeInfo 3615 3645++tsrange :: TypeInfo+tsrange = TypeInfo 3908 3909++tsmultirange :: TypeInfo+tsmultirange = TypeInfo 4533 6152++tstzrange :: TypeInfo+tstzrange = TypeInfo 3910 3911++tstzmultirange :: TypeInfo+tstzmultirange = TypeInfo 4534 6153++tsvector :: TypeInfo+tsvector = TypeInfo 3614 3643++txid_snapshot :: TypeInfo+txid_snapshot = TypeInfo 2970 2949++unknown :: TypeInfo+unknown = TypeInfo 705 705++uuid :: TypeInfo+uuid = TypeInfo 2950 2951++varbit :: TypeInfo+varbit = TypeInfo 1562 1563++varchar :: TypeInfo+varchar = TypeInfo 1043 1015++xid :: TypeInfo+xid = TypeInfo 28 1011++xml :: TypeInfo+xml = TypeInfo 142 143
+ src/codecs/Hasql/Codecs/Vocab/TypeRef.hs view
@@ -0,0 +1,20 @@+module Hasql.Codecs.Vocab.TypeRef+  ( TypeRef (..),+  )+where++import Hasql.Codecs.Vocab.QualifiedTypeName (QualifiedTypeName)+import Hasql.Platform.Prelude++-- |+-- How a parameter's Postgres type is identified within parameter metadata:+-- either an already-known OID, or a 'QualifiedTypeName' still pending OID+-- resolution against the server.+data TypeRef+  = -- | The type's OID is statically known.+    KnownOid Word32+  | -- | The type is named and its OID must be resolved before execution.+    NamedType QualifiedTypeName+  deriving stock (Eq, Ord, Show, Generic)++instance Hashable TypeRef
src/comms-tests/Hasql/Comms/Session/CleanUpAfterInterruptionSpec.hs view
@@ -2,7 +2,8 @@  import Hasql.Comms.Session qualified as Session import Hasql.Platform.Prelude-import Hasql.Pq qualified as Pq+import Pqi qualified as Pq+import Pqi.Ffi qualified import Test.Hspec import TextBuilder qualified @@ -61,7 +62,7 @@         finalPipelineStatus `shouldBe` Pq.PipelineOff      -- Deterministic counterpart to the timing-based reproduction in-    -- "Sharing.ByBug.PipelineAbortedInterruptionCleanupSpec": instead of+    -- "Sharing.Connection.Use.PipelineAbortedInterruptionCleanupSpec": instead of     -- racing an async exception into the narrow window during which libpq's     -- pipeline is in the aborted state, we put the connection into that state     -- directly and invoke the cleanup that an interruption would have@@ -223,7 +224,7 @@             " dbname=postgres"           ]    in bracket-        (Pq.connectdb connectionString)+        (Pq.connectdb Pqi.Ffi.adapter connectionString)         ( \connection -> do             Pq.finish connection         )
+ src/comms/Hasql/Comms/Recv.hs view
@@ -0,0 +1,108 @@+module Hasql.Comms.Recv+  ( Recv,+    singleResult,+    allResults,+    toHandler,+    Error (..),+  )+where++import Hasql.Comms.ResultDecoder qualified as ResultDecoder+import Hasql.Platform.Prelude+import Pqi qualified as Pq++newtype Recv context a+  = Recv (Pq.Connection -> IO (Either (Error context) a))+  deriving stock (Functor)++instance Applicative (Recv context) where+  {-# INLINE pure #-}+  pure x = Recv \_ -> pure (Right x)+  {-# INLINE (<*>) #-}+  Recv recv1 <*> Recv recv2 =+    Recv \cs -> do+      ef <- recv1 cs+      eg <- recv2 cs+      pure (ef <*> eg)++instance Bifunctor Recv where+  {-# INLINE bimap #-}+  bimap f g (Recv recv) = Recv (fmap (bimap (fmap f) g) . recv)++toHandler :: Recv context a -> Pq.Connection -> IO (Either (Error context) a)+toHandler (Recv recv) = recv++-- | Exactly one result.+singleResult :: context -> ResultDecoder.ResultDecoder a -> Recv context a+singleResult context handler = Recv \connection -> runExceptT do+  result <- ExceptT do+    result <- Pq.getResult connection+    case result of+      Nothing -> do+        errorMessage <- Pq.errorMessage connection+        pure (Left (NoResultsError context errorMessage))+      Just result -> pure (Right result)+  ExceptT do+    result <- Pq.getResult connection+    case result of+      Nothing -> pure (Right result)+      Just _ -> pure (Left (TooManyResultsError context 1))+  result <- ExceptT do+    result <- ResultDecoder.toHandler handler result+    pure (first (ResultError context 0) result)+  pure result++-- | Consume all results from a multi-statement query (e.g., scripts).+-- Each result is decoded using the provided handler.+-- This is useful for scripts that may contain multiple statements,+-- where each statement produces a result that needs to be validated.+-- All results are consumed even if an error occurs, to leave the connection+-- in a clean state.+allResults :: context -> ResultDecoder.ResultDecoder a -> Recv context ()+allResults context handler = Recv \connection -> do+  let loop resultIndex maybeError = do+        result <- Pq.getResult connection+        case result of+          Nothing -> pure maybeError+          Just result -> do+            decodedResult <- ResultDecoder.toHandler handler result+            case decodedResult of+              Left err ->+                -- Continue consuming results even after error to clean up connection+                loop (resultIndex + 1) (Just (ResultError context resultIndex err))+              Right _ ->+                loop (resultIndex + 1) maybeError+  errorOrUnit <- loop 0 Nothing+  pure (maybe (Right ()) Left errorOrUnit)++-- * Errors++data Error context+  = ResultError+      context+      -- | Offset of the result in the series.+      Int+      -- | Underlying error.+      ResultDecoder.Error+  | NoResultsError+      context+      -- | Details about the error. Possibly empty.+      (Maybe ByteString)+  | TooManyResultsError+      context+      -- | Expected count.+      Int+  deriving stock (Show, Eq, Functor)++instance Comonad Error where+  {-# INLINE extract #-}+  extract = \case+    ResultError context _ _ -> context+    NoResultsError context _ -> context+    TooManyResultsError context _ -> context++  {-# INLINE duplicate #-}+  duplicate e = case e of+    ResultError _ resultIndex resultError -> ResultError e resultIndex resultError+    NoResultsError _ details -> NoResultsError e details+    TooManyResultsError _ expectedCount -> TooManyResultsError e expectedCount
+ src/comms/Hasql/Comms/ResultDecoder.hs view
@@ -0,0 +1,343 @@+module Hasql.Comms.ResultDecoder+  ( ResultDecoder,++    -- * Relations+    Handler,+    toHandler,+    fromHandler,++    -- * Extractors+    columnOids,++    -- * Constructors++    -- ** Basic+    ok,+    pipelineSync,+    rowsAffected,+    checkExecStatus,++    -- ** Higher-level decoders+    maybe,+    single,+    vector,+    foldl,+    foldr,++    -- ** Refinement+    refine,++    -- * Errors+    Error (..),+  )+where++import Data.Attoparsec.ByteString.Char8 qualified as Attoparsec+import Data.ByteString qualified as ByteString+import Data.Vector qualified as Vector+import Data.Vector.Mutable qualified as MutableVector+import Hasql.Comms.RowDecoder qualified as RowDecoder+import Hasql.Platform.Prelude hiding (foldl, foldr, maybe)+import Hasql.Platform.Prelude qualified as Prelude+import Pqi qualified as Pq++-- | Result consumption context, for consuming a single result from a sequence of results returned by the server.+newtype ResultDecoder a+  = ResultDecoder (Pq.Result -> IO (Either Error a))+  deriving+    (Functor, Applicative, Monad, MonadError Error, MonadReader Pq.Result)+    via (ReaderT Pq.Result (ExceptT Error IO))++instance Filterable ResultDecoder where+  {-# INLINE mapMaybe #-}+  mapMaybe fn =+    refine (Prelude.maybe (Left "Invalid result") Right . fn)++-- * Relations++-- ** Handler++type Handler a = Pq.Result -> IO (Either Error a)++toHandler :: ResultDecoder a -> Handler a+toHandler (ResultDecoder handler) =+  handler++fromHandler :: Handler a -> ResultDecoder a+fromHandler handler =+  ResultDecoder handler++-- * Construction++{-# INLINE ok #-}+ok :: ResultDecoder ()+ok = checkExecStatus [Pq.CommandOk, Pq.TuplesOk]++{-# INLINE pipelineSync #-}+pipelineSync :: ResultDecoder ()+pipelineSync = checkExecStatus [Pq.PipelineSync]++{-# INLINE rowsAffected #-}+rowsAffected :: ResultDecoder Int64+rowsAffected = do+  checkExecStatus [Pq.CommandOk]+  ResultDecoder \result -> do+    cmdTuplesReader <$> Pq.cmdTuples result+  where+    cmdTuplesReader =+      notNothing >=> notEmpty >=> decimal+      where+        notNothing =+          Prelude.maybe (Left (UnexpectedResult "No bytes")) Right+        notEmpty bytes =+          if ByteString.null bytes+            then Left (UnexpectedResult "Empty bytes")+            else Right bytes+        decimal bytes =+          first+            ( \m ->+                UnexpectedResult+                  ("Decimal parsing failure: " <> fromString m)+            )+            ( Attoparsec.parseOnly+                (Attoparsec.decimal <* Attoparsec.endOfInput)+                bytes+            )++{-# INLINE checkExecStatus #-}+checkExecStatus :: [Pq.ExecStatus] -> ResultDecoder ()+checkExecStatus expectedList = do+  status <- ResultDecoder \result -> Right <$> Pq.resultStatus result+  unless (elem status expectedList) $ do+    case status of+      Pq.BadResponse -> serverError+      Pq.NonfatalError -> serverError+      Pq.FatalError -> serverError+      Pq.EmptyQuery -> return ()+      _ ->+        throwError+          ( UnexpectedResult+              ("Unexpected result status: " <> fromString (show status) <> ". Expecting one of the following: " <> fromString (show expectedList))+          )++{-# INLINE serverError #-}+serverError :: ResultDecoder ()+serverError =+  ResultDecoder \result -> do+    code <-+      fold <$> Pq.resultErrorField result Pq.DiagSqlstate+    message <-+      fold <$> Pq.resultErrorField result Pq.DiagMessagePrimary+    detail <-+      Pq.resultErrorField result Pq.DiagMessageDetail+    hint <-+      Pq.resultErrorField result Pq.DiagMessageHint+    position <-+      parsePosition <$> Pq.resultErrorField result Pq.DiagStatementPosition+    pure $ Left $ ServerError code message detail hint position+  where+    parsePosition = \case+      Nothing -> Nothing+      Just pos ->+        case Attoparsec.parseOnly (Attoparsec.decimal <* Attoparsec.endOfInput) pos of+          Right pos -> Just pos+          _ -> Nothing++-- | Get the OIDs of all columns in the current result.+{-# INLINE columnOids #-}+columnOids :: ResultDecoder [Word32]+columnOids = ResultDecoder \result -> do+  count <- Pq.nfields result+  oids <- forM [0 .. count - 1] $ \colIndex ->+    Pq.ftype result colIndex+  pure (Right oids)++-- * Higher-level decoders++{-# INLINE checkCompatibility #-}+checkCompatibility :: RowDecoder.RowDecoder a -> ResultDecoder ()+checkCompatibility rowDec =+  let oids = RowDecoder.toExpectedOids rowDec+   in ResultDecoder \result -> do+        maxCols <- Pq.nfields result+        if length oids == fromIntegral maxCols+          then+            let go [] _ = pure (Right ())+                go (Nothing : rest) colIndex = go rest (succ colIndex)+                go (Just expectedOid : rest) colIndex = do+                  actualOid <- Pq.ftype result (fromIntegral colIndex)+                  if actualOid == expectedOid+                    then go rest (succ colIndex)+                    else+                      pure+                        ( Left+                            ( DecoderTypeMismatch+                                colIndex+                                expectedOid+                                actualOid+                            )+                        )+             in go oids 0+          else pure (Left (UnexpectedColumnCount (length oids) (fromIntegral maxCols)))++{-# INLINE maybe #-}+maybe :: RowDecoder.RowDecoder a -> ResultDecoder (Maybe a)+maybe rowDec =+  do+    checkExecStatus [Pq.TuplesOk]+    checkCompatibility rowDec+    ResultDecoder+      $ \result -> do+        maxRows <- Pq.ntuples result+        case maxRows of+          0 -> return (Right Nothing)+          1 -> do+            result <-+              RowDecoder.toDecoder rowDec result 0+                <&> first (RowError 0)+            pure (fmap Just result)+          _ -> return (Left (UnexpectedRowCount (fromIntegral maxRows)))++{-# INLINE single #-}+single :: RowDecoder.RowDecoder a -> ResultDecoder a+single rowDec =+  do+    checkExecStatus [Pq.TuplesOk]+    checkCompatibility rowDec+    ResultDecoder+      $ \result -> do+        maxRows <- Pq.ntuples result+        case maxRows of+          1 -> do+            RowDecoder.toDecoder rowDec result 0+              <&> first (RowError 0)+          _ -> return (Left (UnexpectedRowCount (fromIntegral maxRows)))++{-# INLINE vector #-}+vector :: RowDecoder.RowDecoder a -> ResultDecoder (Vector a)+vector rowDec =+  do+    checkExecStatus [Pq.TuplesOk]+    checkCompatibility rowDec+    ResultDecoder+      $ \result -> do+        maxRows <- Pq.ntuples result+        mvector <- MutableVector.unsafeNew (fromIntegral maxRows)+        failureRef <- newIORef Nothing+        forMFromZero_ (fromIntegral maxRows) $ \rowIndex -> do+          rowResult <- RowDecoder.toDecoder rowDec result (fromIntegral rowIndex)+          case rowResult of+            Left !err -> writeIORef failureRef (Just (RowError rowIndex err))+            Right !x -> MutableVector.unsafeWrite mvector rowIndex x+        readIORef failureRef >>= \case+          Nothing -> Right <$> Vector.unsafeFreeze mvector+          Just x -> pure (Left x)++{-# INLINE foldl #-}+foldl :: (a -> b -> a) -> a -> RowDecoder.RowDecoder b -> ResultDecoder a+foldl step init rowDec =+  {-# SCC "foldl" #-}+  do+    checkExecStatus [Pq.TuplesOk]+    checkCompatibility rowDec+    ResultDecoder+      $ \result ->+        {-# SCC "traversal" #-}+        do+          maxRows <- Pq.ntuples result+          accRef <- newIORef init+          failureRef <- newIORef Nothing+          forMFromZero_ (fromIntegral maxRows) $ \rowIndex -> do+            rowResult <- RowDecoder.toDecoder rowDec result (fromIntegral rowIndex)+            case rowResult of+              Left !err -> writeIORef failureRef (Just (RowError rowIndex err))+              Right !x -> modifyIORef' accRef (\acc -> step acc x)+          readIORef failureRef >>= \case+            Nothing -> Right <$> readIORef accRef+            Just x -> pure (Left x)++{-# INLINE foldr #-}+foldr :: (b -> a -> a) -> a -> RowDecoder.RowDecoder b -> ResultDecoder a+foldr step init rowDec =+  {-# SCC "foldr" #-}+  do+    checkExecStatus [Pq.TuplesOk]+    checkCompatibility rowDec+    ResultDecoder+      $ \result -> do+        maxRows <- Pq.ntuples result+        accRef <- newIORef init+        failureRef <- newIORef Nothing+        forMToZero_ (fromIntegral maxRows) $ \rowIndex -> do+          rowResult <- RowDecoder.toDecoder rowDec result (fromIntegral rowIndex)+          case rowResult of+            Left !err -> writeIORef failureRef (Just (RowError rowIndex err))+            Right !x -> modifyIORef accRef (\acc -> step x acc)+        readIORef failureRef >>= \case+          Nothing -> Right <$> readIORef accRef+          Just x -> pure (Left x)++-- * Refinement++refine :: (a -> Either Text b) -> ResultDecoder a -> ResultDecoder b+refine refiner (ResultDecoder reader) = ResultDecoder+  $ \result -> do+    resultEither <- reader result+    return $ resultEither >>= first UnexpectedResult . refiner++-- * Errors++-- |+-- An error with a command result.+data Error+  = -- | An error reported by the DB.+    ServerError+      -- | __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.+      ByteString+      -- | __Message__. The primary human-readable error message(typically one+      -- line). Always present.+      ByteString+      -- | __Details__. An optional secondary error message carrying more+      -- detail about the problem. Might run to multiple lines.+      (Maybe ByteString)+      -- | __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.+      (Maybe ByteString)+      -- | __Position__. Error cursor position as an index into the original+      -- statement string. Positions are measured in characters not bytes.+      (Maybe Int)+  | -- |+    -- The database returned an unexpected result.+    -- Indicates an improper statement or a schema mismatch.+    UnexpectedResult Text+  | -- |+    -- An unexpected amount of rows.+    UnexpectedRowCount Int+  | -- |+    -- An unexpected amount of columns in the result.+    UnexpectedColumnCount+      -- | Expected amount of columns.+      Int+      -- | Actual amount of columns.+      Int+  | -- |+    -- Appears when the decoder's expected type doesn't match the actual column type.+    -- Reports the expected OID and the actual OID from the result.+    DecoderTypeMismatch+      -- | Column index.+      Int+      -- | Expected OID.+      Word32+      -- | Actual OID.+      Word32+  | -- | An error in a specific row, reported by a row decoder.+    RowError+      -- | Row index.+      Int+      -- | Underlying error.+      RowDecoder.Error+  deriving (Show, Eq)
+ src/comms/Hasql/Comms/Roundtrip.hs view
@@ -0,0 +1,140 @@+module Hasql.Comms.Roundtrip+  ( Roundtrip,+    toPipelineIO,+    toSerialIO,++    -- * Constructors+    prepare,+    queryPrepared,+    queryParams,+    query,+    script,++    -- * Errors+    Error (..),+  )+where++import Hasql.Comms.Recv qualified as Recv+import Hasql.Comms.ResultDecoder qualified as ResultDecoder+import Hasql.Comms.Send qualified as Send+import Hasql.Platform.Prelude+import Pqi qualified as Pq++data Roundtrip context a+  = Roundtrip (Send.Send context) (Recv.Recv context a)+  deriving stock (Functor)++instance Applicative (Roundtrip context) where+  {-# INLINE pure #-}+  pure x = Roundtrip mempty (pure x)+  {-# INLINE (<*>) #-}+  Roundtrip send1 recv1 <*> Roundtrip send2 recv2 =+    Roundtrip (send1 <> send2) (recv1 <*> recv2)++instance Bifunctor Roundtrip where+  {-# INLINE bimap #-}+  bimap f g (Roundtrip send recv) =+    Roundtrip+      (fmap f send)+      (bimap f g recv)++toPipelineIO :: Roundtrip context a -> context -> Pq.Connection -> IO (Either (Error context) a)+toPipelineIO sendAndRecv context connection = mask \restore -> do+  sendResult <- Send.toHandler (Send.enterPipelineMode context <> send) connection+  case sendResult of+    Send.Error context details -> pure (Left (ClientError context details))+    Send.Ok -> do+      recvResult <- first ServerError <$> restore (Recv.toHandler recv connection)+      exitResult <- do+        result <- Send.toHandler (Send.exitPipelineMode context) connection+        case result of+          Send.Error context details -> pure (Left (ClientError context details))+          Send.Ok -> pure (Right ())+      pure (recvResult <* exitResult)+  where+    Roundtrip send recv = sendAndRecv <* pipelineSync context++toSerialIO :: Roundtrip context a -> Pq.Connection -> IO (Either (Error context) a)+toSerialIO (Roundtrip send recv) connection = do+  sendResult <- Send.toHandler send connection+  case sendResult of+    Send.Error context details -> pure (Left (ClientError context details))+    Send.Ok -> do+      recvResult <- Recv.toHandler recv connection+      pure (first ServerError recvResult)++pipelineSync :: context -> Roundtrip context ()+pipelineSync context =+  Roundtrip+    (Send.pipelineSync context)+    (Recv.singleResult context ResultDecoder.pipelineSync)++prepare :: context -> ByteString -> ByteString -> [Word32] -> Roundtrip context ()+prepare context statementName sql oidList =+  Roundtrip+    (Send.prepare context statementName sql (Just oidList))+    (Recv.singleResult context ResultDecoder.ok)++queryPrepared ::+  context ->+  -- | Prepared statement name.+  ByteString ->+  -- | Parameters.+  [Maybe (ByteString, Pq.Format)] ->+  -- | Result format.+  Pq.Format ->+  -- | Result decoder.+  ResultDecoder.ResultDecoder a ->+  Roundtrip context a+queryPrepared context statementName params resultFormat resultDecoder =+  Roundtrip+    (Send.queryPrepared context statementName params resultFormat)+    (Recv.singleResult context resultDecoder)++queryParams ::+  context ->+  -- | SQL.+  ByteString ->+  -- | Parameters.+  [Maybe (Word32, ByteString, Pq.Format)] ->+  -- | Result format.+  Pq.Format ->+  -- | Result decoder.+  ResultDecoder.ResultDecoder a ->+  Roundtrip context a+queryParams context sql params resultFormat resultDecoder =+  Roundtrip+    (Send.queryParams context sql params resultFormat)+    (Recv.singleResult context resultDecoder)++query :: context -> ByteString -> Roundtrip context ()+query context sql =+  Roundtrip+    (Send.query context sql)+    (Recv.singleResult context ResultDecoder.ok)++-- | Execute a script (multi-statement SQL).+-- Unlike 'query', this consumes all results from the execution,+-- which is necessary for scripts containing multiple statements.+script :: context -> ByteString -> Roundtrip context ()+script context sql =+  Roundtrip+    (Send.query context sql)+    (Recv.allResults context ResultDecoder.ok)++data Error context+  = ClientError context (Maybe ByteString)+  | ServerError (Recv.Error context)+  deriving stock (Show, Eq, Functor)++instance Comonad Error where+  {-# INLINE extract #-}+  extract = \case+    ClientError context _ -> context+    ServerError recvError -> extract recvError++  {-# INLINE duplicate #-}+  duplicate = \case+    clientError@(ClientError _ details) -> ClientError clientError details+    ServerError recvError -> ServerError (fmap ServerError (duplicate recvError))
+ src/comms/Hasql/Comms/RowDecoder.hs view
@@ -0,0 +1,79 @@+module Hasql.Comms.RowDecoder+  ( RowDecoder,+    nullableColumn,+    nonNullableColumn,++    -- * Relations++    -- ** Expected OIDs+    toExpectedOids,++    -- ** Decoder+    Decoder,+    toDecoder,++    -- * Errors+    Error,+  )+where++import Hasql.Comms.RowReader qualified as RowReader+import Hasql.Platform.Prelude+import Pqi qualified as Pq++-- * RowDecoder++data RowDecoder a+  = RowDecoder+      [Maybe Word32]+      (RowReader.RowReader a)+  deriving stock (Functor)++instance Applicative RowDecoder where+  pure a = RowDecoder [] (pure a)+  RowDecoder lOids lDec <*> RowDecoder rOids rDec =+    RowDecoder (lOids <> rOids) (lDec <*> rDec)++instance Filterable RowDecoder where+  mapMaybe fn (RowDecoder oids dec) =+    RowDecoder oids (mapMaybe fn dec)++-- * Functions++-- |+-- Next value, decoded using the provided value decoder.+{-# INLINE nullableColumn #-}+nullableColumn :: Maybe Word32 -> (ByteString -> Either Text a) -> RowDecoder (Maybe a)+nullableColumn oid decoder =+  RowDecoder+    [oid]+    (RowReader.nullableColumn decoder)++-- |+-- Next value, decoded using the provided value decoder.+{-# INLINE nonNullableColumn #-}+nonNullableColumn :: Maybe Word32 -> (ByteString -> Either Text a) -> RowDecoder a+nonNullableColumn oid decoder =+  RowDecoder+    [oid]+    (RowReader.nonNullableColumn decoder)++-- * Relations++-- ** Expected OIDs++toExpectedOids :: RowDecoder a -> [Maybe Word32]+toExpectedOids (RowDecoder oids _) = oids++-- ** Decoder++type Decoder a = Pq.Result -> Int32 -> IO (Either Error a)++{-# INLINE toDecoder #-}+toDecoder :: RowDecoder a -> Decoder a+toDecoder (RowDecoder _ dec) result row =+  RowReader.toHandler dec result row++-- * Errors++type Error = RowReader.Error
+ src/comms/Hasql/Comms/RowReader.hs view
@@ -0,0 +1,102 @@+-- | Lower level context focused on just the actual decoding of values. No metadata involved.+module Hasql.Comms.RowReader+  ( RowReader,+    nullableColumn,+    nonNullableColumn,++    -- * Errors+    Error (..),+    CellError (..),++    -- * Relations+    toHandler,+  )+where++import Hasql.Platform.Prelude+import Pqi qualified as Pq++data Error+  = CellError+      -- | Column index, 0-based.+      Int+      -- | OID of the column type as reported by Postgres.+      Word32+      -- | Underlying error.+      CellError+  | RefinementError Text+  deriving stock (Eq, Show)++data CellError+  = DecodingCellError Text+  | UnexpectedNullCellError+  deriving stock (Eq, Show)++newtype RowReader a+  = RowReader (StateT Int32 (ReaderT Env (ExceptT Error IO)) a)+  deriving+    (Functor, Applicative)+    via (StateT Int32 (ReaderT Env (ExceptT Error IO)))++data Env+  = Env+      Pq.Result+      Int32++-- * Instances++instance Filterable RowReader where+  {-# INLINE mapMaybe #-}+  mapMaybe fn (RowReader run) =+    RowReader do+      result <- run+      case fn result of+        Just refined -> pure refined+        Nothing -> throwError (RefinementError "Filtration failed")++-- * Functions++{-# INLINE toHandler #-}+toHandler :: RowReader a -> Pq.Result -> Int32 -> IO (Either Error a)+toHandler (RowReader f) result row =+  let env = Env result row+   in runExceptT (runReaderT (evalStateT f 0) env)++-- |+-- Next value, decoded using the provided value decoder.+{-# INLINE column #-}+column :: (Maybe a -> Maybe b) -> (ByteString -> Either Text a) -> RowReader b+column processNullable valueDec = RowReader do+  col <- get+  Env result row <- ask+  let colInt = fromIntegral col+  put (succ col)++  valueMaybe <- liftIO ({-# SCC "getvalue'" #-} Pq.getvalue' result row col)++  valueMaybe <- case valueMaybe of+    Nothing -> pure Nothing+    Just v ->+      case {-# SCC "decode" #-} valueDec v of+        Left err -> do+          oid <- liftIO (Pq.ftype result col)+          throwError (CellError colInt oid (DecodingCellError err))+        Right decoded -> pure (Just decoded)++  case processNullable valueMaybe of+    Nothing -> do+      oid <- liftIO (Pq.ftype result col)+      throwError (CellError colInt oid UnexpectedNullCellError)+    Just decoded -> pure decoded++-- |+-- Next value, decoded using the provided value decoder.+{-# INLINE nullableColumn #-}+nullableColumn :: (ByteString -> Either Text a) -> RowReader (Maybe a)+nullableColumn = column Just++-- |+-- Next value, decoded using the provided value decoder.+{-# INLINE nonNullableColumn #-}+nonNullableColumn :: (ByteString -> Either Text a) -> RowReader a+nonNullableColumn = column id
+ src/comms/Hasql/Comms/Send.hs view
@@ -0,0 +1,67 @@+module Hasql.Comms.Send where++import Hasql.Platform.Prelude+import Pqi qualified as Pq++data Result context+  = Ok+  | Error context (Maybe ByteString)+  deriving stock (Eq, Show, Functor)++newtype Send context+  = Send (Pq.Connection -> IO (Result context))+  deriving stock (Functor)++instance Semigroup (Send context) where+  {-# INLINE (<>) #-}+  Send send1 <> Send send2 = Send \cs -> do+    result <- send1 cs+    case result of+      Error context details -> pure (Error context details)+      Ok -> do+        result2 <- send2 cs+        pure result2++instance Monoid (Send context) where+  {-# INLINE mempty #-}+  mempty = Send \_ -> pure Ok++toHandler :: Send context -> Pq.Connection -> IO (Result context)+toHandler (Send send) = send++liftPqSend :: context -> (Pq.Connection -> IO Bool) -> Send context+liftPqSend context pqSend = Send \connection -> do+  success <- pqSend connection+  if success+    then pure Ok+    else do+      errorMessage <- Pq.errorMessage connection+      pure (Error context errorMessage)++prepare :: context -> ByteString -> ByteString -> Maybe [Word32] -> Send context+prepare context statementName sql oidList =+  liftPqSend context \connection -> Pq.sendPrepare connection statementName sql oidList++query :: context -> ByteString -> Send context+query context sql =+  liftPqSend context \connection -> Pq.sendQuery connection sql++queryPrepared :: context -> ByteString -> [Maybe (ByteString, Pq.Format)] -> Pq.Format -> Send context+queryPrepared context statementName params resultFormat =+  liftPqSend context \connection -> Pq.sendQueryPrepared connection statementName params resultFormat++queryParams :: context -> ByteString -> [Maybe (Word32, ByteString, Pq.Format)] -> Pq.Format -> Send context+queryParams context sql params resultFormat =+  liftPqSend context \connection -> Pq.sendQueryParams connection sql params resultFormat++pipelineSync :: context -> Send context+pipelineSync context =+  liftPqSend context \connection -> Pq.pipelineSync connection++enterPipelineMode :: context -> Send context+enterPipelineMode context =+  liftPqSend context \connection -> Pq.enterPipelineMode connection++exitPipelineMode :: context -> Send context+exitPipelineMode context =+  liftPqSend context \connection -> Pq.exitPipelineMode connection
+ src/comms/Hasql/Comms/Session.hs view
@@ -0,0 +1,176 @@+module Hasql.Comms.Session+  ( Session,++    -- * Constructors+    cleanUpAfterInterruption,++    -- * Executors+    toHandler,+  )+where++import Hasql.Comms.Roundtrip qualified as Roundtrip+import Hasql.Platform.Prelude+import Pqi qualified as Pq++-- | Serial execution of commands in the scope of a connection.+newtype Session a = Session (Pq.Connection -> IO (Either Error a))+  deriving+    (Functor, Applicative, Monad, MonadError Error)+    via (ExceptT Error (ReaderT Pq.Connection IO))++type Error = Text++-- * Constructors++-- | Bring the connection to a clean state after an interruption.+--+-- This includes:+-- - Leaving pipeline mode if we are in it.+-- - Bringing the transaction status to idle if we are in a transaction.+-- - Deallocating all prepared statements.+cleanUpAfterInterruption :: Session ()+cleanUpAfterInterruption = do+  drainResults+  cancel+  drainResults+  -- Ensure we are out of pipeline mode.+  leavePipeline+  -- Ensure we are in idle transaction state.+  bringTransactionStatusToIdle+  deallocateAllPreparedStatements++bringTransactionStatusToIdle :: Session ()+bringTransactionStatusToIdle = do+  transactionStatus <- getTransactionStatus+  case transactionStatus of+    Pq.TransIdle -> pure ()+    Pq.TransInTrans -> do+      runScript "ABORT"+    Pq.TransActive -> do+      -- A command is still in progress.+      drainResults+      -- Check status again after draining.+      transactionStatus <- getTransactionStatus+      case transactionStatus of+        Pq.TransIdle -> pure ()+        Pq.TransInTrans -> do+          runScript "ABORT"+        Pq.TransActive -> do+          -- If we're still active, there's not much we can do.+          -- The connection is probably in a bad state.+          throwError "Failed to bring transaction status to idle after draining results"+        Pq.TransInError -> do+          runScript "ABORT"+        Pq.TransUnknown -> do+          -- Unknown state (connection issue), there's not much we can do.+          throwError "Transaction status is unknown, connection is corrupted"+    Pq.TransInError -> do+      -- Transaction is in error state, we need to abort it.+      runScript "ABORT"+    Pq.TransUnknown -> do+      -- Unknown state (connection issue), there's not much we can do.+      throwError "Transaction status is unknown, connection is corrupted"++leavePipeline :: Session ()+leavePipeline = do+  pipelineStatus <- getPipelineStatus+  -- PipelineAborted is still pipeline mode. It must reach a sync point before+  -- libpq permits serial queries such as ABORT or DEALLOCATE ALL again.+  when (pipelineStatus /= Pq.PipelineOff) do+    -- In pipeline mode, we need to ensure the pipeline is synchronized before exiting.+    -- Send a pipeline sync marker to flush any pending operations.+    syncSuccess <- sendPipelineSync+    when syncSuccess drainResults+    -- After sync, send a flush to ensure all queued commands are sent to the server.+    flushSuccess <- sendFlushRequest+    when flushSuccess drainResults+    -- Try to exit pipeline mode.+    -- This might fail if there are pending results that need to be consumed.+    success <- exitPipelineMode+    unless success do+      -- If exit failed, drain results and try again.+      drainResults+      success <- exitPipelineMode+      unless success do+        -- If it still fails, there's not much we can do.+        -- The connection is probably in a bad state.+        errorMessage <- getErrorMessage+        let message = case errorMessage of+              Nothing -> "Failed to exit pipeline mode after draining results"+              Just details -> "Failed to exit pipeline mode after draining results: " <> decodeUtf8Lenient details+        throwError message++deallocateAllPreparedStatements :: Session ()+deallocateAllPreparedStatements =+  runScript "DEALLOCATE ALL"++cancel :: Session ()+cancel = Session \connection -> do+  mCancel <- Pq.getCancel connection+  case mCancel of+    Just cancel -> do+      result <- Pq.cancel cancel+      case result of+        Left errorMessage ->+          pure (Left ("Failed to cancel: " <> decodeUtf8Lenient errorMessage))+        Right () ->+          pure (Right ())+    Nothing -> pure (Right ())++getErrorMessage :: Session (Maybe ByteString)+getErrorMessage = Session \connection -> do+  Right <$> Pq.errorMessage connection++getTransactionStatus :: Session Pq.TransactionStatus+getTransactionStatus = Session \connection -> do+  Right <$> Pq.transactionStatus connection++getPipelineStatus :: Session Pq.PipelineStatus+getPipelineStatus = Session \connection -> do+  Right <$> Pq.pipelineStatus connection++exitPipelineMode :: Session Bool+exitPipelineMode = Session \connection -> do+  Right <$> Pq.exitPipelineMode connection++sendPipelineSync :: Session Bool+sendPipelineSync = Session \connection -> do+  Right <$> Pq.pipelineSync connection++sendFlushRequest :: Session Bool+sendFlushRequest = Session \connection -> do+  Right <$> Pq.sendFlushRequest connection++-- Drain all pending results from the connection.+drainResults :: Session ()+drainResults = Session \connection ->+  let go = do+        mResult <- Pq.getResult connection+        case mResult of+          Nothing -> pure ()+          Just _ -> go+   in go $> Right ()++runScript :: ByteString -> Session ()+runScript script = runRoundtrip (Roundtrip.query () script)++runRoundtrip :: Roundtrip.Roundtrip () a -> Session a+runRoundtrip roundtrip = Session \connection -> do+  result <- Roundtrip.toSerialIO roundtrip connection+  case result of+    Left err ->+      let message = case err of+            Roundtrip.ClientError () Nothing ->+              "Unknown client error occurred"+            Roundtrip.ClientError () (Just details) ->+              "Client error occurred: " <> decodeUtf8Lenient details+            Roundtrip.ServerError recvError ->+              "Server error occurred: " <> fromString (show recvError)+       in pure (Left message)+    Right value -> pure (Right value)++-- * Executors++toHandler :: Session a -> Pq.Connection -> IO (Either Text a)+toHandler (Session run) = run
src/engine-tests/Hasql/Engine/Structures/OidCacheSpec.hs view
@@ -3,8 +3,8 @@ import Data.HashSet qualified as HashSet import Hasql.Codecs.Vocab.OidCache qualified as OidCache import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName-import Test.Hspec import Prelude+import Test.Hspec  spec :: Spec spec = do
src/engine-tests/Hasql/Engine/Structures/StatementCacheSpec.hs view
@@ -1,7 +1,6 @@ module Hasql.Engine.Structures.StatementCacheSpec (spec) where  import Data.Maybe-import Database.PostgreSQL.LibPQ (Oid (..)) import Hasql.Engine.Structures.StatementCache qualified as StatementCache import Test.Hspec @@ -24,15 +23,15 @@       key1 `shouldNotBe` key2      it "generates unique remote keys for same SQL with different OIDs" do-      let oid23 = Oid 23-          oid25 = Oid 25+      let oid23 = 23+          oid25 = 25           (key1, cache1) = StatementCache.insert "SELECT $1" [oid23] StatementCache.empty           (key2, _cache2) = StatementCache.insert "SELECT $1" [oid25] cache1       key1 `shouldNotBe` key2      it "distinguishes statements with same SQL but different OIDs" do-      let oid23 = Oid 23-          oid25 = Oid 25+      let oid23 = 23+          oid25 = 25           (_key1, cache1) = StatementCache.insert "SELECT $1" [oid23] StatementCache.empty           (_key2, cache2) = StatementCache.insert "SELECT $1" [oid25] cache1       -- Both should be findable@@ -51,8 +50,8 @@         `shouldBe` Nothing      it "returns Nothing for matching SQL but different OIDs" do-      let oid23 = Oid 23-          oid25 = Oid 25+      let oid23 = 23+          oid25 = 25           (_key, cache) = StatementCache.insert "SELECT $1" [oid23] StatementCache.empty       StatementCache.lookup "SELECT $1" [oid25] cache         `shouldBe` Nothing@@ -63,14 +62,14 @@         `shouldBe` Just key      it "handles multiple OIDs" do-      let oids = [Oid 23, Oid 25, Oid 1043]+      let oids = [23, 25, 1043]           (key, cache) = StatementCache.insert "SELECT $1, $2, $3" oids StatementCache.empty       StatementCache.lookup "SELECT $1, $2, $3" oids cache         `shouldBe` Just key      it "distinguishes different OID ordering" do-      let oidsA = [Oid 23, Oid 25]-          oidsB = [Oid 25, Oid 23]+      let oidsA = [23, 25]+          oidsB = [25, 23]           (_keyA, cache1) = StatementCache.insert "SELECT $1, $2" oidsA StatementCache.empty           (_keyB, cache2) = StatementCache.insert "SELECT $1, $2" oidsB cache1       StatementCache.lookup "SELECT $1, $2" oidsA cache2
+ src/engine/Hasql/Engine/Contexts/Pipeline.hs view
@@ -0,0 +1,265 @@+module Hasql.Engine.Contexts.Pipeline+  ( Pipeline,+    run,+    statement,+  )+where++import Data.HashMap.Strict qualified as HashMap+import Data.HashSet qualified as HashSet+import Hasql.Codecs.RequestingOid qualified as RequestingOid+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.OidCache qualified as OidCache+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Comms.Roundtrip qualified as Comms.Roundtrip+import Hasql.Engine.Errors qualified as Errors+import Hasql.Engine.PqProcedures.SelectTypeInfo qualified as PqProcedures.SelectTypeInfo+import Hasql.Engine.Statement qualified as Statement+import Hasql.Engine.Structures.StatementCache qualified as StatementCache+import Hasql.Platform.Prelude+import Pqi qualified as Pq++run ::+  Pipeline a ->+  Bool ->+  Pq.Connection ->+  OidCache.OidCache ->+  StatementCache.StatementCache ->+  IO+    ( Either Errors.SessionError a,+      OidCache.OidCache,+      StatementCache.StatementCache+    )+run (Pipeline totalStatements unknownTypes runPipeline) usePreparedStatements connection oidCache statementCache = do+  let missingTypes = OidCache.selectUnknownNames unknownTypes oidCache+  resolvedOidCache <-+    if HashSet.null missingTypes+      then pure (Right oidCache)+      else do+        oidCacheUpdates <-+          PqProcedures.SelectTypeInfo.run connection (PqProcedures.SelectTypeInfo.SelectTypeInfo missingTypes)+        pure $ case oidCacheUpdates of+          Left err -> Left err+          Right oidCacheUpdates ->+            let foundTypes = HashMap.keysSet oidCacheUpdates+                notFoundTypes = HashSet.difference missingTypes foundTypes+             in if not (HashSet.null notFoundTypes)+                  then Left (Errors.MissingTypesSessionError (HashSet.map Vocab.QualifiedTypeName.toNameTuple notFoundTypes))+                  else Right (oidCache <> OidCache.fromHashMap oidCacheUpdates)+  case resolvedOidCache of+    Left err -> pure (Left err, oidCache, statementCache)+    Right newOidCache -> do+      let (roundtrip, newStatementCache) =+            runPipeline 0 usePreparedStatements newOidCache statementCache+          contextualRoundtrip = first Just roundtrip++      executionResult <- Comms.Roundtrip.toPipelineIO contextualRoundtrip Nothing connection++      let result =+            first+              ( \case+                  Comms.Roundtrip.ClientError _context details ->+                    Errors.ConnectionSessionError (maybe "" decodeUtf8Lenient details)+                  Comms.Roundtrip.ServerError recvError ->+                    Errors.fromRecvError (fmap (fmap (\(Context index sql params prepared _) -> (totalStatements, index, sql, params, prepared))) recvError)+              )+              executionResult+          finalStatementCache =+            case executionResult of+              Right _ -> newStatementCache+              Left executionError ->+                maybe+                  statementCache+                  (\(Context _ _ _ _ statementCache) -> statementCache)+                  (extract executionError)++      pure (result, newOidCache, finalStatementCache)++-- |+-- Composable abstraction over the execution of queries in [the pipeline mode](https://www.postgresql.org/docs/current/libpq-pipeline-mode.html).+--+-- It allows you to issue multiple queries to the server in much fewer network transactions.+-- If the amounts of sent and received data do not surpass the buffer sizes in the driver and on the server it will be just a single roundtrip.+-- Typically the buffer size is 8KB.+--+-- This execution mode is much more efficient than running queries directly from 'Hasql.Session.Session', because in session every statement execution involves a dedicated network roundtrip.+--+-- An obvious question rises then: why not execute all queries like that?+-- In situations where the parameters depend on the result of another query it is impossible to execute them in parallel, because the client needs to receive the results of one query before sending the request to execute the next.+-- This reasoning is essentially the same as the one for the difference between 'Applicative' and 'Monad'.+-- That's why 'Pipeline' does not have the 'Monad' instance.+--+-- To execute 'Pipeline' lift it into 'Hasql.Session.Session' via 'Hasql.Session.pipeline'.+--+-- == Examples+--+-- === Insert-Many or Batch-Insert+--+-- You can use pipeline to turn a single-row insert query into an efficient multi-row insertion session.+-- In effect this should be comparable in performance to issuing a single multi-row insert statement.+--+-- Given the following definition in a Statements module:+--+-- @+-- insertOrder :: 'Hasql.Statement.Statement' OrderDetails OrderId+-- @+--+-- You can lift it into the following session+--+-- @+-- insertOrders :: [OrderDetails] -> 'Hasql.Session.Session' [OrderId]+-- insertOrders orders =+--   'Hasql.Session.pipeline' $+--     for orders $ \order ->+--       'Hasql.Pipeline.statement' order Statements.insertOrder+-- @+--+-- === Combining Queries+--+-- Given the following definitions in a Statements module:+--+-- @+-- selectOrderDetails :: 'Hasql.Statement.Statement' OrderId (Maybe OrderDetails)+-- selectOrderProducts :: 'Hasql.Statement.Statement' OrderId [OrderProduct]+-- selectOrderFinancialTransactions :: 'Hasql.Statement.Statement' OrderId [FinancialTransaction]+-- @+--+-- You can combine them into a session using the `ApplicativeDo` extension as follows:+--+-- @+-- selectEverythingAboutOrder :: OrderId -> 'Hasql.Session.Session' (Maybe OrderDetails, [OrderProduct], [FinancialTransaction])+-- selectEverythingAboutOrder orderId =+--   'Hasql.Session.pipeline' $ do+--     details <- 'Hasql.Pipeline.statement' orderId Statements.selectOrderDetails+--     products <- 'Hasql.Pipeline.statement' orderId Statements.selectOrderProducts+--     transactions <- 'Hasql.Pipeline.statement' orderId Statements.selectOrderFinancialTransactions+--     pure (details, products, transactions)+-- @+data Pipeline a+  = Pipeline+      -- | Amount of statements in this pipeline.+      Int+      -- | Names of types that are used in this pipeline.+      --+      -- They will be used to pre-resolve type OIDs before running the pipeline providing them in OidCache.+      -- It can be assumed in the execution function that these types are always present in the cache.+      -- To achieve that property we will be validating the presence of all requested types in the database or failing before running the pipeline.+      -- In the execution function we will be defaulting to OID 0 for unknown types as a fallback in case of bugs.+      (HashSet Vocab.QualifiedTypeName)+      -- | Function that runs the pipeline.+      --+      -- The integer parameter indicates the current offset of the statement in the pipeline (0-based).+      --+      -- The boolean parameter indicates whether preparable statements should be prepared.+      --+      -- OidCache is provided in which the names of types used in this pipeline are already resolved.+      --+      -- The function takes the current statement cache and returns a tuple of:+      -- 1. The actual roundtrip action to be executed in the pipeline.+      -- 2. The updated statement cache after composing this part of the pipeline.+      --+      -- The resulting cache is optimistic: on failure we recover the last known+      -- committed cache from statement contexts carried by roundtrip errors.+      ( Int ->+        Bool ->+        OidCache.OidCache ->+        StatementCache.StatementCache ->+        (Comms.Roundtrip.Roundtrip Context a, StatementCache.StatementCache)+      )++data Context+  = Context+      -- | Offset of the statement in the pipeline (0-based).+      Int+      -- | SQL.+      ByteString+      -- | Parameters in a human-readable form.+      [Text]+      -- | Whether the statement is prepared.+      Bool+      -- | The so far successfully updated statement cache.+      StatementCache.StatementCache+  deriving stock (Show, Eq)++-- * Instances++instance Functor Pipeline where+  fmap f (Pipeline count unknownTypes run) = Pipeline count unknownTypes \offset usePreparedStatements oidCache cache ->+    let (roundtrip, newStatementCache) = run offset usePreparedStatements oidCache cache+     in (fmap f roundtrip, newStatementCache)++instance Applicative Pipeline where+  pure a =+    Pipeline 0 mempty (\_ _ _ cache -> (pure a, cache))++  Pipeline lCount leftUnknownTypes lRun <*> Pipeline rCount rightUnknownTypes rRun =+    let unknownTypes = leftUnknownTypes <> rightUnknownTypes+     in Pipeline (lCount + rCount) unknownTypes \offset usePreparedStatements oidCache statementCache ->+          let (lRoundtrip, statementCache1) = lRun offset usePreparedStatements oidCache statementCache+              offset1 = offset + lCount+              (rRoundtrip, statementCache2) = rRun offset1 usePreparedStatements oidCache statementCache1+           in (lRoundtrip <*> rRoundtrip, statementCache2)++-- * Construction++-- |+-- Execute a statement in pipelining mode.+statement ::+  Statement.Statement params result ->+  params ->+  Pipeline result+statement stmt params =+  Pipeline 1 (Statement.unknownTypes stmt) run+  where+    sql = Statement.sql stmt+    run offset usePreparedStatements oidCache =+      if prepare+        then runPrepared+        else runUnprepared+      where+        (oidList, valueAndFormatList) =+          Statement.compilePreparedStatementData stmt oidCache params++        prepare =+          usePreparedStatements && Statement.isPrepared stmt++        context soFarStatementCache =+          Context+            offset+            sql+            (Statement.printer stmt params)+            prepare+            soFarStatementCache++        runPrepared statementCache =+          (roundtrip, newStatementCache)+          where+            (isNew, remoteKey, newStatementCache) =+              case StatementCache.lookup sql oidList statementCache of+                Just remoteKey -> (False, remoteKey, statementCache)+                Nothing ->+                  let (remoteKey, newStatementCache) = StatementCache.insert sql oidList statementCache+                   in (True, remoteKey, newStatementCache)++            roundtrip =+              when+                isNew+                (Comms.Roundtrip.prepare (context statementCache) remoteKey sql oidList)+                *> Comms.Roundtrip.queryPrepared (context newStatementCache) remoteKey encodedParams Pq.Binary decoder'+              where+                encodedParams =+                  valueAndFormatList+                    & fmap (fmap (\(bytes, format) -> (bytes, bool Pq.Binary Pq.Text format)))++        runUnprepared statementCache =+          (roundtrip, statementCache)+          where+            roundtrip =+              Comms.Roundtrip.queryParams (context statementCache) sql encodedParams Pq.Binary decoder'+              where+                encodedParams =+                  Statement.compileUnpreparedStatementData stmt oidCache params+                    & fmap (fmap (\(oid, bytes, format) -> (oid, bytes, bool Pq.Binary Pq.Text format)))++        decoder' =+          RequestingOid.toBase (Statement.decoder stmt) oidCache
+ src/engine/Hasql/Engine/Contexts/Session.hs view
@@ -0,0 +1,207 @@+module Hasql.Engine.Contexts.Session where++import Data.HashMap.Strict qualified as HashMap+import Data.HashSet qualified as HashSet+import Hasql.Codecs.RequestingOid qualified as RequestingOid+import Hasql.Codecs.Vocab.OidCache qualified as OidCache+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Comms.Roundtrip qualified as Comms.Roundtrip+import Hasql.Engine.Contexts.Pipeline qualified as Pipeline+import Hasql.Engine.Errors qualified as Errors+import Hasql.Engine.PqProcedures.SelectTypeInfo qualified as PqProcedures.SelectTypeInfo+import Hasql.Engine.Statement qualified as Statement+import Hasql.Engine.Structures.ConnectionState qualified as ConnectionState+import Hasql.Engine.Structures.StatementCache qualified as StatementCache+import Hasql.Platform.Prelude+import Pqi qualified as Pq++-- |+-- A sequence of operations to be executed in the context of a single database connection with exclusive access to it.+--+-- Construct sessions using helpers in this module such as+-- 'statement', 'pipeline' and 'script', or use 'onLibpqConnection' for a low-level+-- escape hatch.+--+-- To actually execute a 'Session' use 'Hasql.Connection.use', which manages+-- concurrent access to the shared connection state and returns either a+-- 'Errors.SessionError' or the result:+--+-- > result <- Hasql.Connection.use connection mySession+--+-- Note: while most session errors are returned as values, user code executed+-- inside a session may still throw exceptions; in that case the driver will+-- reset the connection to a clean state.+newtype Session a+  = Session (ConnectionState.ConnectionState -> IO (Either Errors.SessionError a, ConnectionState.ConnectionState))+  deriving+    (Functor, Applicative, Monad, MonadError Errors.SessionError, MonadIO)+    via (ExceptT Errors.SessionError (StateT ConnectionState.ConnectionState IO))++run :: Session a -> ConnectionState.ConnectionState -> IO (Either Errors.SessionError a, ConnectionState.ConnectionState)+run (Session session) connectionState = session connectionState++-- |+-- Possibly a multi-statement query,+-- which however cannot be parameterized or prepared,+-- nor can any results of it be collected.+script :: ByteString -> Session ()+script sql =+  Session \connectionState -> do+    let connection = ConnectionState.connection connectionState+    result <- Comms.Roundtrip.toSerialIO (Comms.Roundtrip.script (Just sql) sql) connection+    case result of+      Left err -> case err of+        Comms.Roundtrip.ClientError _ details -> do+          pure+            ( Left (Errors.ConnectionSessionError (maybe "" decodeUtf8Lenient details)),+              connectionState+            )+        Comms.Roundtrip.ServerError recvError ->+          pure+            ( Left (Errors.fromRecvErrorInScript sql recvError),+              connectionState+            )+      Right () ->+        pure+          ( Right (),+            connectionState+          )++-- |+-- Execute a single statement by providing parameters to it,+-- running it directly in serial mode.+--+-- Each execution is a dedicated network roundtrip. The first execution of a+-- preparable statement costs an extra roundtrip (a separate @PARSE@), after+-- which steady-state execution is a single roundtrip.+--+-- To batch multiple statements into fewer roundtrips, use 'pipeline' instead.+statement ::+  Statement.Statement params result ->+  params ->+  Session result+statement stmt params =+  Session \connectionState -> do+    let usePreparedStatements = ConnectionState.preparedStatements connectionState+        statementCache = ConnectionState.statementCache connectionState+        oidCache = ConnectionState.oidCache connectionState+        connection = ConnectionState.connection connectionState+        sql = Statement.sql stmt+        missingTypes = OidCache.selectUnknownNames (Statement.unknownTypes stmt) oidCache+    resolvedOidCache <-+      if HashSet.null missingTypes+        then pure (Right oidCache)+        else do+          oidCacheUpdates <-+            PqProcedures.SelectTypeInfo.run connection (PqProcedures.SelectTypeInfo.SelectTypeInfo missingTypes)+          pure $ case oidCacheUpdates of+            Left err -> Left err+            Right oidCacheUpdates ->+              let foundTypes = HashMap.keysSet oidCacheUpdates+                  notFoundTypes = HashSet.difference missingTypes foundTypes+               in if not (HashSet.null notFoundTypes)+                    then Left (Errors.MissingTypesSessionError (HashSet.map Vocab.QualifiedTypeName.toNameTuple notFoundTypes))+                    else Right (oidCache <> OidCache.fromHashMap oidCacheUpdates)+    case resolvedOidCache of+      Left err -> pure (Left err, connectionState)+      Right newOidCache -> do+        let decoder' = RequestingOid.toBase (Statement.decoder stmt) newOidCache+            prepared = usePreparedStatements && Statement.isPrepared stmt+            -- Single-statement context for error reporting:+            -- total statements 1, index 0.+            context = Just (1, 0, sql, Statement.printer stmt params, prepared)+            mapError = \case+              Comms.Roundtrip.ClientError _ details ->+                Errors.ConnectionSessionError (maybe "" decodeUtf8Lenient details)+              Comms.Roundtrip.ServerError recvError ->+                Errors.fromRecvError recvError+            withState (result, newStatementCache) =+              ( first mapError result,+                connectionState+                  { ConnectionState.oidCache = newOidCache,+                    ConnectionState.statementCache = newStatementCache+                  }+              )+        fmap withState+          $ if prepared+            then do+              let (oidList, valueAndFormatList) =+                    Statement.compilePreparedStatementData stmt newOidCache params+                  encodedParams =+                    valueAndFormatList+                      & fmap (fmap (\(bytes, format) -> (bytes, bool Pq.Binary Pq.Text format)))+                  execute remoteKey =+                    Comms.Roundtrip.toSerialIO+                      (Comms.Roundtrip.queryPrepared context remoteKey encodedParams Pq.Binary decoder')+                      connection+              case StatementCache.lookup sql oidList statementCache of+                Just remoteKey -> do+                  result <- execute remoteKey+                  pure (result, statementCache)+                Nothing -> do+                  let (remoteKey, newStatementCache) = StatementCache.insert sql oidList statementCache+                  -- In non-pipeline mode PARSE and EXECUTE cannot be sent+                  -- back-to-back, so prepare in a dedicated roundtrip first.+                  prepareResult <-+                    Comms.Roundtrip.toSerialIO+                      (Comms.Roundtrip.prepare context remoteKey sql oidList)+                      connection+                  case prepareResult of+                    -- PARSE failed: the statement is not on the server, so+                    -- keep the old cache (no entry committed).+                    Left err -> pure (Left err, statementCache)+                    Right () -> do+                      -- PARSE succeeded, so the statement is on the server+                      -- under remoteKey regardless of whether EXECUTE then+                      -- fails. Commit the cache so a later use hits it instead+                      -- of re-issuing PARSE for an already-existing name.+                      result <- execute remoteKey+                      pure (result, newStatementCache)+            else do+              let encodedParams =+                    Statement.compileUnpreparedStatementData stmt newOidCache params+                      & fmap (fmap (\(oid, bytes, format) -> (oid, bytes, bool Pq.Binary Pq.Text format)))+              result <-+                Comms.Roundtrip.toSerialIO+                  (Comms.Roundtrip.queryParams context sql encodedParams Pq.Binary decoder')+                  connection+              pure (result, statementCache)++-- |+-- Execute a pipeline.+pipeline :: Pipeline.Pipeline result -> Session result+pipeline pipeline = Session \connectionState -> do+  let usePreparedStatements = ConnectionState.preparedStatements connectionState+      statementCache = ConnectionState.statementCache connectionState+      oidCache = ConnectionState.oidCache connectionState+      pqConnection = ConnectionState.connection connectionState+   in do+        (result, newOidCache, newStatementCache) <- Pipeline.run pipeline usePreparedStatements pqConnection oidCache statementCache+        let newConnectionState =+              connectionState+                { ConnectionState.oidCache = newOidCache,+                  ConnectionState.statementCache = newStatementCache+                }++        pure (result, newConnectionState)++-- |+-- Execute an operation on the raw libpq connection possibly producing an error and updating the connection.+-- This is a low-level escape hatch for custom integrations.+--+-- You can supply a new connection in the result to replace it in the running Hasql connection.+-- The responsibility to close the old libpq connection is on you.+-- Otherwise, just return the same connection you've received.+--+-- Producing a 'Left' value will cause the session to fail with the given error.+-- Regardless of success or failure, the connection will be replaced with the one you return.+--+-- Throwing exceptions is okay. It will lead to the connection getting reset.+onLibpqConnection ::+  (Pq.Connection -> IO (Either Errors.SessionError a, Pq.Connection)) ->+  Session a+onLibpqConnection f = Session \connectionState -> do+  let pqConnection = ConnectionState.connection connectionState+  (result, newConnection) <- f pqConnection+  let newState = ConnectionState.setConnection newConnection connectionState+  pure (result, newState)
+ src/engine/Hasql/Engine/Decoders/Result.hs view
@@ -0,0 +1,95 @@+module Hasql.Engine.Decoders.Result where++import Hasql.Codecs.RequestingOid qualified as RequestingOid+import Hasql.Comms.ResultDecoder qualified as ResultDecoder+import Hasql.Engine.Decoders.Row (Row (..))+import Hasql.Engine.Decoders.Row qualified as Row+import Hasql.Platform.Prelude++-- |+-- Decoder of a query result.+newtype Result a+  = Result (RequestingOid.RequestingOid (ResultDecoder.ResultDecoder a))+  deriving+    (Functor, Applicative, Filterable)+    via (Compose RequestingOid.RequestingOid ResultDecoder.ResultDecoder)++unwrap :: Result a -> RequestingOid.RequestingOid (ResultDecoder.ResultDecoder a)+unwrap (Result decoder) = decoder++-- * Construction++-- |+-- Decode no value from the result.+--+-- Useful for statements like @INSERT@ or @CREATE@.+{-# INLINE noResult #-}+noResult :: Result ()+noResult =+  Result (RequestingOid.lift ResultDecoder.ok)++-- |+-- Get the amount of rows affected by such statements as+-- @UPDATE@ or @DELETE@.+{-# INLINE rowsAffected #-}+rowsAffected :: Result Int64+rowsAffected =+  Result (RequestingOid.lift ResultDecoder.rowsAffected)++-- |+-- Exactly one row.+-- Will raise the 'Hasql.Errors.UnexpectedRowCountStatementError' error if it's any other.+{-# INLINE singleRow #-}+singleRow :: Row a -> Result a+singleRow decoder =+  Result (fmap ResultDecoder.single (Row.toDecoder decoder))++refineResult :: (a -> Either Text b) -> Result a -> Result b+refineResult refiner (Result decoder) =+  Result (fmap (ResultDecoder.refine refiner) decoder)++-- ** Multi-row traversers++-- |+-- Foldl multiple rows.+{-# INLINE foldlRows #-}+foldlRows :: (a -> b -> a) -> a -> Row b -> Result a+foldlRows step init decoder =+  Result+    (fmap (ResultDecoder.foldl step init) (Row.toDecoder decoder))++-- |+-- Foldr multiple rows.+{-# INLINE foldrRows #-}+foldrRows :: (b -> a -> a) -> a -> Row b -> Result a+foldrRows step init decoder =+  Result+    (fmap (ResultDecoder.foldr step init) (Row.toDecoder decoder))++-- ** Specialized multi-row results++-- |+-- Maybe one row or none.+{-# INLINE rowMaybe #-}+rowMaybe :: Row a -> Result (Maybe a)+rowMaybe decoder =+  Result+    (fmap ResultDecoder.maybe (Row.toDecoder decoder))++-- |+-- Zero or more rows packed into the vector.+--+-- It's recommended to prefer this function to 'rowList',+-- since it performs notably better.+{-# INLINE rowVector #-}+rowVector :: Row a -> Result (Vector a)+rowVector decoder =+  Result+    (fmap ResultDecoder.vector (Row.toDecoder decoder))++-- |+-- Zero or more rows packed into the list.+{-# INLINE rowList #-}+rowList :: Row a -> Result [a]+rowList =+  foldrRows strictCons []
+ src/engine/Hasql/Engine/Decoders/Row.hs view
@@ -0,0 +1,65 @@+module Hasql.Engine.Decoders.Row where++import Hasql.Codecs.Decoders+import Hasql.Codecs.Decoders.Value qualified as Value+import Hasql.Codecs.RequestingOid qualified as RequestingOid+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo+import Hasql.Comms.RowDecoder qualified+import Hasql.Platform.Prelude+import PostgreSQL.Binary.Decoding qualified as Binary++-- |+-- 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 (RequestingOid.RequestingOid (Hasql.Comms.RowDecoder.RowDecoder a))+  deriving+    (Functor, Applicative, Filterable)+    via (Compose RequestingOid.RequestingOid Hasql.Comms.RowDecoder.RowDecoder)++toDecoder ::+  Row a ->+  RequestingOid.RequestingOid (Hasql.Comms.RowDecoder.RowDecoder a)+toDecoder (Row f) = f++-- |+-- Lift an individual value decoder to a composable row decoder.+{-# INLINE column #-}+column :: NullableOrNot Value a -> Row a+column = \case+  Nullable valueDecoder ->+    Row case Value.toOid valueDecoder of+      Just oid ->+        fmap+          (Hasql.Comms.RowDecoder.nullableColumn (Just oid) . Binary.valueParser)+          (Value.toDecoder valueDecoder)+      Nothing -> do+        RequestingOid.hoistLookingUp+          (Vocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema valueDecoder) (Value.toTypeName valueDecoder))+          ( \lookupResult decoder ->+              Hasql.Comms.RowDecoder.nullableColumn (Just (chooseLookedUpOid valueDecoder lookupResult)) (Binary.valueParser decoder)+          )+          (Value.toDecoder valueDecoder)+  NonNullable valueDecoder ->+    Row case Value.toOid valueDecoder of+      Just oid ->+        fmap+          (Hasql.Comms.RowDecoder.nonNullableColumn (Just oid) . Binary.valueParser)+          (Value.toDecoder valueDecoder)+      Nothing -> do+        RequestingOid.hoistLookingUp+          (Vocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema valueDecoder) (Value.toTypeName valueDecoder))+          (\lookupResult decoder -> Hasql.Comms.RowDecoder.nonNullableColumn (Just (chooseLookedUpOid valueDecoder lookupResult)) (Binary.valueParser decoder))+          (Value.toDecoder valueDecoder)+  where+    chooseLookedUpOid valueDecoder typeInfo =+      if Value.toDimensionality valueDecoder > 0+        then Vocab.TypeInfo.toArrayOid typeInfo+        else Vocab.TypeInfo.toBaseOid typeInfo
+ src/engine/Hasql/Engine/Errors.hs view
@@ -0,0 +1,473 @@+module Hasql.Engine.Errors where++import Hasql.Comms.Recv qualified+import Hasql.Comms.ResultDecoder qualified+import Hasql.Comms.Roundtrip qualified+import Hasql.Comms.RowReader qualified+import Hasql.Platform.Prelude+import TextBuilder qualified++-- * Error types++-- |+-- Error that occurs when attempting to establish a database connection.+--+-- These errors can occur when calling 'Hasql.Connection.acquire'.+-- Connection errors are categorized into several types to help with+-- error handling and logging.+data ConnectionError+  = -- | Network-level error while connecting to the database server.+    --+    -- This typically indicates issues like:+    --+    -- * Server is not reachable (wrong host\/port or server is down)+    -- * Network connectivity problems+    -- * Firewall blocking the connection+    -- * Connection timeout+    --+    -- These errors are transient and the operation can be retried.+    NetworkingConnectionError+      -- | Human readable details intended for logging.+      Text+  | -- | Authentication failed when connecting to the database.+    --+    -- This typically indicates issues like:+    --+    -- * Invalid username or password+    -- * User does not have permission to access the database+    -- * Authentication method mismatch (e.g., server requires SSL but client doesn't use it)+    --+    -- These errors are not transient and require fixing the credentials or permissions.+    AuthenticationConnectionError+      -- | Human readable details intended for logging.+      Text+  | -- | Compatibility issue between client and server.+    --+    -- This typically indicates issues like:+    --+    -- * Server version is too old or too new+    -- * Required PostgreSQL features are not available+    -- * Protocol version mismatch+    --+    -- These errors are not transient and require upgrading/downgrading+    -- the server or client.+    CompatibilityConnectionError+      -- | Human readable details intended for logging.+      Text+  | -- | Uncategorized error coming from @libpq@.+    --+    -- This is a catch-all for connection errors that don't fit into other categories.+    -- The error message may be empty if @libpq@ doesn't provide details.+    --+    -- These errors are not transient by default.+    OtherConnectionError+      -- | Human readable details intended for logging. May be empty.+      Text+  deriving stock (Show, Eq)++-- |+-- Error that occurs during session execution.+--+-- A session is a batch of actions executed in a database connection context.+-- Session errors can occur due to statement failures, connection issues,+-- missing types, or internal driver errors.+--+-- Session errors provide detailed context to help diagnose problems,+-- including SQL text, parameters, and the location of the error within+-- a pipeline of statements.+data SessionError+  = -- | An error occurred while executing a statement in the session.+    --+    -- This wraps statement-level errors and provides additional context about:+    --+    -- * Which statement in the pipeline failed (when multiple statements are batched)+    -- * The SQL text and parameters of the failing statement+    -- * Whether the statement was prepared or unprepared+    --+    -- The error message includes formatted output showing all this context,+    -- making it easier to diagnose issues in production.+    StatementSessionError+      -- | Total number of statements in the running pipeline. 1 if it's executed alone.+      Int+      -- | 0-based index of the statement that failed. 0 if it's executed alone.+      Int+      -- | SQL template of the failing statement.+      Text+      -- | Parameter values as text (for logging purposes).+      [Text]+      -- | Whether the statement was executed as a prepared one.+      Bool+      -- | The underlying statement error.+      StatementError+  | -- | An error occurred while executing a script.+    --+    -- Scripts are multi-statement SQL texts executed via 'Hasql.Session.script'.+    -- Unlike regular statements, scripts don't support parameters or result decoding,+    -- and errors are limited to server-reported issues.+    ScriptSessionError+      -- | The SQL text of the script.+      Text+      -- | The server error that occurred.+      ServerError+  | -- | A connection-level error occurred during session execution.+    --+    -- This indicates that the connection to the database was lost or+    -- became unusable during the session. These errors are transient+    -- and the operation can be retried with a new connection.+    --+    -- Note: As of version 1.10, connections recover from async exceptions+    -- without resetting, preserving connection-local state.+    ConnectionSessionError+      -- | Human-readable details about the connection error.+      Text+  | -- | One or more types referenced in the statement could not be found in the database.+    --+    -- This occurs when using custom types (enums, composite types, domains) that+    -- are resolved by name at runtime, but the types don't exist in the database.+    --+    -- To fix this error:+    --+    -- * Ensure the types are defined in the database+    -- * Check that schema search paths are configured correctly+    -- * Verify that the type names in your code match those in the database+    MissingTypesSessionError+      -- | Set of (schema name, type name) pairs that could not be found.+      --+      -- Schema name is 'Nothing' when the type was looked up without a schema qualifier.+      (HashSet (Maybe Text, Text))+  | -- | An internal driver error occurred.+    --+    -- This indicates either:+    --+    -- * A bug in Hasql+    -- * The PostgreSQL server misbehaving+    -- * An unexpected response from the server+    --+    -- If you encounter this error, please report it as a bug.+    DriverSessionError+      -- | Human-readable details about what went wrong.+      Text+  deriving stock (Show, Eq)++-- |+-- Error that occurs when executing a single statement.+--+-- Statement errors can be caused by server-side issues (SQL errors, constraint violations)+-- or by mismatches between the decoder specification and the actual result structure+-- (wrong number of rows/columns, type mismatches, or cell-level decoding failures).+data StatementError+  = -- | The server rejected the statement and returned an error.+    --+    -- This includes SQL syntax errors, constraint violations, permission errors,+    -- and any other error reported by PostgreSQL during statement execution.+    ServerStatementError ServerError+  | -- | The statement returned a different number of rows than expected.+    --+    -- This occurs when using result decoders like @Decoders.singleRow@ or+    -- @Decoders.rowsAffectedAtLeast@ that have specific row count expectations.+    UnexpectedRowCountStatementError+      -- | Expected minimum number of rows.+      Int+      -- | Expected maximum number of rows.+      Int+      -- | Actual number of rows returned.+      Int+  | -- | The statement returned a different number of columns than expected.+    --+    -- This indicates a mismatch between the decoder specification and the+    -- actual result structure, possibly due to:+    --+    -- * Schema changes (columns added or removed)+    -- * Wrong query (selecting different columns than expected)+    -- * Decoder configuration error+    UnexpectedColumnCountStatementError+      -- | Expected number of columns.+      Int+      -- | Actual number of columns returned.+      Int+  | -- | A column has a different type than expected.+    --+    -- This occurs when the decoder expects a specific PostgreSQL type (by OID)+    -- but the actual column has a different type. This can happen due to:+    --+    -- * Schema changes (column type changed)+    -- * Wrong query (selecting wrong column or using a cast)+    -- * Decoder configuration error+    --+    -- Note: As of version 1.10, Hasql performs strict type checking and will+    -- report this error instead of attempting automatic type coercion.+    UnexpectedColumnTypeStatementError+      -- | 0-based column index where the type mismatch occurred.+      Int+      -- | Expected PostgreSQL type OID.+      Word32+      -- | Actual PostgreSQL type OID of the column.+      Word32+  | -- | An error occurred while decoding a specific row.+    --+    -- This wraps errors that occur at the row or cell level, providing+    -- context about which row failed.+    RowStatementError+      -- | 0-based index of the row that failed to decode.+      Int+      -- | The underlying row-level error.+      RowError+  | -- | The database returned an unexpected result structure.+    --+    -- This is a catch-all error that indicates either:+    --+    -- * An improper statement (e.g., executing a query that doesn't match expectations)+    -- * A schema mismatch between the code and database+    -- * A bug in Hasql or server misbehavior+    UnexpectedResultStatementError+      -- | Human-readable details about what went wrong.+      Text+  deriving stock (Show, Eq)++-- |+-- Error reported by the PostgreSQL server when executing a statement.+--+-- The server provides structured error information including error codes+-- (SQL state), messages, and optional context like hints and position information.+--+-- For a complete list of PostgreSQL error codes, see:+-- <https://www.postgresql.org/docs/current/errcodes-appendix.html>+data ServerError+  = ServerError+      -- | SQL State Code (SQLSTATE).+      --+      -- A five-character code that identifies the error class and condition.+      -- Examples: @\"23505\"@ (unique violation), @\"42P01\"@ (undefined table).+      Text+      -- | Primary error message.+      --+      -- A human-readable description of the error.+      Text+      -- | Optional detailed error information.+      --+      -- Additional context about the error, if available.+      (Maybe Text)+      -- | Optional hint for resolving the error.+      --+      -- A suggestion for how to fix the problem, if available.+      (Maybe Text)+      -- | Optional position in the SQL string where the error occurred.+      --+      -- A 1-based character index into the SQL string, if the error+      -- relates to a specific location in the query.+      (Maybe Int)+  deriving stock (Show, Eq)++-- |+-- Error that occurs when decoding a result row.+--+-- Row errors indicate problems when processing an individual row from the result set,+-- either at the cell level or during row refinement/validation.+data RowError+  = -- | An error occurred while decoding a specific cell in the row.+    --+    -- This wraps cell-level errors (null handling, deserialization failures)+    -- and provides context about which column failed and its type.+    CellRowError+      -- | 0-based index of the column where the error occurred.+      Int+      -- | PostgreSQL type OID of the column, as reported by the server.+      Word32+      -- | The underlying cell-level error.+      CellError+  | -- | A refinement or validation error when processing the row.+    --+    -- This occurs when using refinement functions in row decoders+    -- (e.g., with 'Decoders.refineRow') to validate or transform+    -- decoded values. The refinement function rejected the row data.+    RefinementRowError+      -- | Human-readable details about why the refinement failed.+      Text+  deriving stock (Show, Eq)++-- |+-- Error that occurs when decoding a single cell (column value) in a result row.+--+-- Cell errors indicate problems with individual values returned by the database,+-- such as unexpected nulls or failures in binary deserialization.+data CellError+  = -- | A NULL value was encountered when a non-NULL value was expected.+    --+    -- This occurs when using non-nullable decoders (e.g., @Decoders.nonNullable@)+    -- on a column that contains a NULL value.+    UnexpectedNullCellError+  | -- | Failed to deserialize the cell value from its binary representation.+    --+    -- This can occur when:+    --+    -- * The binary data is corrupted+    -- * The decoder doesn't match the actual data type+    -- * The data format is invalid for the expected type+    DeserializationCellError+      -- | Human-readable error message describing what went wrong.+      Text+  deriving stock (Show, Eq)++fromRoundtripError :: Hasql.Comms.Roundtrip.Error context -> SessionError+fromRoundtripError = \case+  Hasql.Comms.Roundtrip.ClientError _context details ->+    ConnectionSessionError (maybe "" decodeUtf8Lenient details)+  Hasql.Comms.Roundtrip.ServerError recvError ->+    fromRecvError (Nothing <$ recvError)++fromRecvError :: Hasql.Comms.Recv.Error (Maybe (Int, Int, ByteString, [Text], Bool)) -> SessionError+fromRecvError = \case+  Hasql.Comms.Recv.ResultError location _resultOffset resultError ->+    case location of+      Nothing ->+        (DriverSessionError . TextBuilder.toText . mconcat)+          [ "Unexpected error outside of statement context. ",+            "This indicates a bug in Hasql or the server misbehaving. ",+            "Error: ",+            TextBuilder.string (show resultError)+          ]+      Just (totalStatements, statementIndex, sql, parameters, prepared) ->+        StatementSessionError+          totalStatements+          statementIndex+          (decodeUtf8Lenient sql)+          parameters+          prepared+          (fromStatementResultError resultError)+  Hasql.Comms.Recv.NoResultsError location details ->+    case location of+      Nothing ->+        (DriverSessionError . TextBuilder.toText . mconcat)+          [ "Unexpectedly got no results outside of statement context. ",+            "This indicates a bug in Hasql or the server misbehaving. ",+            "Details: ",+            TextBuilder.string (show details)+          ]+      Just (totalStatements, statementIndex, sql, parameters, prepared) ->+        StatementSessionError+          totalStatements+          statementIndex+          (decodeUtf8Lenient sql)+          parameters+          prepared+          (UnexpectedRowCountStatementError 1 1 0)+  Hasql.Comms.Recv.TooManyResultsError location actual ->+    case location of+      Nothing ->+        (DriverSessionError . TextBuilder.toText . mconcat)+          [ "Unexpectedly got too many results outside of statement context. ",+            "This indicates a bug in Hasql or the server misbehaving. ",+            "Amount: ",+            TextBuilder.decimal actual+          ]+      Just (totalStatements, statementIndex, sql, parameters, prepared) ->+        StatementSessionError+          totalStatements+          statementIndex+          (decodeUtf8Lenient sql)+          parameters+          prepared+          (UnexpectedRowCountStatementError 1 1 actual)++fromStatementResultError :: Hasql.Comms.ResultDecoder.Error -> StatementError+fromStatementResultError = \case+  Hasql.Comms.ResultDecoder.ServerError code message detail hint position ->+    ServerStatementError+      ( ServerError+          (decodeUtf8Lenient code)+          (decodeUtf8Lenient message)+          (fmap decodeUtf8Lenient detail)+          (fmap decodeUtf8Lenient hint)+          position+      )+  Hasql.Comms.ResultDecoder.UnexpectedResult msg ->+    UnexpectedResultStatementError msg+  Hasql.Comms.ResultDecoder.UnexpectedRowCount actual ->+    UnexpectedRowCountStatementError 1 1 actual+  Hasql.Comms.ResultDecoder.UnexpectedColumnCount expected actual ->+    UnexpectedColumnCountStatementError expected actual+  Hasql.Comms.ResultDecoder.DecoderTypeMismatch colIdx expectedOid actualOid ->+    UnexpectedColumnTypeStatementError+      colIdx+      expectedOid+      actualOid+  Hasql.Comms.ResultDecoder.RowError rowIndex rowError ->+    case rowError of+      Hasql.Comms.RowReader.CellError column oid cellErr ->+        RowStatementError+          rowIndex+          ( CellRowError+              column+              oid+              ( case cellErr of+                  Hasql.Comms.RowReader.DecodingCellError msg -> DeserializationCellError msg+                  Hasql.Comms.RowReader.UnexpectedNullCellError -> UnexpectedNullCellError+              )+          )+      Hasql.Comms.RowReader.RefinementError msg ->+        RowStatementError+          rowIndex+          (RefinementRowError msg)++fromRecvErrorInScript :: ByteString -> Hasql.Comms.Recv.Error (Maybe ByteString) -> SessionError+fromRecvErrorInScript scriptSql = \case+  Hasql.Comms.Recv.ResultError _ _ resultError ->+    case resultError of+      Hasql.Comms.ResultDecoder.ServerError code message detail hint position ->+        ScriptSessionError+          (decodeUtf8Lenient scriptSql)+          ( ServerError+              (decodeUtf8Lenient code)+              (decodeUtf8Lenient message)+              (fmap decodeUtf8Lenient detail)+              (fmap decodeUtf8Lenient hint)+              position+          )+      Hasql.Comms.ResultDecoder.UnexpectedResult msg ->+        (DriverSessionError . TextBuilder.toText . mconcat)+          [ "Unexpected result in script: ",+            TextBuilder.text msg+          ]+      Hasql.Comms.ResultDecoder.UnexpectedRowCount actual ->+        (DriverSessionError . TextBuilder.toText . mconcat)+          [ "Unexpected amount of rows in script: ",+            TextBuilder.decimal actual+          ]+      Hasql.Comms.ResultDecoder.UnexpectedColumnCount expected actual ->+        (DriverSessionError . TextBuilder.toText . mconcat)+          [ "Unexpected amount of columns in script: expected ",+            TextBuilder.decimal expected,+            ", got ",+            TextBuilder.decimal actual+          ]+      Hasql.Comms.ResultDecoder.DecoderTypeMismatch colIdx expectedOid actualOid ->+        (DriverSessionError . TextBuilder.toText . mconcat)+          [ "Decoder type mismatch in script: expected OID ",+            TextBuilder.string (show expectedOid),+            " at column ",+            TextBuilder.decimal colIdx,+            ", got ",+            TextBuilder.string (show actualOid)+          ]+      Hasql.Comms.ResultDecoder.RowError rowIndex rowError ->+        (DriverSessionError . TextBuilder.toText . mconcat)+          [ "Row error in script at row ",+            TextBuilder.decimal rowIndex,+            ": ",+            TextBuilder.string (show rowError)+          ]+  Hasql.Comms.Recv.NoResultsError _ details ->+    (DriverSessionError . TextBuilder.toText . mconcat)+      [ "Got no results in script.",+        " This indicates a bug in Hasql or the server misbehaving.",+        details+          & filter (/= "")+          & foldMap (mappend " Details: " . TextBuilder.text . decodeUtf8Lenient)+      ]+  Hasql.Comms.Recv.TooManyResultsError _ actual ->+    (DriverSessionError . TextBuilder.toText . mconcat)+      [ "Got too many results in script. ",+        "This indicates a bug in Hasql or the server misbehaving. ",+        "Amount: ",+        TextBuilder.decimal actual+      ]
+ src/engine/Hasql/Engine/PqProcedures/SelectTypeInfo.hs view
@@ -0,0 +1,118 @@+module Hasql.Engine.PqProcedures.SelectTypeInfo+  ( SelectTypeInfo (..),+    SelectTypeInfoResult,+    run,+  )+where++import Data.HashMap.Strict qualified as HashMap+import Data.HashSet qualified as HashSet+import Hasql.Codecs.Decoders.Value qualified as Decoders.Value+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo+import Hasql.Comms.ResultDecoder qualified+import Hasql.Comms.Roundtrip qualified+import Hasql.Comms.RowDecoder qualified+import Hasql.Engine.Errors qualified as Errors+import Hasql.Platform.Prelude+import PostgreSQL.Binary.Encoding qualified as Binary+import Pqi qualified as Pq++newtype SelectTypeInfo = SelectTypeInfo+  { -- | Set of (schema name, type name) pairs to look up.+    keys :: HashSet Vocab.QualifiedTypeName+  }++-- | Result maps (schema name, type name) pairs to TypeInfo (scalar OID, array OID).+type SelectTypeInfoResult =+  HashMap Vocab.QualifiedTypeName Vocab.TypeInfo.TypeInfo++run :: Pq.Connection -> SelectTypeInfo -> IO (Either Errors.SessionError SelectTypeInfoResult)+run connection (SelectTypeInfo keys) =+  if HashSet.null keys+    then pure (Right HashMap.empty)+    else+      first Errors.fromRoundtripError+        <$> Hasql.Comms.Roundtrip.toSerialIO (roundtrip (SelectTypeInfo keys)) connection++sql :: ByteString+sql =+  "with\n\+  \  inputs as (\n\+  \    select *\n\+  \    from unnest($1, $2) as x(schema_name, type_name)\n\+  \  ),\n\+  \  unnamespaced_results as (\n\+  \    select\n\+  \      null :: text as schema_name,\n\+  \      pg_type.typname :: text as type_name,\n\+  \      pg_type.oid :: int4 as type_oid,\n\+  \      pg_type.typarray :: int4 as array_oid\n\+  \    from inputs\n\+  \    join pg_type on pg_type.oid = to_regtype(inputs.type_name)\n\+  \    where inputs.schema_name is null\n\+  \  ),\n\+  \  namespaced_results as (\n\+  \    select\n\+  \      pg_namespace.nspname :: text as schema_name,\n\+  \      pg_type.typname :: text as type_name,\n\+  \      pg_type.oid :: int4 as type_oid,\n\+  \      pg_type.typarray :: int4 as array_oid\n\+  \    from inputs\n\+  \    join pg_namespace on pg_namespace.nspname = inputs.schema_name\n\+  \    join pg_type\n\+  \      on pg_type.typname = inputs.type_name\n\+  \      and pg_type.typnamespace = pg_namespace.oid\n\+  \    where inputs.schema_name is not null\n\+  \  )\n\+  \select * from unnamespaced_results\n\+  \union\n\+  \select * from namespaced_results"++roundtrip :: SelectTypeInfo -> Hasql.Comms.Roundtrip.Roundtrip () SelectTypeInfoResult+roundtrip params =+  Hasql.Comms.Roundtrip.queryParams () sql (encodeParams params) Pq.Binary decoder++-- | Encode the two text-array parameters directly.+-- Text OID is 25; text-array OID is 1009.+encodeParams :: SelectTypeInfo -> [Maybe (Word32, ByteString, Pq.Format)]+encodeParams (SelectTypeInfo keys) =+  let (schemaNames, typeNames) = unzip (fmap Vocab.QualifiedTypeName.toNameTuple (HashSet.toList keys))+      schemaArray = Binary.encodingBytes (Binary.array 25 (encodeTextArray (encodeMaybeText schemaNames)))+      typeArray = Binary.encodingBytes (Binary.array 25 (encodeTextArray (fmap (Binary.encodingArray . Binary.text_strict) typeNames)))+   in [ Just (1009, schemaArray, Pq.Binary),+        Just (1009, typeArray, Pq.Binary)+      ]+  where+    encodeTextArray elements =+      Binary.dimensionArray foldl' id elements+    encodeMaybeText =+      fmap \case+        Nothing -> Binary.nullArray+        Just text -> Binary.encodingArray (Binary.text_strict text)++decoder :: Hasql.Comms.ResultDecoder.ResultDecoder SelectTypeInfoResult+decoder =+  Hasql.Comms.ResultDecoder.foldl step HashMap.empty rowDecoder+  where+    step acc (schemaName, typeName, typeOid, arrayOid) =+      HashMap.insert (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) (Vocab.TypeInfo.TypeInfo typeOid arrayOid) acc++rowDecoder :: Hasql.Comms.RowDecoder.RowDecoder (Maybe Text, Text, Word32, Word32)+rowDecoder =+  (,,,)+    <$> nullableColumn Decoders.Value.text+    <*> nonNullableColumn Decoders.Value.text+    <*> nonNullableColumn (fromIntegral <$> Decoders.Value.int4)+    <*> nonNullableColumn (fromIntegral <$> Decoders.Value.int4)+  where+    nullableColumn valueDecoder =+      Hasql.Comms.RowDecoder.nullableColumn+        (Decoders.Value.toBaseOid valueDecoder)+        (Decoders.Value.toByteStringParser valueDecoder mempty)++    nonNullableColumn valueDecoder =+      Hasql.Comms.RowDecoder.nonNullableColumn+        (Decoders.Value.toBaseOid valueDecoder)+        (Decoders.Value.toByteStringParser valueDecoder mempty)
+ src/engine/Hasql/Engine/Statement.hs view
@@ -0,0 +1,188 @@+module Hasql.Engine.Statement+  ( Statement (..),+    preparable,+    unpreparable,+    refineResult,+    toSql,+    compilePreparedStatementData,+    compileUnpreparedStatementData,+  )+where++import Data.Text.Encoding qualified as TextEncoding+import Data.Vector qualified as Vector+import Hasql.Codecs.Encoders qualified as Encoders+import Hasql.Codecs.Encoders.Params qualified as Params+import Hasql.Codecs.RequestingOid qualified as RequestingOid+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.OidCache qualified as Vocab.OidCache+import Hasql.Codecs.Vocab.ParamMeta (ParamMeta (..))+import Hasql.Codecs.Vocab.TypeRef qualified as Vocab.TypeRef+import Hasql.Comms.ResultDecoder qualified as ResultDecoder+import Hasql.Engine.Decoders.Result qualified as Decoders+import Hasql.Engine.Decoders.Result qualified as Decoders.Result+import Hasql.Platform.Prelude++-- |+-- Specification of a strictly single-statement query, which can be parameterized and prepared.+-- It encapsulates the mapping of parameters and results in association with an SQL template.+--+-- Following is an example of a declaration of a prepared statement with its associated codecs.+--+-- @+-- selectSum :: 'Statement' (Int64, Int64) Int64+-- selectSum =+--   'preparable' sql encoder decoder+--   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.nonNullable' Encoders.'Hasql.Encoders.int8'))+--     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 params result+  = Statement+  { -- | SQL template pre-encoded as UTF-8 for execution.+    sql :: ByteString,+    -- | Frozen per-parameter metadata: type reference, dimensionality, text-format flag.+    -- Produced once at construction from the Params DList and reused across executions.+    columnsMetadata :: Vector ParamMeta,+    -- | Serialise params to encoded wire values given a resolved OID cache.+    serializer :: Vocab.OidCache -> params -> [Maybe ByteString],+    -- | Render params in human-readable form (for error reporting).+    printer :: params -> [Text],+    -- | Union of encoder and decoder unknown types, resolved once at construction.+    unknownTypes :: HashSet Vocab.QualifiedTypeName,+    -- | Unwrapped result decoder (RequestingOid layer already peeled from Result).+    decoder :: RequestingOid.RequestingOid (ResultDecoder.ResultDecoder result),+    -- | Whether this statement may be prepared on the server.+    isPrepared :: Bool+  }++-- |+-- Construct a preparable statement.+--+-- Use this for statements that will be executed multiple times with different parameters.+-- Preparable statements are cached by PostgreSQL, which avoids reconstructing the execution plan each time.+--+-- Suitable for applications with a limited amount of queries that don't generate SQL dynamically.+preparable ::+  -- | SQL template with parameters in positional notation (@$1@, @$2@, etc.)+  Text ->+  -- | Parameters encoder+  Encoders.Params params ->+  -- | Result decoder+  Decoders.Result result ->+  Statement params result+preparable sqlText encoder resultDecoder =+  Statement+    { sql = TextEncoding.encodeUtf8 sqlText,+      columnsMetadata = Params.toColumnsMetadata encoder,+      serializer = Params.toSerializer encoder,+      printer = Params.toPrinter encoder,+      unknownTypes = Params.toUnknownTypes encoder <> RequestingOid.toUnknownTypes rawDecoder,+      decoder = rawDecoder,+      isPrepared = True+    }+  where+    rawDecoder = Decoders.Result.unwrap resultDecoder++-- |+-- Construct an unpreparable statement.+--+-- Use this for statements that are dynamically generated or executed only once.+-- Unpreparable statements are not cached by PostgreSQL.+--+-- Suitable for dynamic SQL or one-off queries.+unpreparable ::+  -- | SQL template with parameters in positional notation (@$1@, @$2@, etc.)+  Text ->+  -- | Parameters encoder+  Encoders.Params params ->+  -- | Result decoder+  Decoders.Result result ->+  Statement params result+unpreparable sqlText encoder resultDecoder =+  Statement+    { sql = TextEncoding.encodeUtf8 sqlText,+      columnsMetadata = Params.toColumnsMetadata encoder,+      serializer = Params.toSerializer encoder,+      printer = Params.toPrinter encoder,+      unknownTypes = Params.toUnknownTypes encoder <> RequestingOid.toUnknownTypes rawDecoder,+      decoder = rawDecoder,+      isPrepared = False+    }+  where+    rawDecoder = Decoders.Result.unwrap resultDecoder++instance Functor (Statement params) where+  {-# INLINE fmap #-}+  fmap f stmt = stmt {decoder = fmap (fmap f) (decoder stmt)}++instance Filterable (Statement params) where+  {-# INLINE mapMaybe #-}+  mapMaybe filtrator stmt = stmt {decoder = fmap (mapMaybe filtrator) (decoder stmt)}++instance Profunctor Statement where+  {-# INLINE dimap #-}+  dimap f1 f2 stmt =+    stmt+      { serializer = \oidCache -> serializer stmt oidCache . f1,+        printer = printer stmt . f1,+        decoder = fmap (fmap f2) (decoder stmt)+      }++-- |+-- Refine the result of a statement,+-- causing the running session to fail with the 'Hasql.Errors.UnexpectedResultStatementError' error in case of a refinement failure.+--+-- This function is especially useful for refining the results of statements produced with+-- <http://hackage.haskell.org/package/hasql-th the \"hasql-th\" library>.+refineResult :: (a -> Either Text b) -> Statement params a -> Statement params b+refineResult refiner stmt = stmt {decoder = fmap (ResultDecoder.refine refiner) (decoder stmt)}++-- | Extract the SQL template from a statement.+toSql :: Statement params result -> Text+toSql stmt = decodeUtf8Lenient (sql stmt)++-- | Compile prepared-statement data: resolve OIDs and pair encoded values with their format flags.+compilePreparedStatementData ::+  Statement params result ->+  Vocab.OidCache ->+  params ->+  ([Word32], [Maybe (ByteString, Bool)])+compilePreparedStatementData stmt oidCache params =+  unzip+    $ zipWith+      (\(ParamMeta typeRef dim fmt) encoding -> (resolveOid typeRef dim, fmap (,fmt) encoding))+      (Vector.toList (columnsMetadata stmt))+      (serializer stmt oidCache params)+  where+    resolveOid (Vocab.TypeRef.NamedType name) dim =+      case Vocab.OidCache.lookupTypeNameScalar name oidCache of+        Just oid -> if dim == 0 then oid else fromMaybe 0 (Vocab.OidCache.lookupTypeNameArray name oidCache)+        Nothing -> 0+    resolveOid (Vocab.TypeRef.KnownOid oid) _ = oid++-- | Compile unprepared-statement data: resolve OIDs inline with encoded values.+compileUnpreparedStatementData ::+  Statement params result ->+  Vocab.OidCache ->+  params ->+  [Maybe (Word32, ByteString, Bool)]+compileUnpreparedStatementData stmt oidCache params =+  zipWith+    (\(ParamMeta typeRef dim fmt) encoding -> (,,) <$> Just (resolveOid typeRef dim) <*> encoding <*> Just fmt)+    (Vector.toList (columnsMetadata stmt))+    (serializer stmt oidCache params)+  where+    resolveOid (Vocab.TypeRef.NamedType name) dim =+      case Vocab.OidCache.lookupTypeNameScalar name oidCache of+        Just oid -> if dim == 0 then oid else fromMaybe 0 (Vocab.OidCache.lookupTypeNameArray name oidCache)+        Nothing -> 0+    resolveOid (Vocab.TypeRef.KnownOid oid) _ = oid
+ src/engine/Hasql/Engine/Structures/ConnectionState.hs view
@@ -0,0 +1,98 @@+-- |+-- This module defines the internal state of a database connection.+module Hasql.Engine.Structures.ConnectionState+  ( ConnectionState (..),+    toStatementCache,+    fromConnection,+    setPreparedStatements,+    setStatementCache,+    setConnection,+    setOidCache,+    mapStatementCache,+    mapOidCache,+    traverseStatementCache,+    resetPreparedStatementsCache,+  )+where++import Hasql.Codecs.Vocab.OidCache qualified as OidCache+import Hasql.Engine.Structures.StatementCache qualified as StatementCache+import Hasql.Platform.Prelude+import Pqi qualified as Pq++-- |+-- The internal state of a database connection.+data ConnectionState = ConnectionState+  { -- | Whether prepared statements are enabled.+    preparedStatements :: Bool,+    -- | The statement cache for prepared statements.+    statementCache :: StatementCache.StatementCache,+    -- | The OID cache for type name to OID mapping.+    oidCache :: OidCache.OidCache,+    -- | The underlying database connection.+    connection :: Pq.Connection+  }++toStatementCache :: ConnectionState -> StatementCache.StatementCache+toStatementCache ConnectionState {..} = statementCache++fromConnection :: Pq.Connection -> ConnectionState+fromConnection connection =+  ConnectionState+    { preparedStatements = False,+      statementCache = StatementCache.empty,+      oidCache = OidCache.empty,+      connection = connection+    }++setPreparedStatements :: Bool -> ConnectionState -> ConnectionState+setPreparedStatements preparedStatements connectionState =+  connectionState {preparedStatements = preparedStatements}++setStatementCache :: StatementCache.StatementCache -> ConnectionState -> ConnectionState+setStatementCache statementCache connectionState =+  connectionState {statementCache = statementCache}++setConnection :: Pq.Connection -> ConnectionState -> ConnectionState+setConnection connection connectionState =+  connectionState {connection = connection}++setOidCache :: OidCache.OidCache -> ConnectionState -> ConnectionState+setOidCache oidCache connectionState =+  connectionState {oidCache}++mapStatementCache ::+  (StatementCache.StatementCache -> StatementCache.StatementCache) ->+  (ConnectionState -> ConnectionState)+mapStatementCache f ConnectionState {..} =+  ConnectionState+    { statementCache = f statementCache,+      ..+    }++mapOidCache ::+  (OidCache.OidCache -> OidCache.OidCache) ->+  (ConnectionState -> ConnectionState)+mapOidCache f ConnectionState {..} =+  ConnectionState+    { oidCache = f oidCache,+      ..+    }++traverseStatementCache ::+  (Functor f) =>+  (StatementCache.StatementCache -> f StatementCache.StatementCache) ->+  (ConnectionState -> f ConnectionState)+traverseStatementCache f ConnectionState {..} =+  fmap+    ( \newStatementCache ->+        ConnectionState+          { statementCache = newStatementCache,+            ..+          }+    )+    (f statementCache)++resetPreparedStatementsCache :: ConnectionState -> ConnectionState+resetPreparedStatementsCache =+  mapStatementCache (const StatementCache.empty)
+ src/engine/Hasql/Engine/Structures/StatementCache.hs view
@@ -0,0 +1,55 @@+module Hasql.Engine.Structures.StatementCache+  ( -- * Pure registry operations+    StatementCache,+    empty,+    lookup,+    insert,+    reset,+  )+where++import Data.HashMap.Strict qualified as HashMap+import Hasql.Platform.Prelude hiding (empty, insert, lookup, reset)++-- | Pure registry state containing the hash map and counter+data StatementCache = StatementCache (HashMap LocalKey ByteString) Word+  deriving stock (Show, Eq)++-- | Create an empty registry state+{-# INLINEABLE empty #-}+empty :: StatementCache+empty = StatementCache HashMap.empty 0++-- | Pure lookup operation+{-# INLINEABLE lookup #-}+lookup :: ByteString -> [Word32] -> StatementCache -> Maybe ByteString+lookup sql oids (StatementCache hashMap _) = HashMap.lookup localKey hashMap+  where+    localKey = LocalKey sql oids++-- | Pure insert operation that returns new state and the generated remote key+{-# INLINEABLE insert #-}+insert :: ByteString -> [Word32] -> StatementCache -> (ByteString, StatementCache)+insert sql oids (StatementCache hashMap counter) = (remoteKey, newState)+  where+    remoteKey = fromString $ show $ newCounter+    newHashMap = HashMap.insert localKey remoteKey hashMap+    newCounter = counter + 1+    newState = StatementCache newHashMap newCounter+    localKey = LocalKey sql oids++-- | Pure reset operation+{-# INLINEABLE reset #-}+reset :: StatementCache -> StatementCache+reset _ = StatementCache HashMap.empty 0++-- |+-- Local statement key.+data LocalKey+  = LocalKey ByteString [Word32]+  deriving (Show, Eq)++instance Hashable LocalKey where+  {-# INLINE hashWithSalt #-}+  hashWithSalt salt (LocalKey template oids) =+    hashWithSalt (hashWithSalt salt template) oids
+ src/library-tests/Helpers/Adapters.hs view
@@ -0,0 +1,30 @@+module Helpers.Adapters+  ( adapters,+    byAdapter,+    hook,+  )+where++import Pqi qualified+import Pqi.Ffi qualified+import Pqi.Native qualified+import Prelude+import Test.Hspec++adapters :: [Pqi.Adapter]+adapters =+  [ Pqi.Ffi.adapter,+    Pqi.Native.adapter+  ]++-- | Run the given spec-building function once per available Pqi adapter,+-- nesting each run under a @describe@ named after the adapter.+byAdapter :: (Pqi.Adapter -> Spec) -> Spec+byAdapter f =+  for_ adapters \adapter ->+    describe (toList (Pqi.name adapter)) (f adapter)++hook :: SpecWith Pqi.Adapter -> Spec+hook hookedSpec =+  byAdapter \adapter ->+    mapSubject (const adapter) hookedSpec
src/library-tests/Helpers/Dsls/Execution.hs view
@@ -12,9 +12,9 @@ import Hasql.Session (Session) import Hasql.Session qualified as Session import Helpers.Dsls.Statement qualified as StatementDsl+import Prelude import System.Random.Stateful qualified as Random import TextBuilder qualified-import Prelude  sessionByParams ::   (StatementDsl.StatementModule params result) =>
src/library-tests/Helpers/Scripts.hs view
@@ -2,14 +2,15 @@  import Hasql.Connection qualified as Connection import Hasql.Connection.Settings qualified as Settings+import Pqi qualified+import Prelude import System.Random.Stateful qualified as Random import TextBuilder qualified-import Prelude  -- | -- Parameters provided by the scope.--- Host and port of a running isolated postgres server.-type ScopeParams = (Text, Word16)+-- Adapter, host and port of a running isolated postgres server.+type ScopeParams = (Pqi.Adapter, Text, Word16)  onPreparableConnection :: ScopeParams -> (Connection.Connection -> IO a) -> IO a onPreparableConnection = onConnection False@@ -18,7 +19,7 @@ onUnpreparableConnection = onConnection True  onConnection :: Bool -> ScopeParams -> (Connection.Connection -> IO a) -> IO a-onConnection unpreparable (host, port) =+onConnection unpreparable (adapter, host, port) =   bracket     ( do         let settings =@@ -29,7 +30,7 @@                   Settings.dbname "postgres",                   Settings.noPreparedStatements unpreparable                 ]-        res <- Connection.acquire settings+        res <- Connection.acquire adapter settings         case res of           Left err -> fail ("Connection failed: " <> show err)           Right conn -> pure conn
+ src/library-tests/Integration/Isolated/Connection/AcquireSpec.hs view
@@ -0,0 +1,220 @@+module Integration.Isolated.Connection.AcquireSpec (spec) where++import Hasql.Connection qualified+import Hasql.Connection qualified as Connection+import Hasql.Connection.Settings qualified as Settings+import Hasql.Errors qualified as Errors+import Pqi qualified+import Prelude+import Test.Hspec+import TestcontainersPostgresql qualified++spec :: SpecWith Pqi.Adapter+spec = do+  describe "By result" do+    describe "Left" do+      describe "Networking" do+        it "Fails on server missing" \adapter -> do+          let settings =+                Settings.hostAndPort "nopostgresql.net" 5432+          result <- Connection.acquire adapter settings+          case result of+            Right conn -> do+              Connection.release conn+              expectationFailure "Expected connection to fail with authentication error, but it succeeded"+            Left (Errors.NetworkingConnectionError _) ->+              pure ()+            Left err ->+              expectationFailure ("Expected NetworkingConnectionError, but got: " <> show err)++  describe "postgres:9" do+    it "Succeeds" \adapter -> do+      TestcontainersPostgresql.run+        TestcontainersPostgresql.Config+          { tagName = "postgres:9",+            auth = TestcontainersPostgresql.CredentialsAuth "postgres" "postgres",+            forwardLogs = False+          }+        \(host, port) -> do+          let settings =+                mconcat+                  [ Settings.hostAndPort host port,+                    Settings.user "postgres",+                    Settings.password "postgres",+                    Settings.dbname "postgres"+                  ]+          result <- Connection.acquire adapter settings+          case result of+            Right conn -> do+              Connection.release conn+            Left err -> do+              expectationFailure ("Expected connection to succeed, but it failed with error: " <> show err)++  describe "postgres:18" do+    it "Succeeds" \adapter -> do+      TestcontainersPostgresql.run+        TestcontainersPostgresql.Config+          { tagName = "postgres:18",+            auth = TestcontainersPostgresql.CredentialsAuth "postgres" "postgres",+            forwardLogs = False+          }+        \(host, port) -> do+          let settings =+                mconcat+                  [ Settings.hostAndPort host port,+                    Settings.user "postgres",+                    Settings.password "postgres",+                    Settings.dbname "postgres"+                  ]+          result <- Connection.acquire adapter settings+          case result of+            Right conn -> do+              Connection.release conn+            Left err -> do+              expectationFailure ("Expected connection to succeed, but it failed with error: " <> show err)++    it "Fails with authentication error on incorrect password" \adapter -> do+      TestcontainersPostgresql.run+        TestcontainersPostgresql.Config+          { tagName = "postgres:18",+            auth = TestcontainersPostgresql.CredentialsAuth "postgres" "postgres",+            forwardLogs = False+          }+        \(host, port) -> do+          let settings =+                mconcat+                  [ Settings.hostAndPort host port,+                    Settings.user "postgres",+                    Settings.password "",+                    Settings.dbname "postgres1"+                  ]+          result <- Connection.acquire adapter settings+          case result of+            Right conn -> do+              Connection.release conn+              expectationFailure "Expected connection to fail with authentication error, but it succeeded"+            Left (Errors.AuthenticationConnectionError _) ->+              pure ()+            Left err ->+              expectationFailure ("Expected AuthenticationConnectionError, but got: " <> show err)++    it "Fails with authentication error on incorrect user" \adapter -> do+      TestcontainersPostgresql.run+        TestcontainersPostgresql.Config+          { tagName = "postgres:18",+            auth = TestcontainersPostgresql.CredentialsAuth "postgres" "postgres",+            forwardLogs = False+          }+        \(host, port) -> do+          let settings =+                mconcat+                  [ Settings.hostAndPort host port,+                    Settings.user "postgres1",+                    Settings.password "",+                    Settings.dbname "postgres"+                  ]+          result <- Connection.acquire adapter settings+          case result of+            Right conn -> do+              Connection.release conn+              expectationFailure "Expected connection to fail with authentication error, but it succeeded"+            Left (Errors.AuthenticationConnectionError _) ->+              pure ()+            Left err ->+              expectationFailure ("Expected AuthenticationConnectionError, but got: " <> show err)++  describe "postgres:9" do+    byDistro "postgres:9"++  describe "postgres:18" do+    byDistro "postgres:18"++byDistro :: Text -> SpecWith Pqi.Adapter+byDistro tagName = do+  let itConnects :: Text -> Text -> SpecWith Pqi.Adapter+      itConnects username password =+        describe ("username: " <> toList username) do+          describe ("password: " <> toList password) do+            it "connects" \adapter -> do+              TestcontainersPostgresql.run+                TestcontainersPostgresql.Config+                  { tagName,+                    auth = TestcontainersPostgresql.CredentialsAuth username password,+                    forwardLogs = False+                  }+                ( \(host, port) -> do+                    result <-+                      Hasql.Connection.acquire+                        adapter+                        ( mconcat+                            [ Settings.hostAndPort host port,+                              Settings.user username,+                              Settings.password password+                            ]+                        )+                    case result of+                      Left err -> expectationFailure ("Connection failed: " <> show err <> ". Host: " <> show host <> ", port: " <> show port)+                      Right connection -> do+                        Hasql.Connection.release connection+                        pure ()+                )+   in do+        itConnects "user" "new password"+        itConnects "user" "new\\password"+        itConnects "user" "new'password"+        itConnects "new user" "password"++  describe "Connection errors" do+    describe "NetworkingConnectionError" do+      it "is reported for invalid host" \adapter -> do+        result <-+          Hasql.Connection.acquire+            adapter+            ( mconcat+                [ Settings.hostAndPort "nonexistent.invalid.host" 5432,+                  Settings.user "postgres",+                  Settings.password ""+                ]+            )+        case result of+          Left (Errors.NetworkingConnectionError _) -> pure ()+          Left err -> expectationFailure ("Expected NetworkingConnectionError, got: " <> show err)+          Right _conn -> expectationFailure "Expected connection to fail"++      it "is reported for connection refused" \adapter -> do+        result <-+          Hasql.Connection.acquire+            adapter+            ( mconcat+                [ Settings.hostAndPort "127.0.0.1" 1,+                  Settings.user "postgres",+                  Settings.password ""+                ]+            )+        case result of+          Left (Errors.NetworkingConnectionError _) -> pure ()+          Left err -> expectationFailure ("Expected NetworkingConnectionError, got: " <> show err)+          Right _conn -> expectationFailure "Expected connection to fail"++    describe "AuthenticationConnectionError" do+      it "is reported for invalid credentials" \adapter -> do+        TestcontainersPostgresql.run+          TestcontainersPostgresql.Config+            { tagName,+              auth = TestcontainersPostgresql.CredentialsAuth "password" "correctpassword",+              forwardLogs = False+            }+          \(host, port) -> do+            result <-+              Hasql.Connection.acquire+                adapter+                ( mconcat+                    [ Settings.hostAndPort host port,+                      Settings.user "incorrectuser",+                      Settings.password "incorrectpassword"+                    ]+                )+            case result of+              Left (Errors.AuthenticationConnectionError _) -> pure ()+              Left err -> expectationFailure ("Expected AuthenticationConnectionError, got: " <> show err)+              Right _conn -> expectationFailure "Expected connection to fail with authentication error"
+ src/library-tests/Integration/Sharing/Connection/Use/PipelineAbortedInterruptionCleanupSpec.hs view
@@ -0,0 +1,134 @@+module Integration.Sharing.Connection.Use.PipelineAbortedInterruptionCleanupSpec (spec) where++import Data.Text qualified as Text+import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Pipeline qualified as Pipeline+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++-- | A statement that sleeps for the given number of seconds and succeeds.+--+-- Used to widen the wall-clock window during which the client is blocked+-- waiting on the network/socket for a pipelined result, so that an+-- asynchronous interruption has a realistic chance of landing right around+-- the moment the *next* statement in the same pipeline fails.+sleepStatement :: Statement.Statement Double ()+sleepStatement =+  Statement.preparable+    "select pg_sleep($1)"+    (Encoders.param (Encoders.nonNullable Encoders.float8))+    Decoders.noResult++-- | A statement that is guaranteed to fail on the server.+failingStatement :: Statement.Statement () ()+failingStatement =+  Statement.preparable+    "select 1/0"+    Encoders.noParams+    Decoders.noResult++-- | A pipeline of two statements: the first sleeps and succeeds, the+-- second fails. Executing this via 'Session.pipeline' drives libpq's+-- pipeline status through: Off -> On -> (once the sleep result has been+-- received and the divide error has been processed) Aborted -> (normally)+-- Off again, via the exit sequence inside 'toPipelineIO'.+--+-- The bug under test concerns what happens if an asynchronous exception+-- interrupts execution during the narrow "Aborted" window: right after+-- libpq has registered the error result for the second statement (which+-- flips its internal pipeline status to `PipelineAborted`) but before the+-- driver has drained the trailing pipeline-sync marker and called+-- `exitPipelineMode`. That window is only a couple of FFI calls wide, so+-- reliably landing an async exception inside it requires many attempts+-- across a fine-grained sweep of interrupt delays (see 'spec' below).+--+-- Note: an earlier version of this test tried to widen the window by+-- appending many trivial "filler" statements after the failing one (on+-- the theory that draining their results would take measurably longer).+-- That approach reproduced failures reliably, but for the wrong reason:+-- `Comms.Session.drainResults` only drains one queued command's worth of+-- results per call, so a large backlog of undrained filler results made+-- `exitPipelineMode` fail with "cannot exit pipeline mode with uncollected+-- results" regardless of whether the `PipelineOn`/`PipelineAborted` bug+-- under test was present or fixed. That's a real, separate limitation of+-- `drainResults`, but not the bug this test is about, so the pipeline here+-- is kept to exactly two statements and 'attempt' below specifically+-- checks for the "not allowed in pipeline mode" signature (the one the+-- one-line `leavePipeline` fix actually addresses) rather than any+-- "Failed to clean up after interruption" message.+racingPipelineSession :: Double -> Session.Session ()+racingPipelineSession sleepSeconds =+  Session.pipeline do+    Pipeline.statement sleepSeconds sleepStatement+      *> Pipeline.statement () failingStatement++-- | Try once to reproduce the bug: acquire a fresh connection, race a+-- `timeout` against the pipelined session (sleep-then-fail) tuned to fire+-- right around the moment the pipeline transitions to the aborted state,+-- and report whether `Connection.use` came back with the specific driver+-- error that signals the `leavePipeline` bug: it only checks for+-- `PipelineOn`, so when the connection is genuinely `PipelineAborted` at+-- interruption time, cleanup skips leaving the pipeline and falls through+-- to `bringTransactionStatusToIdle`, which tries to send "ABORT" as a+-- serial command while still in pipeline mode -- something libpq flatly+-- refuses ("PQsendQuery not allowed in pipeline mode").+--+-- Note on why checking `Connection.use`'s own return value is enough: when+-- `timeout` throws its internal exception into the thread running+-- `Connection.use`, that exception is caught by `use`'s own+-- @try \@SomeException@. If the bug is NOT triggered, `use` cleans up+-- successfully and rethrows the very same timeout exception, so `timeout`+-- observes it and returns 'Nothing'. If the bug IS triggered, `use`+-- reports the cleanup failure as an ordinary `Left (DriverSessionError _)`+-- return value instead of rethrowing, so `timeout` observes a normal+-- return and reports 'Just (Left _)'.+attempt :: Scripts.ScopeParams -> Double -> Int -> IO (Maybe Text)+attempt config sleepSeconds delayMicros =+  Scripts.onPreparableConnection config \connection -> do+    result <- timeout delayMicros do+      Connection.use connection (racingPipelineSession sleepSeconds)+    pure case result of+      Just (Left err) ->+        let rendered = Text.pack (show err)+         in if "Failed to clean up after interruption"+              `Text.isInfixOf` rendered+              && "not allowed in pipeline mode"+              `Text.isInfixOf` rendered+              then Just rendered+              else Nothing+      Just (Right ()) -> Nothing+      Nothing -> Nothing++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Interruption of a pipeline while it is in the Aborted status" do+    it "Connection.use recovers cleanly instead of reporting a driver cleanup failure" \config -> do+      -- We sweep the timeout across a window that straddles the moment the+      -- sleep statement finishes and the failing statement's error result+      -- gets processed by libpq (which is when the pipeline status flips+      -- from `PipelineOn` to `PipelineAborted`). The genuinely vulnerable+      -- window is only a couple of FFI calls wide (nowhere near as wide as+      -- our timer granularity), so we compensate with a large number of+      -- attempts spread finely across the window and a fresh connection+      -- each time, rather than trying to widen the window itself.+      let sleepMicros = 20000 :: Int -- 20ms sleep statement duration+          sleepSeconds = fromIntegral sleepMicros / 1000000+          delays = [sleepMicros + step | step <- [(-3000), (-2900) .. 6000]]+          attemptsPerDelay = 15++      results <-+        sequence+          [ attempt config sleepSeconds d+          | d <- delays,+            _ <- [1 :: Int .. attemptsPerDelay]+          ]++      let reproductions = [msg | Just msg <- results]++      reproductions+        `shouldBe` []
+ src/library-tests/Integration/Sharing/Connection/UseSpec.hs view
@@ -0,0 +1,272 @@+module Integration.Sharing.Connection.UseSpec (spec) where++import Control.Concurrent+import Control.Exception+import Data.Either+import Data.IORef+import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Pipeline qualified as Pipeline+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Dsls.Execution qualified as Execution+import Helpers.Scripts qualified as Scripts+import Helpers.Statements.SelectOne qualified as Statements.SelectOne+import Helpers.Statements.SelectProvidedInt8 qualified as Statements.SelectProvidedInt8+import Helpers.Statements.Sleep qualified as Statements+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Transactions" do+    it "Do not cause \"in progress after error\"" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let sumStatement =+              Statement.preparable+                "select ($1 + $2)"+                ( mconcat+                    [ fst >$< Encoders.param (Encoders.nonNullable Encoders.int8),+                      snd >$< Encoders.param (Encoders.nonNullable Encoders.int8)+                    ]+                )+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))++        result <-+          Connection.use connection do+            Session.script "."++        result `shouldSatisfy` isLeft++        result <-+          Connection.use connection do+            Session.script "begin;"+            s <- Session.statement (1 :: Int64, 2 :: Int64) sumStatement+            Session.script "end;"+            return s++        result `shouldBe` Right (3 :: Int64)++  describe "Pipeline Mode" do+    it "Leaves the connection usable after timeout in pipeline" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let selectStatement =+              Statement.preparable+                "select $1::int"+                (Encoders.param (Encoders.nonNullable Encoders.int4))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))++        -- Timeout during a pipeline operation+        result <-+          timeout 50_000 do+            Connection.use connection+              $ Session.pipeline+              $ (,)+              <$> Pipeline.statement 42 selectStatement+              <*> Execution.pipelineByParams (Statements.Sleep 0.1)++        result `shouldBe` Nothing++        -- Try to use pipeline again after timeout cleanup+        -- This should work but fails with "connection not idle" without the fix+        result2 <-+          Connection.use connection+            $ Session.pipeline+            $ Pipeline.statement 99 selectStatement++        result2 `shouldBe` Right 99++  describe "Timing out" do+    describe "On a statement" do+      it "Leaves the connection usable" \config -> Scripts.onPreparableConnection config \connection -> do+        result <-+          timeout 50_000 do+            Connection.use connection do+              Execution.sessionByParams (Statements.Sleep 0.1)++        result `shouldBe` Nothing++        result <-+          Connection.use connection do+            Execution.sessionByParams Statements.SelectOne.SelectOne++        result `shouldBe` Right 1++    describe "On a transaction" do+      it "Leaves the connection usable" \config -> Scripts.onPreparableConnection config \connection -> do+        -- Start a transaction and timeout during it+        result <-+          timeout 50_000 do+            Connection.use connection do+              Session.script "begin;"+              Execution.sessionByParams (Statements.Sleep 0.1)+              Session.script "commit;"++        result `shouldBe` Nothing++        -- Connection should still be usable after timeout in transaction+        result <-+          Connection.use connection do+            Execution.sessionByParams Statements.SelectOne.SelectOne++        result `shouldBe` Right 1++      it "Lets us start another transaction" do+        let checkTransactionStatus =+              Statement.preparable+                "select case when pg_advisory_lock(1) is null then 0 else 1 end"+                mempty+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))+         in \config -> Scripts.onPreparableConnection config \connection -> do+              -- Timeout during a transaction+              result <-+                timeout 50_000 do+                  Connection.use connection do+                    Session.script "begin;"+                    Execution.sessionByParams (Statements.Sleep 0.1)++              result `shouldBe` Nothing++              -- Verify we can start a new transaction without "already in progress" error+              result <-+                Connection.use connection do+                  Session.script "begin;"+                  s <- Session.statement () checkTransactionStatus+                  Session.script "commit;"+                  return s++              result `shouldBe` Right 1++      it "Does not corrupt the prepared statement registry" do+        let returnIntStatement =+              Statement.preparable+                "select $1::int"+                (Encoders.param (Encoders.nonNullable Encoders.int4))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))+         in \config -> Scripts.onPreparableConnection config \connection -> do+              -- Use a prepared statement first+              result <-+                Connection.use connection do+                  Session.statement 42 returnIntStatement++              result `shouldBe` Right 42++              -- Timeout during transaction (causes connection reset)+              result <-+                timeout 50_000 do+                  Connection.use connection do+                    Session.script "begin;"+                    Execution.sessionByParams (Statements.Sleep 0.1)+                    Session.script "commit;"++              result `shouldBe` Nothing++              -- The prepared statement should work again without "does not exist" error+              result <-+                Connection.use connection do+                  Session.statement 99 returnIntStatement++              result `shouldBe` Right 99++  describe "Concurrency" do+    it "handles concurrent connections properly" \config -> do+      Scripts.onPreparableConnection config \connection1 -> do+        Scripts.onPreparableConnection config \connection2 -> do+          let selectSleep =+                Statement.preparable+                  "select pg_sleep($1)"+                  (Encoders.param (Encoders.nonNullable Encoders.float8))+                  Decoders.noResult++          beginVar <- newEmptyMVar+          finishVar <- newEmptyMVar++          _ <- forkIO do+            putMVar beginVar ()+            _ <- Connection.use connection1 (Session.statement (0.2 :: Double) selectSleep)+            void (tryPutMVar finishVar False)++          _ <- forkIO do+            takeMVar beginVar+            _ <- Connection.use connection2 (Session.statement (0.1 :: Double) selectSleep)+            void (tryPutMVar finishVar True)++          -- The second connection should finish first (True)+          result <- takeMVar finishVar+          result `shouldBe` True++    it "Connection remains usable after exception in non-idle state with concurrent threads" \config -> Scripts.onPreparableConnection config \connection -> do+      -- This test reproduces the bug fixed in commit 62ebef2.+      -- The bug was that when an exception occurred during a session,+      -- the connection state was put back into the MVar BEFORE resetting the connection.+      -- This created a race condition where another thread could grab the corrupted connection.++      -- We'll create a scenario where:+      -- 1. Thread A starts a session that will throw an exception+      -- 2. Thread B repeatedly tries to use the connection+      -- 3. The exception in Thread A should not corrupt the connection for Thread B++      -- Counter to track successful operations by Thread B+      successCount <- newIORef (0 :: Int)+      errorCount <- newIORef (0 :: Int)++      -- Barrier to synchronize threads+      startBarrier <- newEmptyMVar+      doneBarrier <- newEmptyMVar++      -- Thread A: Throws exceptions repeatedly+      _ <- forkIO do+        takeMVar startBarrier+        replicateM_ 10 do+          -- Use the connection and throw an exception during the session+          _ <- try @SomeException do+            Connection.use connection do+              -- Start a transaction to put connection in non-idle state+              Session.script "BEGIN"+              -- Throw an exception while in transaction (non-idle state)+              liftIO (throwIO (userError "Intentional exception"))+          threadDelay 1000 -- Small delay to allow interleaving+        putMVar doneBarrier ()++      -- Thread B: Tries to use connection concurrently+      _ <- forkIO do+        takeMVar startBarrier+        replicateM_ 20 do+          result <- Connection.use connection (Execution.sessionByParams (Statements.SelectProvidedInt8.SelectProvidedInt8 42))+          case result of+            Right 42 -> atomicModifyIORef' successCount (\n -> (n + 1, ()))+            _ -> atomicModifyIORef' errorCount (\n -> (n + 1, ()))+          threadDelay 500+        putMVar doneBarrier ()++      -- Start both threads+      putMVar startBarrier ()+      putMVar startBarrier ()++      -- Wait for both threads to complete with a timeout+      -- If the bug exists, threads may hang waiting for a corrupted connection+      result <- timeout (5 * 1000000) do+        -- 5 seconds timeout+        takeMVar doneBarrier+        takeMVar doneBarrier++      case result of+        Nothing -> do+          -- Test timed out - this indicates the bug is present+          expectationFailure "Test timed out waiting for threads to complete. This indicates the connection became deadlocked due to the race condition bug."+        Just () -> do+          -- Threads completed successfully+          -- Check results+          successes <- readIORef successCount+          errors <- readIORef errorCount++          -- Thread B should have succeeded at least some times+          -- If the bug exists, we'd expect Thread B to get errors due to corrupted connection state+          successes `shouldSatisfy` (> 0)++          errors `shouldBe` 0++          -- Verify connection is still usable after all this+          finalResult <- Connection.use connection (Execution.sessionByParams (Statements.SelectProvidedInt8.SelectProvidedInt8 99))+          finalResult `shouldBe` Right 99
+ src/library-tests/Integration/Sharing/Decoders/CitextSpec.hs view
@@ -0,0 +1,85 @@+module Integration.Sharing.Decoders.CitextSpec (spec) where++import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Citext Decoders" do+    it "decodes a citext value" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS citext"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          Session.statement ()+            $ Statement.preparable+              "select 'Hello World'::citext"+              mempty+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.citext)))+        result `shouldBe` Right "Hello World"++    it "decodes a citext value preserving case" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS citext"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          Session.statement ()+            $ Statement.preparable+              "select 'HeLLo WoRLd'::citext"+              mempty+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.citext)))+        result `shouldBe` Right "HeLLo WoRLd"++    it "decodes a nullable citext value" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS citext"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          Session.statement ()+            $ Statement.preparable+              "select null::citext"+              mempty+              (Decoders.singleRow (Decoders.column (Decoders.nullable Decoders.citext)))+        result `shouldBe` Right (Nothing :: Maybe Text)++    it "decodes citext case-insensitive comparison in SQL" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS citext"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          Session.statement ()+            $ Statement.preparable+              "select 'hello'::citext = 'HELLO'::citext"+              mempty+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True
+ src/library-tests/Integration/Sharing/Decoders/Composite/OidMismatchSpec.hs view
@@ -0,0 +1,165 @@+module Integration.Sharing.Decoders.Composite.OidMismatchSpec (spec) where++import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Errors qualified as Errors+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Composite field OID mismatch detection" do+    describe "Decoder field type mismatch" do+      it "detects when decoder expects int4 but actual field is int8" \config -> do+        typeName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create composite type with int8 field+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", typeName, " as (x int8)"])+                mempty+                Decoders.noResult+            -- Try to decode with int4 decoder+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select row(42) :: ", typeName])+                mempty+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            ( Decoders.composite+                                Nothing+                                typeName+                                -- Using int4 decoder for int8 field - should fail+                                (Decoders.field (Decoders.nonNullable Decoders.int4))+                            )+                        )+                    )+                )+          -- The error should indicate a decoding failure due to type mismatch+          case result of+            Left (Errors.StatementSessionError _ _ _ _ _ (Errors.RowStatementError _ (Errors.CellRowError _ _ (Errors.DeserializationCellError msg)))) -> do+              -- PostgreSQL binary decoder should detect the OID mismatch+              toList msg `shouldContain` "Unexpected OID"+            Left err ->+              expectationFailure ("Unexpected type of error: " <> show err)+            Right _ ->+              expectationFailure "Expected an error but got success"++      it "detects when decoder expects int8 but actual field is int4" \config -> do+        typeName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create composite type with int4 field+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", typeName, " as (x int4)"])+                mempty+                Decoders.noResult+            -- Try to decode with int8 decoder+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select row(42) :: ", typeName])+                mempty+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            ( Decoders.composite+                                Nothing+                                typeName+                                -- Using int8 decoder for int4 field - should fail+                                (Decoders.field (Decoders.nonNullable Decoders.int8))+                            )+                        )+                    )+                )+          -- The error should indicate a decoding failure due to type mismatch+          case result of+            Left (Errors.StatementSessionError _ _ _ _ _ (Errors.RowStatementError _ (Errors.CellRowError _ _ (Errors.DeserializationCellError msg)))) -> do+              -- PostgreSQL binary decoder should detect the OID mismatch+              toList msg `shouldContain` "Unexpected OID"+            Left err ->+              expectationFailure ("Unexpected type of error: " <> show err)+            Right _ ->+              expectationFailure "Expected an error but got success"++      it "detects when decoder expects text but actual field is int8" \config -> do+        typeName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create composite type with int8 field+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", typeName, " as (x int8)"])+                mempty+                Decoders.noResult+            -- Try to decode with text decoder+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select row(42) :: ", typeName])+                mempty+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            ( Decoders.composite+                                Nothing+                                typeName+                                -- Using text decoder for int8 field - should fail+                                (Decoders.field (Decoders.nonNullable Decoders.text))+                            )+                        )+                    )+                )+          -- The error should indicate a decoding failure due to type mismatch+          case result of+            Left (Errors.StatementSessionError _ _ _ _ _ (Errors.RowStatementError _ (Errors.CellRowError _ _ (Errors.DeserializationCellError _msg)))) -> do+              -- PostgreSQL binary decoder should detect the type mismatch+              pure ()+            Left err ->+              expectationFailure ("Unexpected type of error: " <> show err)+            Right _ ->+              expectationFailure "Expected an error but got success"++    describe "Multiple fields with mismatches" do+      it "detects mismatch in second field" \config -> do+        typeName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create composite type with int8, int4 fields+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", typeName, " as (a int8, b int4)"])+                mempty+                Decoders.noResult+            -- Try to decode with correct first field but wrong second field+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select row(1, 2) :: ", typeName])+                mempty+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            ( Decoders.composite+                                Nothing+                                typeName+                                ( (,)+                                    <$> Decoders.field (Decoders.nonNullable Decoders.int8)+                                    -- Using int8 decoder for int4 field - should fail+                                    <*> Decoders.field (Decoders.nonNullable Decoders.int8)+                                )+                            )+                        )+                    )+                )+          -- The error should indicate a decoding failure+          case result of+            Left (Errors.StatementSessionError _ _ _ _ _ (Errors.RowStatementError _ (Errors.CellRowError _ _ (Errors.DeserializationCellError _msg)))) -> do+              pure ()+            Left err ->+              expectationFailure ("Unexpected type of error: " <> show err)+            Right _ ->+              expectationFailure "Expected an error but got success"
+ src/library-tests/Integration/Sharing/Decoders/CompositeSpec.hs view
@@ -0,0 +1,777 @@+module Integration.Sharing.Decoders.CompositeSpec (spec) where++import Data.HashSet qualified as HashSet+import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Errors qualified as Errors+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Named Composite Decoders" do+    describe "Simple composites" do+      it "decodes a simple named composite from static SQL" \config -> do+        typeName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create composite type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", typeName, " as (x int8, y bool)"])+                mempty+                Decoders.noResult+            -- Test decoding from static value+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select (42, true) :: ", typeName])+                mempty+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            ( Decoders.composite+                                Nothing+                                typeName+                                ( (,)+                                    <$> Decoders.field (Decoders.nonNullable Decoders.int8)+                                    <*> Decoders.field (Decoders.nonNullable Decoders.bool)+                                )+                            )+                        )+                    )+                )+          result `shouldBe` Right (42 :: Int64, True)++      it "decodes a simple named composite with different values" \config -> do+        typeName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create composite type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", typeName, " as (a text, b int4)"])+                mempty+                Decoders.noResult+            -- Test decoding+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select ('hello', 123) :: ", typeName])+                mempty+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            ( Decoders.composite+                                Nothing+                                typeName+                                ( (,)+                                    <$> Decoders.field (Decoders.nonNullable Decoders.text)+                                    <*> Decoders.field (Decoders.nonNullable Decoders.int4)+                                )+                            )+                        )+                    )+                )+          result `shouldBe` Right ("hello", 123 :: Int32)++    describe "Nested composites" do+      it "decodes nested named composites from static SQL" \config -> do+        innerType <- Scripts.generateSymname+        outerType <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create inner composite type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", innerType, " as (x int8, y bool)"])+                mempty+                Decoders.noResult+            -- Create outer composite type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", outerType, " as (\"inner\" ", innerType, ", z text)"])+                mempty+                Decoders.noResult+            -- Test nested decoding+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select ((42, true), 'world') :: ", outerType])+                mempty+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            ( Decoders.composite+                                Nothing+                                outerType+                                ( (,)+                                    <$> Decoders.field+                                      ( Decoders.nonNullable+                                          ( Decoders.composite+                                              Nothing+                                              innerType+                                              ( (,)+                                                  <$> Decoders.field (Decoders.nonNullable Decoders.int8)+                                                  <*> Decoders.field (Decoders.nonNullable Decoders.bool)+                                              )+                                          )+                                      )+                                    <*> Decoders.field (Decoders.nonNullable Decoders.text)+                                )+                            )+                        )+                    )+                )+          result `shouldBe` Right ((42 :: Int64, True), "world")++      it "decodes deeply nested named composites" \config -> do+        type1 <- Scripts.generateSymname+        type2 <- Scripts.generateSymname+        type3 <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create level 1 composite+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", type1, " as (val int8)"])+                mempty+                Decoders.noResult+            -- Create level 2 composite+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", type2, " as (\"inner\" ", type1, ", flag bool)"])+                mempty+                Decoders.noResult+            -- Create level 3 composite+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", type3, " as (\"nested\" ", type2, ", name text)"])+                mempty+                Decoders.noResult+            -- Test deeply nested decoding+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select row (row (row (99), true), 'deep') :: ", type3])+                mempty+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            ( Decoders.composite+                                Nothing+                                type3+                                ( (,)+                                    <$> Decoders.field+                                      ( Decoders.nonNullable+                                          ( Decoders.composite+                                              Nothing+                                              type2+                                              ( (,)+                                                  <$> Decoders.field+                                                    ( Decoders.nonNullable+                                                        ( Decoders.composite+                                                            Nothing+                                                            type1+                                                            (Decoders.field (Decoders.nonNullable Decoders.int8))+                                                        )+                                                    )+                                                  <*> Decoders.field (Decoders.nonNullable Decoders.bool)+                                              )+                                          )+                                      )+                                    <*> Decoders.field (Decoders.nonNullable Decoders.text)+                                )+                            )+                        )+                    )+                )+          result `shouldBe` Right ((99 :: Int64, True), "deep")++    describe "Arrays of composites" do+      it "decodes arrays of primitives" \config -> do+        typeName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", typeName, " as (x int4[])"])+                mempty+                Decoders.noResult+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select row(array[1,2,3])", " :: ", typeName])+                mempty+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            ( Decoders.composite+                                Nothing+                                typeName+                                ( Decoders.field+                                    ( Decoders.nonNullable+                                        ( Decoders.array+                                            ( Decoders.dimension+                                                replicateM+                                                ( Decoders.element+                                                    (Decoders.nonNullable Decoders.int4)+                                                )+                                            )+                                        )+                                    )+                                )+                            )+                        )+                    )+                )+          result `shouldBe` Right [1, 2, 3]++      it "decodes arrays of named composites from static SQL" \config -> do+        typeName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create composite type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", typeName, " as (x int8, y bool)"])+                mempty+                Decoders.noResult+            -- Test array decoding+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select array[(1, true), (2, false), (3, true)] :: ", typeName, "[]"])+                mempty+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            ( Decoders.array+                                ( Decoders.dimension+                                    replicateM+                                    ( Decoders.element+                                        ( Decoders.nonNullable+                                            ( Decoders.composite+                                                Nothing+                                                typeName+                                                ( (,)+                                                    <$> Decoders.field (Decoders.nonNullable Decoders.int8)+                                                    <*> Decoders.field (Decoders.nonNullable Decoders.bool)+                                                )+                                            )+                                        )+                                    )+                                )+                            )+                        )+                    )+                )+          result `shouldBe` Right [(1 :: Int64, True), (2, False), (3, True)]++      it "decodes 2D arrays of named composites" \config -> do+        typeName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create composite type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", typeName, " as (val int4)"])+                mempty+                Decoders.noResult+            -- Test 2D array decoding+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select array[array[row (1), row (2)], array[row (3), row (4)]] :: ", typeName, "[][]"])+                mempty+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            ( Decoders.array+                                ( Decoders.dimension+                                    replicateM+                                    ( Decoders.dimension+                                        replicateM+                                        ( Decoders.element+                                            ( Decoders.nonNullable+                                                ( Decoders.composite+                                                    Nothing+                                                    typeName+                                                    (Decoders.field (Decoders.nonNullable Decoders.int4))+                                                )+                                            )+                                        )+                                    )+                                )+                            )+                        )+                    )+                )+          result `shouldBe` Right [[1 :: Int32, 2], [3, 4]]++    describe "Composites with array fields" do+      it "decodes a composite with an enum array field" \config -> do+        enumType <- Scripts.generateSymname+        compositeType <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create enum type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", enumType, " as enum ('red', 'green', 'blue')"])+                mempty+                Decoders.noResult+            -- Create composite type with enum array field+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", compositeType, " as (id int8, colors ", enumType, "[])"])+                mempty+                Decoders.noResult+            -- Test decoding composite with enum array field+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select (42, array['red', 'green', 'blue'] :: ", enumType, "[]) :: ", compositeType])+                mempty+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            ( Decoders.composite+                                Nothing+                                compositeType+                                ( (,)+                                    <$> Decoders.field (Decoders.nonNullable Decoders.int8)+                                    <*> Decoders.field+                                      ( Decoders.nonNullable+                                          ( Decoders.array+                                              ( Decoders.dimension+                                                  replicateM+                                                  ( Decoders.element+                                                      ( Decoders.nonNullable+                                                          ( Decoders.enum+                                                              Nothing+                                                              enumType+                                                              Just+                                                          )+                                                      )+                                                  )+                                              )+                                          )+                                      )+                                )+                            )+                        )+                    )+                )+          result `shouldBe` Right (42 :: Int64, ["red", "green", "blue"])++      it "decodes a composite with multiple enum array fields" \config -> do+        enum1 <- Scripts.generateSymname+        enum2 <- Scripts.generateSymname+        compositeType <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create first enum type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", enum1, " as enum ('small', 'medium', 'large')"])+                mempty+                Decoders.noResult+            -- Create second enum type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", enum2, " as enum ('low', 'high')"])+                mempty+                Decoders.noResult+            -- Create composite type with multiple enum array fields+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", compositeType, " as (sizes ", enum1, "[], priorities ", enum2, "[])"])+                mempty+                Decoders.noResult+            -- Test decoding composite with multiple enum array fields+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select (array['small', 'large'] :: ", enum1, "[], array['high', 'low'] :: ", enum2, "[]) :: ", compositeType])+                mempty+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            ( Decoders.composite+                                Nothing+                                compositeType+                                ( (,)+                                    <$> Decoders.field+                                      ( Decoders.nonNullable+                                          ( Decoders.array+                                              ( Decoders.dimension+                                                  replicateM+                                                  ( Decoders.element+                                                      ( Decoders.nonNullable+                                                          ( Decoders.enum+                                                              Nothing+                                                              enum1+                                                              Just+                                                          )+                                                      )+                                                  )+                                              )+                                          )+                                      )+                                    <*> Decoders.field+                                      ( Decoders.nonNullable+                                          ( Decoders.array+                                              ( Decoders.dimension+                                                  replicateM+                                                  ( Decoders.element+                                                      ( Decoders.nonNullable+                                                          ( Decoders.enum+                                                              Nothing+                                                              enum2+                                                              Just+                                                          )+                                                      )+                                                  )+                                              )+                                          )+                                      )+                                )+                            )+                        )+                    )+                )+          result `shouldBe` Right (["small", "large"], ["high", "low"])++      it "decodes a composite with mixed scalar and enum array fields" \config -> do+        enumType <- Scripts.generateSymname+        compositeType <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create enum type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", enumType, " as enum ('A', 'B', 'C')"])+                mempty+                Decoders.noResult+            -- Create composite type with mixed fields+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", compositeType, " as (name text, age int4, grades ", enumType, "[])"])+                mempty+                Decoders.noResult+            -- Test decoding composite with mixed fields+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select ('Alice', 25, array['A', 'B', 'A'] :: ", enumType, "[]) :: ", compositeType])+                mempty+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            ( Decoders.composite+                                Nothing+                                compositeType+                                ( do+                                    name <- Decoders.field (Decoders.nonNullable Decoders.text)+                                    age <- Decoders.field (Decoders.nonNullable Decoders.int4)+                                    grades <-+                                      Decoders.field+                                        ( Decoders.nonNullable+                                            ( Decoders.array+                                                ( Decoders.dimension+                                                    replicateM+                                                    ( Decoders.element+                                                        ( Decoders.nonNullable+                                                            ( Decoders.enum+                                                                Nothing+                                                                enumType+                                                                ( \case+                                                                    "A" -> Just 'A'+                                                                    "B" -> Just 'B'+                                                                    "C" -> Just 'C'+                                                                    _ -> Nothing+                                                                )+                                                            )+                                                        )+                                                    )+                                                )+                                            )+                                        )+                                    pure (name, age, grades)+                                )+                            )+                        )+                    )+                )+          result `shouldBe` Right ("Alice", 25 :: Int32, ['A', 'B', 'A'])++      it "decodes nested composite with enum array field" \config -> do+        enumType <- Scripts.generateSymname+        innerType <- Scripts.generateSymname+        outerType <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create enum type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", enumType, " as enum ('x', 'y', 'z')"])+                mempty+                Decoders.noResult+            -- Create inner composite type with enum array field+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", innerType, " as (values ", enumType, "[])"])+                mempty+                Decoders.noResult+            -- Create outer composite type containing the inner type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", outerType, " as (id int4, data ", innerType, ")"])+                mempty+                Decoders.noResult+            -- Test nested decoding+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select (100, row(array['x', 'y', 'z'] :: ", enumType, "[]) :: ", innerType, ") :: ", outerType])+                mempty+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            ( Decoders.composite+                                Nothing+                                outerType+                                ( (,)+                                    <$> Decoders.field (Decoders.nonNullable Decoders.int4)+                                    <*> Decoders.field+                                      ( Decoders.nonNullable+                                          ( Decoders.composite+                                              Nothing+                                              innerType+                                              ( Decoders.field+                                                  ( Decoders.nonNullable+                                                      ( Decoders.array+                                                          ( Decoders.dimension+                                                              replicateM+                                                              ( Decoders.element+                                                                  ( Decoders.nonNullable+                                                                      ( Decoders.enum+                                                                          Nothing+                                                                          enumType+                                                                          ( \case+                                                                              "x" -> Just 'x'+                                                                              "y" -> Just 'y'+                                                                              "z" -> Just 'z'+                                                                              _ -> Nothing+                                                                          )+                                                                      )+                                                                  )+                                                              )+                                                          )+                                                      )+                                                  )+                                              )+                                          )+                                      )+                                )+                            )+                        )+                    )+                )+          result `shouldBe` Right (100 :: Int32, ['x', 'y', 'z'])++      it "decodes a composite with 2D enum array field" \config -> do+        enumType <- Scripts.generateSymname+        compositeType <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create enum type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", enumType, " as enum ('0', '1')"])+                mempty+                Decoders.noResult+            -- Create composite type with 2D enum array field+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", compositeType, " as (matrix ", enumType, "[][])"])+                mempty+                Decoders.noResult+            -- Test decoding composite with 2D enum array field+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select row(array[array['0', '1'], array['1', '0']] :: ", enumType, "[][]) :: ", compositeType])+                mempty+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            ( Decoders.composite+                                Nothing+                                compositeType+                                ( Decoders.field+                                    ( Decoders.nonNullable+                                        ( Decoders.array+                                            ( Decoders.dimension+                                                replicateM+                                                ( Decoders.dimension+                                                    replicateM+                                                    ( Decoders.element+                                                        ( Decoders.nonNullable+                                                            ( Decoders.enum+                                                                Nothing+                                                                enumType+                                                                ( \case+                                                                    "0" -> Just (0 :: Int)+                                                                    "1" -> Just 1+                                                                    _ -> Nothing+                                                                )+                                                            )+                                                        )+                                                    )+                                                )+                                            )+                                        )+                                    )+                                )+                            )+                        )+                    )+                )+          result `shouldBe` Right [[0, 1], [1, 0]]++    describe "OID compatibility checking" do+      it "fails when decoder expects a composite but gets a different type" \config -> do+        typeName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create composite type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", typeName, " as (x int8, y bool)"])+                mempty+                Decoders.noResult+            -- Try to decode text as the composite type (should fail during deserialization)+            Session.statement ()+              $ Statement.preparable+                "select 'some text'::text"+                mempty+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            ( Decoders.composite+                                Nothing+                                typeName+                                ( (,)+                                    <$> Decoders.field (Decoders.nonNullable Decoders.int8)+                                    <*> Decoders.field (Decoders.nonNullable Decoders.bool)+                                )+                            )+                        )+                    )+                )+          -- Should fail with a cell error because text cannot be decoded as a composite+          case result of+            Left (Errors.StatementSessionError _ _ _ _ _ (Errors.UnexpectedColumnTypeStatementError 0 _ _)) ->+              pure ()+            Left err ->+              expectationFailure ("Unexpected type of error: " <> show err)+            Right _ ->+              expectationFailure "Expected an error but got success"++      it "fails when decoder expects one composite type but gets another" \config -> do+        type1 <- Scripts.generateSymname+        type2 <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create first composite type with two fields+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", type1, " as (x int8, y text)"])+                mempty+                Decoders.noResult+            -- Create second composite type with different structure+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", type2, " as (a bool)"])+                mempty+                Decoders.noResult+            -- Try to decode type2 value as type1 (should fail during deserialization)+            -- type2 has 1 field, type1 decoder expects 2 fields+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select row (true) :: ", type2])+                mempty+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            ( Decoders.composite+                                Nothing+                                type1+                                ( (,)+                                    <$> Decoders.field (Decoders.nonNullable Decoders.int8)+                                    <*> Decoders.field (Decoders.nonNullable Decoders.text)+                                )+                            )+                        )+                    )+                )+          -- Should fail with a cell error because the field count doesn't match+          case result of+            Left (Errors.StatementSessionError _ _ _ _ _ (Errors.UnexpectedColumnTypeStatementError 0 _ _)) ->+              pure ()+            Left err ->+              expectationFailure ("Unexpected type of error: " <> show err)+            Right _ ->+              expectationFailure "Expected an error but got success"++      it "correctly validates matching composite type OIDs" \config -> do+        typeName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create composite type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", typeName, " as (x int8, y bool)"])+                mempty+                Decoders.noResult+            -- Decode with correct type - should succeed+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select row (42, true) :: ", typeName])+                mempty+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            ( Decoders.composite+                                Nothing+                                typeName+                                ( (,)+                                    <$> Decoders.field (Decoders.nonNullable Decoders.int8)+                                    <*> Decoders.field (Decoders.nonNullable Decoders.bool)+                                )+                            )+                        )+                    )+                )+          result `shouldBe` Right (42 :: Int64, True)++  it "detects attempts to decode non-existent composite types" \config -> do+    Scripts.onPreparableConnection config \connection -> do+      result <- Connection.use connection do+        Session.statement ()+          $ Statement.preparable+            "select row(42, text 'test')"+            mempty+            ( Decoders.singleRow+                ( Decoders.column+                    ( Decoders.nonNullable+                        ( Decoders.composite+                            Nothing+                            "nonexistent_composite_type"+                            ( (,)+                                <$> Decoders.field (Decoders.nonNullable Decoders.int4)+                                <*> Decoders.field (Decoders.nonNullable Decoders.text)+                            )+                        )+                    )+                )+            )++      case result of+        Left (Errors.MissingTypesSessionError missingTypes) ->+          missingTypes `shouldBe` HashSet.fromList [(Nothing, "nonexistent_composite_type")]+        _ ->+          expectationFailure ("Unexpected result: " <> show result)
+ src/library-tests/Integration/Sharing/Decoders/CustomSpec.hs view
@@ -0,0 +1,286 @@+module Integration.Sharing.Decoders.CustomSpec (spec) where++import Data.ByteString qualified as ByteString+import Data.HashSet qualified as HashSet+import Data.Text.Encoding (encodeUtf8)+import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Errors qualified as Errors+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Basic custom decoders" do+    it "decodes a custom type with runtime OID lookup" \config -> do+      enumName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create enum type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", enumName, " as enum ('alpha', 'beta', 'gamma')"])+              mempty+              Decoders.noResult+          -- Test custom decoder with runtime OID lookup+          Session.statement ()+            $ Statement.preparable+              (mconcat ["select 'beta' :: ", enumName])+              mempty+              ( Decoders.singleRow+                  ( Decoders.column+                      ( Decoders.nonNullable+                          ( Decoders.custom+                              Nothing+                              enumName+                              Nothing+                              []+                              (\_ bytes -> Right (ByteString.length bytes, bytes))+                          )+                      )+                  )+              )+        -- Should successfully decode with length and bytes+        case result of+          Right (len, bytes) -> do+            len `shouldBe` 4+            bytes `shouldBe` "beta"+          Left err ->+            expectationFailure ("Unexpected error: " <> show err)++    it "decodes a custom type with static OIDs" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Test custom decoder with static OIDs for int4 (type OID 23, array OID 1007)+          Session.statement ()+            $ Statement.preparable+              "select 42::int4"+              mempty+              ( Decoders.singleRow+                  ( Decoders.column+                      ( Decoders.nonNullable+                          ( Decoders.custom+                              Nothing+                              "int4"+                              (Just (23, 1007))+                              []+                              (\_ bytes -> Right (ByteString.length bytes))+                          )+                      )+                  )+              )+        -- int4 is encoded in 4 bytes+        result `shouldBe` Right 4++    it "decodes with dependent type OID requests" \config -> do+      enumName <- Scripts.generateSymname+      compositeName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create enum type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", enumName, " as enum ('small', 'large')"])+              mempty+              Decoders.noResult+          -- Create composite type with the enum+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", compositeName, " as (size ", enumName, ", count int4)"])+              mempty+              Decoders.noResult+          -- Test custom decoder requesting OIDs of dependent types+          Session.statement ()+            $ Statement.preparable+              (mconcat ["select ('large', 5) :: ", compositeName])+              mempty+              ( Decoders.singleRow+                  ( Decoders.column+                      ( Decoders.nonNullable+                          ( Decoders.custom+                              Nothing+                              compositeName+                              Nothing+                              [(Nothing, enumName), (Nothing, "int4")]+                              ( \lookupOid bytes -> do+                                  let (enumOidScalar, _enumOidArray) = lookupOid (Nothing, enumName)+                                      (int4OidScalar, _int4OidArray) = lookupOid (Nothing, "int4")+                                  -- Verify we got valid OIDs+                                  if enumOidScalar > 0 && int4OidScalar > 0+                                    then Right (enumOidScalar, int4OidScalar, ByteString.length bytes)+                                    else Left "Failed to resolve OIDs"+                              )+                          )+                      )+                  )+              )+        -- Should successfully get OIDs and byte length+        case result of+          Right (enumOid, int4Oid, len) -> do+            enumOid `shouldSatisfy` (> 0)+            int4Oid `shouldBe` 23+            len `shouldSatisfy` (> 0)+          Left err ->+            expectationFailure ("Unexpected error: " <> show err)++  describe "Error handling" do+    it "detects missing types in custom decoders" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          Session.statement ()+            $ Statement.preparable+              "select 'test'::text"+              mempty+              ( Decoders.singleRow+                  ( Decoders.column+                      ( Decoders.nonNullable+                          ( Decoders.custom+                              Nothing+                              "nonexistent_custom_type"+                              Nothing+                              []+                              (\_ bytes -> Right bytes)+                          )+                      )+                  )+              )++        case result of+          Left (Errors.MissingTypesSessionError missingTypes) ->+            missingTypes `shouldBe` HashSet.fromList [(Nothing, "nonexistent_custom_type")]+          _ ->+            expectationFailure ("Unexpected result: " <> show result)++    it "detects missing dependent types in custom decoders" \config -> do+      customTypeName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create a custom type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", customTypeName, " as (id int4)"])+              mempty+              Decoders.noResult+          -- Try to decode it but request a non-existent dependent type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["select (42) :: ", customTypeName])+              mempty+              ( Decoders.singleRow+                  ( Decoders.column+                      ( Decoders.nonNullable+                          ( Decoders.custom+                              Nothing+                              customTypeName+                              Nothing+                              [(Nothing, "nonexistent_dependency")]+                              (\_ bytes -> Right bytes)+                          )+                      )+                  )+              )++        case result of+          Left (Errors.MissingTypesSessionError missingTypes) ->+            missingTypes `shouldBe` HashSet.fromList [(Nothing, "nonexistent_dependency")]+          _ ->+            expectationFailure ("Unexpected result: " <> show result)++    it "handles decoding errors in custom decoders" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          Session.statement ()+            $ Statement.preparable+              "select 42::int4"+              mempty+              ( Decoders.singleRow+                  ( Decoders.column+                      ( Decoders.nonNullable+                          ( Decoders.custom+                              Nothing+                              "int4"+                              (Just (23, 1007))+                              []+                              (\_ _ -> Left "Custom decoding error")+                          )+                      )+                  )+              )++        case result of+          Left (Errors.StatementSessionError {}) -> pure ()+          _ ->+            expectationFailure "Expected statement error"++  describe "Roundtrip tests" do+    it "roundtrips custom encoded and decoded values" \config -> do+      enumName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create enum type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", enumName, " as enum ('one', 'two', 'three')"])+              mempty+              Decoders.noResult+          -- Test roundtrip using custom encoder and decoder+          Session.statement "two"+            $ Statement.preparable+              (mconcat ["select $1 :: ", enumName])+              (Encoders.param (Encoders.nonNullable (Encoders.custom Nothing enumName Nothing [] (\_ val -> encodeUtf8 val) id)))+              ( Decoders.singleRow+                  ( Decoders.column+                      ( Decoders.nonNullable+                          ( Decoders.custom+                              Nothing+                              enumName+                              Nothing+                              []+                              (\_ bytes -> Right bytes)+                          )+                      )+                  )+              )+        result `shouldBe` Right "two"++  describe "Schema-qualified types" do+    it "decodes custom types from specific schemas" \config -> do+      schemaName <- Scripts.generateSymname+      typeName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create schema+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create schema ", schemaName])+              mempty+              Decoders.noResult+          -- Create enum type in that schema+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", schemaName, ".", typeName, " as enum ('x', 'y')"])+              mempty+              Decoders.noResult+          -- Test custom decoder with schema qualification+          Session.statement ()+            $ Statement.preparable+              (mconcat ["select 'y' :: ", schemaName, ".", typeName])+              mempty+              ( Decoders.singleRow+                  ( Decoders.column+                      ( Decoders.nonNullable+                          ( Decoders.custom+                              (Just schemaName)+                              typeName+                              Nothing+                              []+                              (\_ bytes -> Right bytes)+                          )+                      )+                  )+              )+        result `shouldBe` Right "y"
+ src/library-tests/Integration/Sharing/Decoders/DomainSpec.hs view
@@ -0,0 +1,194 @@+module Integration.Sharing.Decoders.DomainSpec (spec) where++import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Domain type decoding" do+    describe "Simple scalar domains" do+      it "decodes a domain based on int8 using int8 codec" \config -> do+        domainName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create domain type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create domain ", domainName, " as int8"])+                mempty+                Decoders.noResult+            -- Test decoding from static value+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select 42 :: ", domainName])+                mempty+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))+          result `shouldBe` Right (42 :: Int64)++      it "decodes a domain based on text using text codec" \config -> do+        domainName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create domain type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create domain ", domainName, " as text"])+                mempty+                Decoders.noResult+            -- Test decoding from static value+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select 'hello' :: ", domainName])+                mempty+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)))+          result `shouldBe` Right "hello"++      it "decodes a domain based on bool using bool codec" \config -> do+        domainName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create domain type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create domain ", domainName, " as bool"])+                mempty+                Decoders.noResult+            -- Test decoding from static value+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select true :: ", domainName])+                mempty+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+          result `shouldBe` Right True++      it "roundtrips a domain based on numeric" \config -> do+        domainName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create domain type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create domain ", domainName, " as numeric"])+                mempty+                Decoders.noResult+            -- Test roundtrip+            Session.statement (123.456 :: Scientific)+              $ Statement.preparable+                (mconcat ["select $1 :: ", domainName])+                (Encoders.param (Encoders.nonNullable Encoders.numeric))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.numeric)))+          result `shouldBe` Right (123.456 :: Scientific)++    describe "Domain with constraints" do+      it "decodes domain values that satisfy constraints" \config -> do+        domainName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create domain type with constraint+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create domain ", domainName, " as int8 check (value > 0)"])+                mempty+                Decoders.noResult+            -- Decode value that satisfies constraint+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select 42 :: ", domainName])+                mempty+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))+          result `shouldBe` Right (42 :: Int64)++    describe "Domain type cast compatibility for composite usage" do+      it "decodes domain value cast to base type from composite field" \config -> do+        domainName <- Scripts.generateSymname+        compositeName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create domain type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create domain ", domainName, " as int8"])+                mempty+                Decoders.noResult+            -- Create composite type with domain field+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", compositeName, " as (x ", domainName, ", y bool)"])+                mempty+                Decoders.noResult+            -- Extract and cast domain field to base type for decoding+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select ((42 :: ", domainName, ") :: int8)"])+                mempty+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))+          result `shouldBe` Right (42 :: Int64)++    describe "Domain type cast compatibility for array usage" do+      it "decodes array cast from domain array to base type array" \config -> do+        domainName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create domain type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create domain ", domainName, " as int8"])+                mempty+                Decoders.noResult+            -- Decode base type array+            Session.statement ()+              $ Statement.preparable+                "select ARRAY[1,2,3] :: int8[]"+                mempty+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.listArray (Decoders.nonNullable Decoders.int8)))))+          result `shouldBe` Right ([1, 2, 3] :: [Int64])++      it "roundtrips array using base type codec" \config -> do+        domainName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create domain type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create domain ", domainName, " as text"])+                mempty+                Decoders.noResult+            -- Test roundtrip using base type codec+            Session.statement (["a", "b", "c"] :: [Text])+              $ Statement.preparable+                "select $1 :: text[]"+                ( Encoders.param+                    ( Encoders.nonNullable+                        (Encoders.foldableArray (Encoders.nonNullable Encoders.text))+                    )+                )+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.listArray (Decoders.nonNullable Decoders.text)))))+          result `shouldBe` Right (["a", "b", "c"] :: [Text])++      it "decodes base type array that can work with domain arrays via cast" \config -> do+        domainName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create domain type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create domain ", domainName, " as int8"])+                mempty+                Decoders.noResult+            -- Demonstrate that base codec works for arrays+            Session.statement ([10, 20, 30] :: [Int64])+              $ Statement.preparable+                "select $1 :: int8[]"+                ( Encoders.param+                    ( Encoders.nonNullable+                        (Encoders.foldableArray (Encoders.nonNullable Encoders.int8))+                    )+                )+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.listArray (Decoders.nonNullable Decoders.int8)))))+          result `shouldBe` Right ([10, 20, 30] :: [Int64])
+ src/library-tests/Integration/Sharing/Decoders/EnumSpec.hs view
@@ -0,0 +1,302 @@+module Integration.Sharing.Decoders.EnumSpec (spec) where++import Data.HashSet qualified as HashSet+import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Errors qualified as Errors+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Simple enums" do+    it "decodes a simple named enum from static SQL" \config -> do+      enumName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create enum type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", enumName, " as enum ('sad', 'ok', 'happy')"])+              mempty+              Decoders.noResult+          -- Test decoding from static value+          Session.statement ()+            $ Statement.preparable+              (mconcat ["select 'happy' :: ", enumName])+              mempty+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id)))))+        result `shouldBe` Right "happy"++    it "decodes different enum values" \config -> do+      enumName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create enum type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", enumName, " as enum ('alpha', 'beta', 'gamma')"])+              mempty+              Decoders.noResult+          -- Test decoding multiple values+          r1 <-+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select 'alpha' :: ", enumName])+                mempty+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id)))))+          r2 <-+            Session.statement ()+              $ Statement.preparable+                (mconcat ["select 'gamma' :: ", enumName])+                mempty+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id)))))+          return (r1, r2)+        result `shouldBe` Right ("alpha", "gamma")++  describe "Enums in composites" do+    it "decodes enums nested in named composites from static SQL" \config -> do+      enumName <- Scripts.generateSymname+      compositeName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create enum type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", enumName, " as enum ('red', 'green', 'blue')"])+              mempty+              Decoders.noResult+          -- Create composite type with enum+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", compositeName, " as (id int8, color ", enumName, ")"])+              mempty+              Decoders.noResult+          -- Test decoding+          Session.statement ()+            $ Statement.preparable+              (mconcat ["select (42, 'green') :: ", compositeName])+              mempty+              ( Decoders.singleRow+                  ( Decoders.column+                      ( Decoders.nonNullable+                          ( Decoders.composite+                              Nothing+                              compositeName+                              ( (,)+                                  <$> Decoders.field (Decoders.nonNullable Decoders.int8)+                                  <*> Decoders.field (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id)))+                              )+                          )+                      )+                  )+              )+        result `shouldBe` Right (42 :: Int64, "green")++    it "decodes multiple levels of nesting with enums" \config -> do+      enumName <- Scripts.generateSymname+      innerType <- Scripts.generateSymname+      outerType <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create enum type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", enumName, " as enum ('small', 'medium', 'large')"])+              mempty+              Decoders.noResult+          -- Create inner composite with enum+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", innerType, " as (size ", enumName, ", count int4)"])+              mempty+              Decoders.noResult+          -- Create outer composite+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", outerType, " as (\"inner\" ", innerType, ", name text)"])+              mempty+              Decoders.noResult+          -- Test decoding+          Session.statement ()+            $ Statement.preparable+              (mconcat ["select (('large', 5), 'test') :: ", outerType])+              mempty+              ( Decoders.singleRow+                  ( Decoders.column+                      ( Decoders.nonNullable+                          ( Decoders.composite+                              Nothing+                              outerType+                              ( (,)+                                  <$> Decoders.field+                                    ( Decoders.nonNullable+                                        ( Decoders.composite+                                            Nothing+                                            innerType+                                            ( (,)+                                                <$> Decoders.field (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id)))+                                                <*> Decoders.field (Decoders.nonNullable Decoders.int4)+                                            )+                                        )+                                    )+                                  <*> Decoders.field (Decoders.nonNullable Decoders.text)+                              )+                          )+                      )+                  )+              )+        result `shouldBe` Right (("large", 5 :: Int32), "test")++  describe "Arrays of enums" do+    it "decodes arrays of named enums from static SQL" \config -> do+      enumName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create enum type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", enumName, " as enum ('first', 'second', 'third')"])+              mempty+              Decoders.noResult+          -- Test array decoding+          Session.statement ()+            $ Statement.preparable+              (mconcat ["select array['first', 'third', 'second'] :: ", enumName, "[]"])+              mempty+              ( Decoders.singleRow+                  ( Decoders.column+                      ( Decoders.nonNullable+                          ( Decoders.array+                              ( Decoders.dimension+                                  replicateM+                                  (Decoders.element (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id))))+                              )+                          )+                      )+                  )+              )+        result `shouldBe` Right ["first", "third", "second"]++    it "decodes 2D arrays of named enums" \config -> do+      enumName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create enum type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", enumName, " as enum ('a', 'b', 'c')"])+              mempty+              Decoders.noResult+          -- Test 2D array decoding+          Session.statement ()+            $ Statement.preparable+              (mconcat ["select array[array['a', 'b'], array['c', 'a']] :: ", enumName, "[][]"])+              mempty+              ( Decoders.singleRow+                  ( Decoders.column+                      ( Decoders.nonNullable+                          ( Decoders.array+                              ( Decoders.dimension+                                  replicateM+                                  ( Decoders.dimension+                                      replicateM+                                      (Decoders.element (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id))))+                                  )+                              )+                          )+                      )+                  )+              )+        result `shouldBe` Right [["a", "b"], ["c", "a"]]++    it "decodes arrays of composites containing enums" \config -> do+      enumName <- Scripts.generateSymname+      compositeName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create enum type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", enumName, " as enum ('low', 'high')"])+              mempty+              Decoders.noResult+          -- Create composite type with enum+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", compositeName, " as (priority ", enumName, ", id int4)"])+              mempty+              Decoders.noResult+          -- Test decoding array of composites with enums+          Session.statement ()+            $ Statement.preparable+              (mconcat ["select array[('high', 1), ('low', 2)] :: ", compositeName, "[]"])+              mempty+              ( Decoders.singleRow+                  ( Decoders.column+                      ( Decoders.nonNullable+                          ( Decoders.array+                              ( Decoders.dimension+                                  replicateM+                                  ( Decoders.element+                                      ( Decoders.nonNullable+                                          ( Decoders.composite+                                              Nothing+                                              compositeName+                                              ( (,)+                                                  <$> Decoders.field (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id)))+                                                  <*> Decoders.field (Decoders.nonNullable Decoders.int4)+                                              )+                                          )+                                      )+                                  )+                              )+                          )+                      )+                  )+              )+        result `shouldBe` Right [("high", 1 :: Int32), ("low", 2)]++  it "detects attempts to decode non-existent enum types" \config -> do+    Scripts.onPreparableConnection config \connection -> do+      result <- Connection.use connection do+        Session.statement ()+          $ Statement.preparable+            "select 'value'::text"+            mempty+            (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.enum Nothing "nonexistent_enum_type" (Just . id)))))++      case result of+        Left (Errors.MissingTypesSessionError missingTypes) ->+          missingTypes `shouldBe` HashSet.fromList [(Nothing, "nonexistent_enum_type")]+        _ ->+          expectationFailure ("Unexpected result: " <> show result)++  it "detects attempts to decode arrays of non-existent enum types" \config -> do+    Scripts.onPreparableConnection config \connection -> do+      result <- Connection.use connection do+        Session.statement ()+          $ Statement.preparable+            "select array['a', 'b']::text[]"+            mempty+            ( Decoders.singleRow+                ( Decoders.column+                    ( Decoders.nonNullable+                        ( Decoders.array+                            ( Decoders.dimension+                                replicateM+                                (Decoders.element (Decoders.nonNullable (Decoders.enum Nothing "nonexistent_array_enum" (Just . id))))+                            )+                        )+                    )+                )+            )++      case result of+        Left (Errors.MissingTypesSessionError missingTypes) ->+          missingTypes `shouldBe` HashSet.fromList [(Nothing, "nonexistent_array_enum")]+        _ ->+          expectationFailure ("Unexpected result: " <> show result)
+ src/library-tests/Integration/Sharing/Decoders/Float8Spec.hs view
@@ -0,0 +1,27 @@+module Integration.Sharing.Decoders.Float8Spec (spec) where++import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  it "decodes static value properly" \config -> do+    Scripts.onPreparableConnection config \connection -> do+      let statement =+            Statement.preparable+              "select 3.14 :: float8"+              mempty+              ( Decoders.singleRow+                  ( Decoders.column+                      ( Decoders.nonNullable+                          Decoders.float8+                      )+                  )+              )+      result <- Connection.use connection (Session.statement () statement)+      result `shouldBe` Right 3.14
+ src/library-tests/Integration/Sharing/Decoders/HstoreSpec.hs view
@@ -0,0 +1,114 @@+module Integration.Sharing.Decoders.HstoreSpec (spec) where++import Data.HashMap.Strict qualified as HashMap+import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Hstore Decoders" do+    it "decodes empty hstore" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Enable hstore extension (unprepared), ignore if already exists+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS hstore"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          -- Test decoding empty hstore+          Session.statement ()+            $ Statement.preparable+              "select ''::hstore"+              Encoders.noParams+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.hstore (\n f -> replicateM n f >>= pure . HashMap.fromList)))))+        result `shouldBe` Right (HashMap.empty :: HashMap.HashMap Text (Maybe Text))++    it "decodes hstore with single key-value pair" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Enable hstore extension (unprepared), ignore if already exists+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS hstore"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          -- Test decoding single key-value pair+          Session.statement ()+            $ Statement.preparable+              "select 'key => value'::hstore"+              Encoders.noParams+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.hstore (\n f -> replicateM n f >>= pure . HashMap.fromList)))))+        result `shouldBe` Right (HashMap.fromList [("key", Just "value")] :: HashMap.HashMap Text (Maybe Text))++    it "decodes hstore with multiple key-value pairs" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Enable hstore extension (unprepared), ignore if already exists+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS hstore"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          -- Test decoding multiple key-value pairs+          Session.statement ()+            $ Statement.preparable+              "select 'a => 1, b => 2, c => 3'::hstore"+              Encoders.noParams+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.hstore (\n f -> replicateM n f >>= pure . HashMap.fromList)))))+        result `shouldBe` Right (HashMap.fromList [("a", Just "1"), ("b", Just "2"), ("c", Just "3")] :: HashMap.HashMap Text (Maybe Text))++    it "decodes hstore with null values" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Enable hstore extension (unprepared), ignore if already exists+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS hstore"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          -- Test decoding hstore with null values+          Session.statement ()+            $ Statement.preparable+              "select 'key1 => value1, key2 => NULL, key3 => value3'::hstore"+              Encoders.noParams+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.hstore (\n f -> replicateM n f >>= pure . HashMap.fromList)))))+        result `shouldBe` Right (HashMap.fromList [("key1", Just "value1"), ("key2", Nothing), ("key3", Just "value3")] :: HashMap.HashMap Text (Maybe Text))++    it "decodes hstore with special characters" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Enable hstore extension (unprepared), ignore if already exists+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS hstore"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          -- Test decoding hstore with special characters+          Session.statement ()+            $ Statement.preparable+              "select '\"key with spaces\" => \"value with quotes\"'::hstore"+              Encoders.noParams+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.hstore (\n f -> replicateM n f >>= pure . HashMap.fromList)))))+        result `shouldBe` Right (HashMap.fromList [("key with spaces", Just "value with quotes")] :: HashMap.HashMap Text (Maybe Text))
+ src/library-tests/Integration/Sharing/Decoders/InetSpec.hs view
@@ -0,0 +1,72 @@+module Integration.Sharing.Decoders.InetSpec (spec) where++import Data.IP (IPv4, IPv6)+import Data.IP qualified as IP+import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "INET Decoders" do+    it "decodes IPv4 address" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select '192.168.1.1/32'::inet"+                Encoders.noParams+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.inet)))+        result <- Connection.use connection (Session.statement () statement)+        let expectedAddr = read "192.168.1.1" :: IPv4+            expectedRange = IP.makeAddrRange expectedAddr 32+        result `shouldBe` Right (IP.IPv4Range expectedRange)++    it "decodes IPv4 CIDR" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select '10.0.0.0/8'::inet"+                Encoders.noParams+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.inet)))+        result <- Connection.use connection (Session.statement () statement)+        let expectedAddr = read "10.0.0.0" :: IPv4+            expectedRange = IP.makeAddrRange expectedAddr 8+        result `shouldBe` Right (IP.IPv4Range expectedRange)++    it "decodes IPv6 address" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select '::1/128'::inet"+                Encoders.noParams+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.inet)))+        result <- Connection.use connection (Session.statement () statement)+        let expectedAddr = read "::1" :: IPv6+            expectedRange = IP.makeAddrRange expectedAddr 128+        result `shouldBe` Right (IP.IPv6Range expectedRange)++  describe "MACADDR Decoders" do+    it "decodes MAC address" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select '08:00:2b:01:02:03'::macaddr"+                Encoders.noParams+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.macaddr)))+        result <- Connection.use connection (Session.statement () statement)+        result `shouldBe` Right (0x08, 0x00, 0x2b, 0x01, 0x02, 0x03)++    it "decodes another MAC address format" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select 'ff:ff:ff:ff:ff:ff'::macaddr"+                Encoders.noParams+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.macaddr)))+        result <- Connection.use connection (Session.statement () statement)+        result `shouldBe` Right (0xff, 0xff, 0xff, 0xff, 0xff, 0xff)
+ src/library-tests/Integration/Sharing/Decoders/IntervalSpec.hs view
@@ -0,0 +1,23 @@+module Integration.Sharing.Decoders.IntervalSpec (spec) where++import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Interval Decoders" do+    it "decodes intervals correctly" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select interval '10 seconds'"+                Encoders.noParams+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.interval)))+        result <- Connection.use connection (Session.statement () statement)+        result `shouldBe` Right (10 :: DiffTime)
+ src/library-tests/Integration/Sharing/Decoders/JsonSpec.hs view
@@ -0,0 +1,85 @@+module Integration.Sharing.Decoders.JsonSpec (spec) where++import Data.Aeson qualified as Aeson+import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "JSON Decoders" do+    it "decodes JSON null" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select 'null'::json"+                Encoders.noParams+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.json)))+        result <- Connection.use connection (Session.statement () statement)+        result `shouldBe` Right Aeson.Null++    it "decodes JSON number" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select '42'::json"+                Encoders.noParams+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.json)))+        result <- Connection.use connection (Session.statement () statement)+        result `shouldBe` Right (Aeson.Number 42)++    it "decodes JSON string" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select '\"hello\"'::json"+                Encoders.noParams+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.json)))+        result <- Connection.use connection (Session.statement () statement)+        result `shouldBe` Right (Aeson.String "hello")++    it "decodes JSON array" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select '[1,2,3]'::json"+                Encoders.noParams+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.json)))+        result <- Connection.use connection (Session.statement () statement)+        result `shouldBe` Right (Aeson.Array (fromList [Aeson.Number 1, Aeson.Number 2, Aeson.Number 3]))++    it "decodes JSON object" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select '{\"name\":\"John\",\"age\":30}'::json"+                Encoders.noParams+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.json)))+        result <- Connection.use connection (Session.statement () statement)+        result `shouldBe` Right (Aeson.object [("name", Aeson.String "John"), ("age", Aeson.Number 30)])++  describe "JSONB Decoders" do+    it "decodes JSONB object" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select '{\"key\":\"value\"}'::jsonb"+                Encoders.noParams+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.jsonb)))+        result <- Connection.use connection (Session.statement () statement)+        result `shouldBe` Right (Aeson.object [("key", Aeson.String "value")])++    it "decodes JSONB array" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select '[true, false]'::jsonb"+                Encoders.noParams+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.jsonb)))+        result <- Connection.use connection (Session.statement () statement)+        result `shouldBe` Right (Aeson.Array (fromList [Aeson.Bool True, Aeson.Bool False]))
+ src/library-tests/Integration/Sharing/Decoders/RecordSpec.hs view
@@ -0,0 +1,259 @@+module Integration.Sharing.Decoders.RecordSpec (spec) where++import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Unnamed Composite Decoders" do+    describe "Simple composites" do+      it "decodes a simple unnamed composite from static SQL" \config -> do+        Scripts.onPreparableConnection config \connection -> do+          let statement =+                Statement.preparable+                  "select (1, true)"+                  mempty+                  ( Decoders.singleRow+                      ( Decoders.column+                          ( Decoders.nonNullable+                              ( Decoders.record+                                  ( (,)+                                      <$> Decoders.field (Decoders.nonNullable Decoders.int4)+                                      <*> Decoders.field (Decoders.nonNullable Decoders.bool)+                                  )+                              )+                          )+                      )+                  )+          result <- Connection.use connection (Session.statement () statement)+          result `shouldBe` Right (1, True)++      it "decodes unnamed composites with different types" \config -> do+        Scripts.onPreparableConnection config \connection -> do+          let statement =+                Statement.preparable+                  "select (text 'hello', 123)"+                  mempty+                  ( Decoders.singleRow+                      ( Decoders.column+                          ( Decoders.nonNullable+                              ( Decoders.record+                                  ( (,)+                                      <$> Decoders.field (Decoders.nonNullable Decoders.text)+                                      <*> Decoders.field (Decoders.nonNullable Decoders.int4)+                                  )+                              )+                          )+                      )+                  )+          result <- Connection.use connection (Session.statement () statement)+          result `shouldBe` Right ("hello", 123 :: Int32)++      it "decodes unnamed composites with three fields" \config -> do+        Scripts.onPreparableConnection config \connection -> do+          let statement =+                Statement.preparable+                  "select (42, text 'test', 3.14 :: float8)"+                  mempty+                  ( Decoders.singleRow+                      ( Decoders.column+                          ( Decoders.nonNullable+                              ( Decoders.record+                                  ( (,,)+                                      <$> Decoders.field (Decoders.nonNullable Decoders.int4)+                                      <*> Decoders.field (Decoders.nonNullable Decoders.text)+                                      <*> Decoders.field (Decoders.nonNullable Decoders.float8)+                                  )+                              )+                          )+                      )+                  )+          result <- Connection.use connection (Session.statement () statement)+          result `shouldBe` Right (42, "test", 3.14 :: Double)++    describe "Nested composites" do+      it "decodes nested unnamed composites from static SQL" \config -> do+        Scripts.onPreparableConnection config \connection -> do+          let statement =+                Statement.preparable+                  "select ((1, true), (text 'hello', 3))"+                  mempty+                  ( Decoders.singleRow+                      ( Decoders.column+                          ( Decoders.nonNullable+                              ( Decoders.record+                                  ( (,)+                                      <$> Decoders.field+                                        ( Decoders.nonNullable+                                            ( Decoders.record+                                                ( (,)+                                                    <$> Decoders.field (Decoders.nonNullable Decoders.int4)+                                                    <*> Decoders.field (Decoders.nonNullable Decoders.bool)+                                                )+                                            )+                                        )+                                      <*> Decoders.field+                                        ( Decoders.nonNullable+                                            ( Decoders.record+                                                ( (,)+                                                    <$> Decoders.field (Decoders.nonNullable Decoders.text)+                                                    <*> Decoders.field (Decoders.nonNullable Decoders.int4)+                                                )+                                            )+                                        )+                                  )+                              )+                          )+                      )+                  )+          result <- Connection.use connection (Session.statement () statement)+          result `shouldBe` Right ((1, True), ("hello", 3))++      it "decodes deeply nested unnamed composites" \config -> do+        Scripts.onPreparableConnection config \connection -> do+          let statement =+                Statement.preparable+                  "select ((row (99), (true, text 'test')), text 'outer')"+                  mempty+                  ( Decoders.singleRow+                      ( Decoders.column+                          ( Decoders.nonNullable+                              ( Decoders.record+                                  ( (,)+                                      <$> Decoders.field+                                        ( Decoders.nonNullable+                                            ( Decoders.record+                                                ( (,)+                                                    <$> Decoders.field+                                                      ( Decoders.nonNullable+                                                          ( Decoders.record+                                                              (Decoders.field (Decoders.nonNullable Decoders.int4))+                                                          )+                                                      )+                                                    <*> Decoders.field+                                                      ( Decoders.nonNullable+                                                          ( Decoders.record+                                                              ( (,)+                                                                  <$> Decoders.field (Decoders.nonNullable Decoders.bool)+                                                                  <*> Decoders.field (Decoders.nonNullable Decoders.text)+                                                              )+                                                          )+                                                      )+                                                )+                                            )+                                        )+                                      <*> Decoders.field (Decoders.nonNullable Decoders.text)+                                  )+                              )+                          )+                      )+                  )+          result <- Connection.use connection (Session.statement () statement)+          result `shouldBe` Right ((99, (True, "test")), "outer")++    describe "Arrays of composites" do+      it "decodes arrays of unnamed composites from static SQL" \config -> do+        Scripts.onPreparableConnection config \connection -> do+          let statement =+                Statement.preparable+                  "select array[(1, true), (2, false), (3, true)]"+                  mempty+                  ( Decoders.singleRow+                      ( Decoders.column+                          ( Decoders.nonNullable+                              ( Decoders.array+                                  ( Decoders.dimension+                                      replicateM+                                      ( Decoders.element+                                          ( Decoders.nonNullable+                                              ( Decoders.record+                                                  ( (,)+                                                      <$> Decoders.field (Decoders.nonNullable Decoders.int4)+                                                      <*> Decoders.field (Decoders.nonNullable Decoders.bool)+                                                  )+                                              )+                                          )+                                      )+                                  )+                              )+                          )+                      )+                  )+          result <- Connection.use connection (Session.statement () statement)+          result `shouldBe` Right [(1, True), (2, False), (3, True)]++      it "decodes 2D arrays of unnamed composites" \config -> do+        Scripts.onPreparableConnection config \connection -> do+          let statement =+                Statement.preparable+                  "select array[array[(1, text 'a'), (2, text 'b')], array[(3, text 'c'), (4, text 'd')]]"+                  mempty+                  ( Decoders.singleRow+                      ( Decoders.column+                          ( Decoders.nonNullable+                              ( Decoders.array+                                  ( Decoders.dimension+                                      replicateM+                                      ( Decoders.dimension+                                          replicateM+                                          ( Decoders.element+                                              ( Decoders.nonNullable+                                                  ( Decoders.record+                                                      ( (,)+                                                          <$> Decoders.field (Decoders.nonNullable Decoders.int4)+                                                          <*> Decoders.field (Decoders.nonNullable Decoders.text)+                                                      )+                                                  )+                                              )+                                          )+                                      )+                                  )+                              )+                          )+                      )+                  )+          result <- Connection.use connection (Session.statement () statement)+          result `shouldBe` Right [[(1 :: Int32, "a"), (2, "b")], [(3, "c"), (4, "d")]]++      it "decodes arrays of nested unnamed composites" \config -> do+        Scripts.onPreparableConnection config \connection -> do+          let statement =+                Statement.preparable+                  "select array[((1, true), text 'x'), ((2, false), text 'y')]"+                  mempty+                  ( Decoders.singleRow+                      ( Decoders.column+                          ( Decoders.nonNullable+                              ( Decoders.array+                                  ( Decoders.dimension+                                      replicateM+                                      ( Decoders.element+                                          ( Decoders.nonNullable+                                              ( Decoders.record+                                                  ( (,)+                                                      <$> Decoders.field+                                                        ( Decoders.nonNullable+                                                            ( Decoders.record+                                                                ( (,)+                                                                    <$> Decoders.field (Decoders.nonNullable Decoders.int4)+                                                                    <*> Decoders.field (Decoders.nonNullable Decoders.bool)+                                                                )+                                                            )+                                                        )+                                                      <*> Decoders.field (Decoders.nonNullable Decoders.text)+                                                  )+                                              )+                                          )+                                      )+                                  )+                              )+                          )+                      )+                  )+          result <- Connection.use connection (Session.statement () statement)+          result `shouldBe` Right [((1, True), "x"), ((2, False), "y")]
+ src/library-tests/Integration/Sharing/Decoders/UuidSpec.hs view
@@ -0,0 +1,36 @@+module Integration.Sharing.Decoders.UuidSpec (spec) where++import Data.UUID qualified as UUID+import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "UUID Decoders" do+    it "decodes UUID from static value" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select '550e8400-e29b-41d4-a716-446655440000'::uuid"+                Encoders.noParams+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.uuid)))+        result <- Connection.use connection (Session.statement () statement)+        case UUID.fromString "550e8400-e29b-41d4-a716-446655440000" of+          Just expectedUuid -> result `shouldBe` Right expectedUuid+          Nothing -> expectationFailure "Failed to parse expected UUID"++    it "decodes nil UUID" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select '00000000-0000-0000-0000-000000000000'::uuid"+                Encoders.noParams+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.uuid)))+        result <- Connection.use connection (Session.statement () statement)+        result `shouldBe` Right UUID.nil
+ src/library-tests/Integration/Sharing/Encoders/ArraySpec.hs view
@@ -0,0 +1,40 @@+module Integration.Sharing.Encoders.ArraySpec (spec) where++import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude hiding (assert)+import Test.Hspec+import Test.QuickCheck+import Test.QuickCheck.Instances ()+import Test.QuickCheck.Monadic (assert, monadicIO, pre, run)++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Array Encoders" do+    describe "1D arrays" do+      it "roundtrips 1D arrays" \config -> property $ \(values :: [Int64]) -> monadicIO $ do+        let statement =+              Statement.preparable+                "select $1"+                (Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8))))))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.array (Decoders.dimension replicateM (Decoders.element (Decoders.nonNullable Decoders.int8)))))))+        result <- run $ Scripts.onPreparableConnection config \connection ->+          Connection.use connection (Session.statement values statement)+        assert $ result == Right values++    describe "2D arrays" do+      it "roundtrips 2D arrays" \config -> property $ \(values :: [Int64]) -> monadicIO $ do+        pre (not (null values))+        let input = replicate 3 values+        let statement =+              Statement.preparable+                "select $1"+                (Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8)))))))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.array (Decoders.dimension replicateM (Decoders.dimension replicateM (Decoders.element (Decoders.nonNullable Decoders.int8))))))))+        result <- run $ Scripts.onPreparableConnection config \connection ->+          Connection.use connection (Session.statement input statement)+        assert $ result == Right input
+ src/library-tests/Integration/Sharing/Encoders/CitextSpec.hs view
@@ -0,0 +1,67 @@+module Integration.Sharing.Encoders.CitextSpec (spec) where++import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Citext Encoders" do+    it "encodes a citext value and compares with static value" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS citext"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          Session.statement "hello"+            $ Statement.preparable+              "select $1 = 'hello'"+              (Encoders.param (Encoders.nonNullable Encoders.citext))+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True++    it "encodes a citext value with case-insensitive comparison" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS citext"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          Session.statement "Hello"+            $ Statement.preparable+              "select $1 = 'hello'"+              (Encoders.param (Encoders.nonNullable Encoders.citext))+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True++    it "roundtrips a citext value" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS citext"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          Session.statement "Hello World"+            $ Statement.preparable+              "select $1"+              (Encoders.param (Encoders.nonNullable Encoders.citext))+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.citext)))+        result `shouldBe` Right "Hello World"
+ src/library-tests/Integration/Sharing/Encoders/Composite/OidMismatchSpec.hs view
@@ -0,0 +1,193 @@+module Integration.Sharing.Encoders.Composite.OidMismatchSpec (spec) where++import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Errors qualified as Errors+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Composite field OID mismatch detection" do+    describe "Encoder field type mismatch" do+      it "detects when encoder uses int4 but actual field is int8" \config -> do+        typeName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create composite type with int8 field+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", typeName, " as (x int8)"])+                mempty+                Decoders.noResult+            -- Try to encode with int4 encoder to int8 field+            Session.statement (42 :: Int32)+              $ Statement.preparable+                (mconcat ["select $1 :: ", typeName])+                ( Encoders.param+                    ( Encoders.nonNullable+                        ( Encoders.composite+                            Nothing+                            typeName+                            -- Using int4 encoder for int8 field - should fail+                            (Encoders.field (Encoders.nonNullable Encoders.int4))+                        )+                    )+                )+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            (Decoders.composite Nothing typeName (Decoders.field (Decoders.nonNullable Decoders.int8)))+                        )+                    )+                )+          -- The error should indicate a type mismatch from the server+          case result of+            Left (Errors.StatementSessionError _ _ _ _ _ (Errors.ServerStatementError (Errors.ServerError code _msg _detail _hint _pos))) -> do+              -- PostgreSQL should reject the mismatched types+              -- Error code 42804 is "datatype_mismatch"+              code `shouldSatisfy` (\c -> c == "42804" || c == "42P01" || c == "22P02")+            Left err ->+              expectationFailure ("Unexpected type of error: " <> show err)+            Right _ ->+              expectationFailure "Expected an error but got success"++      it "detects when encoder uses int8 but actual field is int4" \config -> do+        typeName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create composite type with int4 field+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", typeName, " as (x int4)"])+                mempty+                Decoders.noResult+            -- Try to encode with int8 encoder to int4 field+            Session.statement (42 :: Int64)+              $ Statement.preparable+                (mconcat ["select $1 :: ", typeName])+                ( Encoders.param+                    ( Encoders.nonNullable+                        ( Encoders.composite+                            Nothing+                            typeName+                            -- Using int8 encoder for int4 field - should fail+                            (Encoders.field (Encoders.nonNullable Encoders.int8))+                        )+                    )+                )+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            (Decoders.composite Nothing typeName (Decoders.field (Decoders.nonNullable Decoders.int4)))+                        )+                    )+                )+          -- The error should indicate a type mismatch from the server+          case result of+            Left (Errors.StatementSessionError _ _ _ _ _ (Errors.ServerStatementError (Errors.ServerError code _msg _detail _hint _pos))) -> do+              -- PostgreSQL should reject the mismatched types+              -- Error code 42804 is "datatype_mismatch"+              code `shouldSatisfy` (\c -> c == "42804" || c == "42P01" || c == "22P02")+            Left err ->+              expectationFailure ("Unexpected type of error: " <> show err)+            Right _ ->+              expectationFailure "Expected an error but got success"++      it "detects when encoder uses text but actual field is int8" \config -> do+        typeName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create composite type with int8 field+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", typeName, " as (x int8)"])+                mempty+                Decoders.noResult+            -- Try to encode with text encoder to int8 field+            Session.statement ("hello" :: Text)+              $ Statement.preparable+                (mconcat ["select $1 :: ", typeName])+                ( Encoders.param+                    ( Encoders.nonNullable+                        ( Encoders.composite+                            Nothing+                            typeName+                            -- Using text encoder for int8 field - should fail+                            (Encoders.field (Encoders.nonNullable Encoders.text))+                        )+                    )+                )+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            (Decoders.composite Nothing typeName (Decoders.field (Decoders.nonNullable Decoders.int8)))+                        )+                    )+                )+          -- The error should indicate a type mismatch from the server+          case result of+            Left (Errors.StatementSessionError _ _ _ _ _ (Errors.ServerStatementError (Errors.ServerError code _msg _detail _hint _pos))) -> do+              -- PostgreSQL should reject the mismatched types+              code `shouldSatisfy` (\c -> c == "42804" || c == "42P01" || c == "22P02")+            Left err ->+              expectationFailure ("Unexpected type of error: " <> show err)+            Right _ ->+              expectationFailure "Expected an error but got success"++    describe "Multiple fields with mismatches" do+      it "detects mismatch in second field" \config -> do+        typeName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create composite type with int8, int4 fields+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create type ", typeName, " as (a int8, b int4)"])+                mempty+                Decoders.noResult+            -- Try to encode with correct first field but wrong second field+            Session.statement (1 :: Int64, 2 :: Int64)+              $ Statement.preparable+                (mconcat ["select $1 :: ", typeName])+                ( Encoders.param+                    ( Encoders.nonNullable+                        ( Encoders.composite+                            Nothing+                            typeName+                            ( divide+                                (\(a, b) -> (a, b))+                                (Encoders.field (Encoders.nonNullable Encoders.int8))+                                -- Using int8 encoder for int4 field - should fail+                                (Encoders.field (Encoders.nonNullable Encoders.int8))+                            )+                        )+                    )+                )+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            ( Decoders.composite+                                Nothing+                                typeName+                                ( (,)+                                    <$> Decoders.field (Decoders.nonNullable Decoders.int8)+                                    <*> Decoders.field (Decoders.nonNullable Decoders.int4)+                                )+                            )+                        )+                    )+                )+          -- The error should indicate a type mismatch from the server+          case result of+            Left (Errors.StatementSessionError _ _ _ _ _ (Errors.ServerStatementError (Errors.ServerError code _msg _detail _hint _pos))) -> do+              -- PostgreSQL should reject the mismatched types+              code `shouldSatisfy` (\c -> c == "42804" || c == "42P01" || c == "22P02")+            Left err ->+              expectationFailure ("Unexpected type of error: " <> show err)+            Right _ ->+              expectationFailure "Expected an error but got success"
+ src/library-tests/Integration/Sharing/Encoders/CompositeSpec.hs view
@@ -0,0 +1,807 @@+module Integration.Sharing.Encoders.CompositeSpec (spec) where++import Data.HashSet qualified as HashSet+import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Errors qualified as Errors+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Simple composites" do+    it "encodes a simple named composite and compares with static value" \config -> do+      typeName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create composite type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", typeName, " as (x int8, y bool)"])+              mempty+              Decoders.noResult+          -- Test encoding by comparing with static value+          Session.statement (42 :: Int64, True)+            $ Statement.preparable+              (mconcat ["select ($1 :: ", typeName, ") = (42, true) :: ", typeName])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.composite+                          Nothing+                          typeName+                          ( divide+                              (\(a, b) -> (a, b))+                              (Encoders.field (Encoders.nonNullable Encoders.int8))+                              (Encoders.field (Encoders.nonNullable Encoders.bool))+                          )+                      )+                  )+              )+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True++    it "encodes and roundtrips a simple named composite" \config -> do+      typeName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create composite type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", typeName, " as (x int8, y bool)"])+              mempty+              Decoders.noResult+          -- Test roundtrip+          Session.statement (42 :: Int64, True)+            $ Statement.preparable+              (mconcat ["select $1 :: ", typeName])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.composite+                          Nothing+                          typeName+                          ( divide+                              (\(a, b) -> (a, b))+                              (Encoders.field (Encoders.nonNullable Encoders.int8))+                              (Encoders.field (Encoders.nonNullable Encoders.bool))+                          )+                      )+                  )+              )+              ( Decoders.singleRow+                  ( Decoders.column+                      ( Decoders.nonNullable+                          ( Decoders.composite+                              Nothing+                              typeName+                              ( (,)+                                  <$> Decoders.field (Decoders.nonNullable Decoders.int8)+                                  <*> Decoders.field (Decoders.nonNullable Decoders.bool)+                              )+                          )+                      )+                  )+              )+        result `shouldBe` Right (42 :: Int64, True)++  describe "Nested composites" do+    it "encodes nested named composites" \config -> do+      innerType <- Scripts.generateSymname+      outerType <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create inner composite type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", innerType, " as (x int8, y bool)"])+              mempty+              Decoders.noResult+          -- Create outer composite type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", outerType, " as (\"inner\" ", innerType, ", z text)"])+              mempty+              Decoders.noResult+          -- Test nested encoding+          Session.statement ((42 :: Int64, True), "hello")+            $ Statement.preparable+              (mconcat ["select ($1 :: ", outerType, ") = ((42, true), 'hello') :: ", outerType])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.composite+                          Nothing+                          outerType+                          ( divide+                              (\(inner, z) -> (inner, z))+                              ( Encoders.field+                                  ( Encoders.nonNullable+                                      ( Encoders.composite+                                          Nothing+                                          innerType+                                          ( divide+                                              (\(a, b) -> (a, b))+                                              (Encoders.field (Encoders.nonNullable Encoders.int8))+                                              (Encoders.field (Encoders.nonNullable Encoders.bool))+                                          )+                                      )+                                  )+                              )+                              (Encoders.field (Encoders.nonNullable Encoders.text))+                          )+                      )+                  )+              )+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True++    it "roundtrips nested named composites" \config -> do+      innerType <- Scripts.generateSymname+      outerType <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create inner composite type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", innerType, " as (x int8, y bool)"])+              mempty+              Decoders.noResult+          -- Create outer composite type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", outerType, " as (\"inner\" ", innerType, ", z text)"])+              mempty+              Decoders.noResult+          -- Test roundtrip+          Session.statement ((42 :: Int64, True), "hello")+            $ Statement.preparable+              (mconcat ["select $1 :: ", outerType])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.composite+                          Nothing+                          outerType+                          ( divide+                              (\(inner, z) -> (inner, z))+                              ( Encoders.field+                                  ( Encoders.nonNullable+                                      ( Encoders.composite+                                          Nothing+                                          innerType+                                          ( divide+                                              (\(a, b) -> (a, b))+                                              (Encoders.field (Encoders.nonNullable Encoders.int8))+                                              (Encoders.field (Encoders.nonNullable Encoders.bool))+                                          )+                                      )+                                  )+                              )+                              (Encoders.field (Encoders.nonNullable Encoders.text))+                          )+                      )+                  )+              )+              ( Decoders.singleRow+                  ( Decoders.column+                      ( Decoders.nonNullable+                          ( Decoders.composite+                              Nothing+                              outerType+                              ( (,)+                                  <$> Decoders.field+                                    ( Decoders.nonNullable+                                        ( Decoders.composite+                                            Nothing+                                            innerType+                                            ( (,)+                                                <$> Decoders.field (Decoders.nonNullable Decoders.int8)+                                                <*> Decoders.field (Decoders.nonNullable Decoders.bool)+                                            )+                                        )+                                    )+                                  <*> Decoders.field (Decoders.nonNullable Decoders.text)+                              )+                          )+                      )+                  )+              )+        result `shouldBe` Right ((42 :: Int64, True), "hello")++  describe "Arrays of composites" do+    it "encodes arrays of named composites" \config -> do+      typeName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create composite type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", typeName, " as (x int8, y bool)"])+              mempty+              Decoders.noResult+          -- Test array encoding+          Session.statement [(1 :: Int64, True), (2, False), (3, True)]+            $ Statement.preparable+              (mconcat ["select $1 = array[(1, true), (2, false), (3, true)] :: ", typeName, "[]"])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.array+                          ( Encoders.dimension+                              foldl'+                              ( Encoders.element+                                  ( Encoders.nonNullable+                                      ( Encoders.composite+                                          Nothing+                                          typeName+                                          ( divide+                                              (\(a, b) -> (a, b))+                                              (Encoders.field (Encoders.nonNullable Encoders.int8))+                                              (Encoders.field (Encoders.nonNullable Encoders.bool))+                                          )+                                      )+                                  )+                              )+                          )+                      )+                  )+              )+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True++    it "roundtrips arrays of named composites" \config -> do+      typeName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create composite type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", typeName, " as (x int8, y bool)"])+              mempty+              Decoders.noResult+          -- Test roundtrip+          Session.statement [(1 :: Int64, True), (2, False), (3, True)]+            $ Statement.preparable+              (mconcat ["select $1 :: ", typeName, "[]"])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.array+                          ( Encoders.dimension+                              foldl'+                              ( Encoders.element+                                  ( Encoders.nonNullable+                                      ( Encoders.composite+                                          Nothing+                                          typeName+                                          ( divide+                                              (\(a, b) -> (a, b))+                                              (Encoders.field (Encoders.nonNullable Encoders.int8))+                                              (Encoders.field (Encoders.nonNullable Encoders.bool))+                                          )+                                      )+                                  )+                              )+                          )+                      )+                  )+              )+              ( Decoders.singleRow+                  ( Decoders.column+                      ( Decoders.nonNullable+                          ( Decoders.array+                              ( Decoders.dimension+                                  replicateM+                                  ( Decoders.element+                                      ( Decoders.nonNullable+                                          ( Decoders.composite+                                              Nothing+                                              typeName+                                              ( (,)+                                                  <$> Decoders.field (Decoders.nonNullable Decoders.int8)+                                                  <*> Decoders.field (Decoders.nonNullable Decoders.bool)+                                              )+                                          )+                                      )+                                  )+                              )+                          )+                      )+                  )+              )+        result `shouldBe` Right [(1 :: Int64, True), (2, False), (3, True)]++  describe "OID lookup verification" do+    it "requests OID for named composites (verified by successful execution)" \config -> do+      -- This test verifies that OID lookup happens by ensuring a named composite+      -- type works correctly - if OID lookup didn't happen, the statement would fail+      typeName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create composite type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", typeName, " as (value int8)"])+              mempty+              Decoders.noResult+          -- Use named composite - this requires OID lookup to succeed+          Session.statement (100 :: Int64)+            $ Statement.preparable+              (mconcat ["select $1 :: ", typeName])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.composite+                          Nothing+                          typeName+                          (Encoders.field (Encoders.nonNullable Encoders.int8))+                      )+                  )+              )+              ( Decoders.singleRow+                  ( Decoders.column+                      ( Decoders.nonNullable+                          (Decoders.composite Nothing typeName (Decoders.field (Decoders.nonNullable Decoders.int8)))+                      )+                  )+              )+        result `shouldBe` Right (100 :: Int64)++    it "correctly tracks unknown types for nested composites with built-in field types" \config -> do+      -- This test reproduces the bug where unknownTypes were incorrectly tracked.+      -- The bug: when a field had a known elementOid (like int8), it was incorrectly+      -- added to unknownTypes. When elementOid was Nothing (custom types), it wasn't added.+      -- This caused nested composites with built-in types to fail OID lookup.+      --+      -- Specifically: When using a named composite as a field in another composite,+      -- the inner composite type needs OID lookup (it's custom), but its int8 field doesn't.+      -- The bug would cause int8 to be requested for OID lookup (wasteful but harmless)+      -- and fail to request OID lookup for the inner composite type (causing failure).+      innerType <- Scripts.generateSymname+      outerType <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create inner composite with a built-in type field+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", innerType, " as (value int8)"])+              mempty+              Decoders.noResult+          -- Create outer composite containing the inner composite+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", outerType, " as (\"inner\" ", innerType, ")"])+              mempty+              Decoders.noResult+          -- With the bug: innerType wouldn't be in the OID cache because+          -- field (with Nothing elementOid) didn't add it to unknownTypes.+          -- Instead, int8 (with Just elementOid) was being added (incorrectly).+          -- This would cause the encoder to use OID 0 for innerType, causing an error.+          Session.statement (42 :: Int64)+            $ Statement.preparable+              (mconcat ["select ($1 :: ", outerType, ").inner.value"])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.composite+                          Nothing+                          outerType+                          ( Encoders.field+                              ( Encoders.nonNullable+                                  ( Encoders.composite+                                      Nothing+                                      innerType+                                      (Encoders.field (Encoders.nonNullable Encoders.int8))+                                  )+                              )+                          )+                      )+                  )+              )+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))+        result `shouldBe` Right (42 :: Int64)++  describe "OID compatibility checking" do+    it "validates that encoder uses correct composite type OID" \config -> do+      -- This test ensures that when encoding a composite type, the correct OID is used.+      -- If the OID lookup fails or returns wrong OID, the statement should fail.+      typeName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create composite type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", typeName, " as (x int8, y bool)"])+              mempty+              Decoders.noResult+          -- Encode and verify - the DB will validate the OID is correct+          Session.statement (42 :: Int64, True)+            $ Statement.preparable+              (mconcat ["select ($1 :: ", typeName, ") = row (42, true) :: ", typeName])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.composite+                          Nothing+                          typeName+                          ( divide+                              (\(a, b) -> (a, b))+                              (Encoders.field (Encoders.nonNullable Encoders.int8))+                              (Encoders.field (Encoders.nonNullable Encoders.bool))+                          )+                      )+                  )+              )+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True++    it "validates OID lookup for nested composite types during encoding" \config -> do+      -- This test ensures OID lookup works correctly for nested composites+      innerType <- Scripts.generateSymname+      outerType <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create inner composite type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", innerType, " as (value int8)"])+              mempty+              Decoders.noResult+          -- Create outer composite type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", outerType, " as (\"nested\" ", innerType, ", flag bool)"])+              mempty+              Decoders.noResult+          -- Encode nested composite - both type OIDs must be looked up correctly+          Session.statement (99 :: Int64, True)+            $ Statement.preparable+              (mconcat ["select ($1 :: ", outerType, ") = row (row (99), true) :: ", outerType])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.composite+                          Nothing+                          outerType+                          ( divide+                              (\(val, flag) -> (val, flag))+                              ( Encoders.field+                                  ( Encoders.nonNullable+                                      ( Encoders.composite+                                          Nothing+                                          innerType+                                          (Encoders.field (Encoders.nonNullable Encoders.int8))+                                      )+                                  )+                              )+                              (Encoders.field (Encoders.nonNullable Encoders.bool))+                          )+                      )+                  )+              )+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True++  describe "Composite with array fields" do+    it "encodes composite types containing array fields" \config -> do+      typeName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create composite type with an array field+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", typeName, " as (id int8, values int8[])"])+              mempty+              Decoders.noResult+          -- Test encoding composite with array field+          Session.statement (42 :: Int64, [1, 2, 3] :: [Int64])+            $ Statement.preparable+              (mconcat ["select ($1 :: ", typeName, ") = (42, '{1, 2, 3}') :: ", typeName])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.composite+                          Nothing+                          typeName+                          ( divide+                              (\(i, vs) -> (i, vs))+                              (Encoders.field (Encoders.nonNullable Encoders.int8))+                              ( Encoders.field+                                  ( Encoders.nonNullable+                                      (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8))))+                                  )+                              )+                          )+                      )+                  )+              )+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True++    it "roundtrips composite types containing array fields" \config -> do+      typeName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create composite type with an array field+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", typeName, " as (id int8, values int8[])"])+              mempty+              Decoders.noResult+          -- Test roundtrip+          Session.statement (42 :: Int64, [1, 2, 3] :: [Int64])+            $ Statement.preparable+              (mconcat ["select $1 :: ", typeName])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.composite+                          Nothing+                          typeName+                          ( divide+                              (\(i, vs) -> (i, vs))+                              (Encoders.field (Encoders.nonNullable Encoders.int8))+                              ( Encoders.field+                                  ( Encoders.nonNullable+                                      (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8))))+                                  )+                              )+                          )+                      )+                  )+              )+              ( Decoders.singleRow+                  ( Decoders.column+                      ( Decoders.nonNullable+                          ( Decoders.composite+                              Nothing+                              typeName+                              ( (,)+                                  <$> Decoders.field (Decoders.nonNullable Decoders.int8)+                                  <*> Decoders.field+                                    ( Decoders.nonNullable+                                        (Decoders.array (Decoders.dimension replicateM (Decoders.element (Decoders.nonNullable Decoders.int8))))+                                    )+                              )+                          )+                      )+                  )+              )+        result `shouldBe` Right (42 :: Int64, [1, 2, 3] :: [Int64])++    it "encodes composite types containing arrays of named composite types" \config -> do+      innerType <- Scripts.generateSymname+      outerType <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create inner composite type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", innerType, " as (x int8, y bool)"])+              mempty+              Decoders.noResult+          -- Create outer composite type with array of inner composite+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", outerType, " as (id int8, items ", innerType, "[])"])+              mempty+              Decoders.noResult+          -- Test encoding composite with array of composite field by checking a field value+          Session.statement (99 :: Int64, [(1 :: Int64, True), (2, False), (3, True)])+            $ Statement.preparable+              (mconcat ["select ($1 :: ", outerType, ").id"])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.composite+                          Nothing+                          outerType+                          ( divide+                              (\(i, items) -> (i, items))+                              (Encoders.field (Encoders.nonNullable Encoders.int8))+                              ( Encoders.field+                                  ( Encoders.nonNullable+                                      ( Encoders.array+                                          ( Encoders.dimension+                                              foldl'+                                              ( Encoders.element+                                                  ( Encoders.nonNullable+                                                      ( Encoders.composite+                                                          Nothing+                                                          innerType+                                                          ( divide+                                                              (\(x, y) -> (x, y))+                                                              (Encoders.field (Encoders.nonNullable Encoders.int8))+                                                              (Encoders.field (Encoders.nonNullable Encoders.bool))+                                                          )+                                                      )+                                                  )+                                              )+                                          )+                                      )+                                  )+                              )+                          )+                      )+                  )+              )+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))+        result `shouldBe` Right (99 :: Int64)++    it "roundtrips composite types containing arrays of named composite types" \config -> do+      innerType <- Scripts.generateSymname+      outerType <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create inner composite type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", innerType, " as (x int8, y bool)"])+              mempty+              Decoders.noResult+          -- Create outer composite type with array of inner composite+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", outerType, " as (id int8, items ", innerType, "[])"])+              mempty+              Decoders.noResult+          -- Test roundtrip+          Session.statement (99 :: Int64, [(1 :: Int64, True), (2, False), (3, True)])+            $ Statement.preparable+              (mconcat ["select $1 :: ", outerType])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.composite+                          Nothing+                          outerType+                          ( divide+                              (\(i, items) -> (i, items))+                              (Encoders.field (Encoders.nonNullable Encoders.int8))+                              ( Encoders.field+                                  ( Encoders.nonNullable+                                      ( Encoders.array+                                          ( Encoders.dimension+                                              foldl'+                                              ( Encoders.element+                                                  ( Encoders.nonNullable+                                                      ( Encoders.composite+                                                          Nothing+                                                          innerType+                                                          ( divide+                                                              (\(x, y) -> (x, y))+                                                              (Encoders.field (Encoders.nonNullable Encoders.int8))+                                                              (Encoders.field (Encoders.nonNullable Encoders.bool))+                                                          )+                                                      )+                                                  )+                                              )+                                          )+                                      )+                                  )+                              )+                          )+                      )+                  )+              )+              ( Decoders.singleRow+                  ( Decoders.column+                      ( Decoders.nonNullable+                          ( Decoders.composite+                              Nothing+                              outerType+                              ( (,)+                                  <$> Decoders.field (Decoders.nonNullable Decoders.int8)+                                  <*> Decoders.field+                                    ( Decoders.nonNullable+                                        ( Decoders.array+                                            ( Decoders.dimension+                                                replicateM+                                                ( Decoders.element+                                                    ( Decoders.nonNullable+                                                        ( Decoders.composite+                                                            Nothing+                                                            innerType+                                                            ( (,)+                                                                <$> Decoders.field (Decoders.nonNullable Decoders.int8)+                                                                <*> Decoders.field (Decoders.nonNullable Decoders.bool)+                                                            )+                                                        )+                                                    )+                                                )+                                            )+                                        )+                                    )+                              )+                          )+                      )+                  )+              )+        result `shouldBe` Right (99 :: Int64, [(1 :: Int64, True), (2, False), (3, True)])++    it "encodes composite types with multiple levels of nesting: composite -> array -> composite" \config -> do+      deepType <- Scripts.generateSymname+      midType <- Scripts.generateSymname+      topType <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create deepest composite type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", deepType, " as (value int8)"])+              mempty+              Decoders.noResult+          -- Create middle composite type with array of deep composite+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", midType, " as (data ", deepType, "[])"])+              mempty+              Decoders.noResult+          -- Create top composite type containing middle composite+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", topType, " as (name text, \"nested\" ", midType, ")"])+              mempty+              Decoders.noResult+          -- Test encoding deeply nested structure by extracting a value+          Session.statement ("test", [1 :: Int64, 2, 3])+            $ Statement.preparable+              (mconcat ["select ($1 :: ", topType, ").name"])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.composite+                          Nothing+                          topType+                          ( divide+                              (\(name, nested) -> (name, nested))+                              (Encoders.field (Encoders.nonNullable Encoders.text))+                              ( Encoders.field+                                  ( Encoders.nonNullable+                                      ( Encoders.composite+                                          Nothing+                                          midType+                                          ( Encoders.field+                                              ( Encoders.nonNullable+                                                  ( Encoders.array+                                                      ( Encoders.dimension+                                                          foldl'+                                                          ( Encoders.element+                                                              ( Encoders.nonNullable+                                                                  ( Encoders.composite+                                                                      Nothing+                                                                      deepType+                                                                      (Encoders.field (Encoders.nonNullable Encoders.int8))+                                                                  )+                                                              )+                                                          )+                                                      )+                                                  )+                                              )+                                          )+                                      )+                                  )+                              )+                          )+                      )+                  )+              )+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)))+        result `shouldBe` Right "test"++  it "detects attempts to encode non-existent composite types" \config -> do+    Scripts.onPreparableConnection config \connection -> do+      result <- Connection.use connection do+        Session.statement (42 :: Int64, "test")+          $ Statement.preparable+            "select $1::nonexistent_composite_type"+            ( Encoders.param+                ( Encoders.nonNullable+                    ( Encoders.composite+                        Nothing+                        "nonexistent_composite_type"+                        ( divide+                            (\(a, b) -> (a, b))+                            (Encoders.field (Encoders.nonNullable Encoders.int8))+                            (Encoders.field (Encoders.nonNullable Encoders.text))+                        )+                    )+                )+            )+            (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)))++      case result of+        Left (Errors.MissingTypesSessionError missingTypes) ->+          missingTypes `shouldBe` HashSet.fromList [(Nothing, "nonexistent_composite_type")]+        _ ->+          expectationFailure ("Unexpected result: " <> show result)
+ src/library-tests/Integration/Sharing/Encoders/CustomSpec.hs view
@@ -0,0 +1,341 @@+module Integration.Sharing.Encoders.CustomSpec (spec) where++import Data.HashSet qualified as HashSet+import Data.Text.Encoding (encodeUtf8)+import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Errors qualified as Errors+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec+import TextBuilder qualified++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Basic custom encoders" do+    it "encodes a custom type with runtime OID lookup" \config -> do+      enumName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create enum type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", enumName, " as enum ('alpha', 'beta', 'gamma')"])+              mempty+              Decoders.noResult+          -- Test custom encoder with runtime OID lookup+          Session.statement "beta"+            $ Statement.preparable+              (mconcat ["select ($1 :: ", enumName, ") = 'beta' :: ", enumName])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.custom+                          Nothing+                          enumName+                          Nothing+                          []+                          (\_ val -> encodeUtf8 val)+                          id+                      )+                  )+              )+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True++    it "encodes a custom type with static OIDs" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Test custom encoder with static OIDs for text (type OID 25, array OID 1009)+          Session.statement "hello"+            $ Statement.preparable+              "select $1::text = 'hello'::text"+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.custom+                          Nothing+                          "text"+                          (Just (25, 1009))+                          []+                          (\_ val -> encodeUtf8 val)+                          id+                      )+                  )+              )+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True++    it "encodes with dependent type OID requests" \config -> do+      enumName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create enum type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", enumName, " as enum ('small', 'large')"])+              mempty+              Decoders.noResult+          -- Test custom encoder that requests OID of the enum type itself+          Session.statement "large"+            $ Statement.preparable+              (mconcat ["select ($1 :: ", enumName, ") = 'large' :: ", enumName])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.custom+                          Nothing+                          enumName+                          Nothing+                          [(Nothing, enumName)]+                          ( \lookupOid val -> do+                              let (enumOidScalar, _enumOidArray) = lookupOid (Nothing, enumName)+                              -- Verify we got a valid OID (non-zero)+                              if enumOidScalar > 0+                                then encodeUtf8 val+                                else error "Failed to resolve enum OID"+                          )+                          id+                      )+                  )+              )+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True++  describe "Error handling" do+    it "detects missing types in custom encoders" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          Session.statement "test_value"+            $ Statement.preparable+              "select $1"+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.custom+                          Nothing+                          "nonexistent_custom_type"+                          Nothing+                          []+                          (\_ val -> encodeUtf8 val)+                          id+                      )+                  )+              )+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)))++        case result of+          Left (Errors.MissingTypesSessionError missingTypes) ->+            missingTypes `shouldBe` HashSet.fromList [(Nothing, "nonexistent_custom_type")]+          _ ->+            expectationFailure ("Unexpected result: " <> show result)++    it "detects missing dependent types in custom encoders" \config -> do+      customTypeName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create a custom type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", customTypeName, " as (id int4)"])+              mempty+              Decoders.noResult+          -- Try to encode it but request a non-existent dependent type+          Session.statement (42 :: Int32)+            $ Statement.preparable+              (mconcat ["select $1 :: ", customTypeName])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.custom+                          Nothing+                          customTypeName+                          Nothing+                          [(Nothing, "nonexistent_dependency")]+                          (\_ val -> encodeUtf8 (TextBuilder.toText (TextBuilder.decimal val)))+                          (TextBuilder.toText . TextBuilder.decimal)+                      )+                  )+              )+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)))++        case result of+          Left (Errors.MissingTypesSessionError missingTypes) ->+            missingTypes `shouldBe` HashSet.fromList [(Nothing, "nonexistent_dependency")]+          _ ->+            expectationFailure ("Unexpected result: " <> show result)++  describe "Roundtrip tests" do+    it "roundtrips custom encoded and decoded values" \config -> do+      enumName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create enum type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", enumName, " as enum ('one', 'two', 'three')"])+              mempty+              Decoders.noResult+          -- Test roundtrip using custom encoder and decoder+          Session.statement "three"+            $ Statement.preparable+              (mconcat ["select $1 :: ", enumName])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.custom+                          Nothing+                          enumName+                          Nothing+                          []+                          (\_ val -> encodeUtf8 val)+                          id+                      )+                  )+              )+              ( Decoders.singleRow+                  ( Decoders.column+                      ( Decoders.nonNullable+                          ( Decoders.custom+                              Nothing+                              enumName+                              Nothing+                              []+                              (\_ bytes -> Right bytes)+                          )+                      )+                  )+              )+        result `shouldBe` Right "three"++    it "roundtrips multiple values" \config -> do+      enumName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create enum type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", enumName, " as enum ('first', 'second', 'third')"])+              mempty+              Decoders.noResult+          -- Test roundtrip for multiple values+          r1 <-+            Session.statement "first"+              $ Statement.preparable+                (mconcat ["select $1 :: ", enumName])+                ( Encoders.param+                    ( Encoders.nonNullable+                        ( Encoders.custom+                            Nothing+                            enumName+                            Nothing+                            []+                            (\_ val -> encodeUtf8 val)+                            id+                        )+                    )+                )+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            ( Decoders.custom+                                Nothing+                                enumName+                                Nothing+                                []+                                (\_ bytes -> Right bytes)+                            )+                        )+                    )+                )+          r2 <-+            Session.statement "third"+              $ Statement.preparable+                (mconcat ["select $1 :: ", enumName])+                ( Encoders.param+                    ( Encoders.nonNullable+                        ( Encoders.custom+                            Nothing+                            enumName+                            Nothing+                            []+                            (\_ val -> encodeUtf8 val)+                            id+                        )+                    )+                )+                ( Decoders.singleRow+                    ( Decoders.column+                        ( Decoders.nonNullable+                            ( Decoders.custom+                                Nothing+                                enumName+                                Nothing+                                []+                                (\_ bytes -> Right bytes)+                            )+                        )+                    )+                )+          return (r1, r2)+        result `shouldBe` Right ("first", "third")++  describe "Schema-qualified types" do+    it "encodes custom types from specific schemas" \config -> do+      schemaName <- Scripts.generateSymname+      typeName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create schema+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create schema ", schemaName])+              mempty+              Decoders.noResult+          -- Create enum type in that schema+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", schemaName, ".", typeName, " as enum ('x', 'y', 'z')"])+              mempty+              Decoders.noResult+          -- Test custom encoder with schema qualification+          Session.statement "z"+            $ Statement.preparable+              (mconcat ["select ($1 :: ", schemaName, ".", typeName, ") = 'z' :: ", schemaName, ".", typeName])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.custom+                          (Just schemaName)+                          typeName+                          Nothing+                          []+                          (\_ val -> encodeUtf8 val)+                          id+                      )+                  )+              )+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True++    it "detects missing types in non-existent schemas" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          Session.statement "test"+            $ Statement.preparable+              "select $1"+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.custom+                          (Just "nonexistent_schema")+                          "nonexistent_type"+                          Nothing+                          []+                          (\_ val -> encodeUtf8 val)+                          id+                      )+                  )+              )+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)))++        case result of+          Left (Errors.MissingTypesSessionError missingTypes) ->+            missingTypes `shouldBe` HashSet.fromList [(Just "nonexistent_schema", "nonexistent_type")]+          _ ->+            expectationFailure ("Unexpected result: " <> show result)
+ src/library-tests/Integration/Sharing/Encoders/DomainSpec.hs view
@@ -0,0 +1,151 @@+module Integration.Sharing.Encoders.DomainSpec (spec) where++import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Domain type encoding" do+    describe "Simple scalar domains" do+      it "encodes a domain based on int8 using int8 codec" \config -> do+        domainName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create domain type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create domain ", domainName, " as int8"])+                mempty+                Decoders.noResult+            -- Test encoding by comparing with static value+            Session.statement (42 :: Int64)+              $ Statement.preparable+                (mconcat ["select ($1 :: ", domainName, ") = 42"])+                (Encoders.param (Encoders.nonNullable Encoders.int8))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+          result `shouldBe` Right True++      it "encodes a domain based on text using text codec" \config -> do+        domainName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create domain type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create domain ", domainName, " as text"])+                mempty+                Decoders.noResult+            -- Test encoding by comparing with static value+            Session.statement ("hello" :: Text)+              $ Statement.preparable+                (mconcat ["select ($1 :: ", domainName, ") = 'hello'"])+                (Encoders.param (Encoders.nonNullable Encoders.text))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+          result `shouldBe` Right True++      it "encodes a domain based on bool using bool codec" \config -> do+        domainName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create domain type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create domain ", domainName, " as bool"])+                mempty+                Decoders.noResult+            -- Test encoding by comparing with static value+            Session.statement True+              $ Statement.preparable+                (mconcat ["select ($1 :: ", domainName, ") = true"])+                (Encoders.param (Encoders.nonNullable Encoders.bool))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+          result `shouldBe` Right True++    describe "Domains with constraints" do+      it "encodes values that satisfy domain constraints" \config -> do+        domainName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create domain type with constraint+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create domain ", domainName, " as int8 check (value > 0)"])+                mempty+                Decoders.noResult+            -- Test encoding a value that satisfies the constraint+            Session.statement (42 :: Int64)+              $ Statement.preparable+                (mconcat ["select ($1 :: ", domainName, ") = 42"])+                (Encoders.param (Encoders.nonNullable Encoders.int8))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+          result `shouldBe` Right True++    describe "Domain type cast compatibility for composite usage" do+      it "encodes base type value that can be used in composite with domain field via explicit cast" \config -> do+        domainName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create domain type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create domain ", domainName, " as int8"])+                mempty+                Decoders.noResult+            -- Encode int8, cast it to domain, and use in ROW constructor+            Session.statement (42 :: Int64)+              $ Statement.preparable+                (mconcat ["select ($1 :: ", domainName, ") = 42"])+                (Encoders.param (Encoders.nonNullable Encoders.int8))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+          result `shouldBe` Right True++    describe "Domain type cast compatibility for array usage" do+      it "encodes base type array that can be cast to domain array" \config -> do+        domainName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create domain type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create domain ", domainName, " as int8"])+                mempty+                Decoders.noResult+            -- Encode int8 array using base codec and verify it works+            Session.statement ([1, 2, 3] :: [Int64])+              $ Statement.preparable+                "select $1 = ARRAY[1,2,3] :: int8[]"+                ( Encoders.param+                    ( Encoders.nonNullable+                        (Encoders.foldableArray (Encoders.nonNullable Encoders.int8))+                    )+                )+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+          result `shouldBe` Right True++      it "encodes text array that can be used with text domain" \config -> do+        domainName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          result <- Connection.use connection do+            -- Create domain type+            Session.statement ()+              $ Statement.preparable+                (mconcat ["create domain ", domainName, " as text"])+                mempty+                Decoders.noResult+            -- Encode text array using base codec+            Session.statement (["a", "b", "c"] :: [Text])+              $ Statement.preparable+                "select $1 = ARRAY['a','b','c'] :: text[]"+                ( Encoders.param+                    ( Encoders.nonNullable+                        (Encoders.foldableArray (Encoders.nonNullable Encoders.text))+                    )+                )+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+          result `shouldBe` Right True
+ src/library-tests/Integration/Sharing/Encoders/EnumSpec.hs view
@@ -0,0 +1,315 @@+module Integration.Sharing.Encoders.EnumSpec (spec) where++import Data.HashSet qualified as HashSet+import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Errors qualified as Errors+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Simple enums" do+    it "encodes a simple named enum and compares with static value" \config -> do+      enumName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create enum type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", enumName, " as enum ('sad', 'ok', 'happy')"])+              mempty+              Decoders.noResult+          -- Test encoding by comparing with static value+          Session.statement "ok"+            $ Statement.preparable+              (mconcat ["select ($1 :: ", enumName, ") = 'ok' :: ", enumName])+              (Encoders.param (Encoders.nonNullable (Encoders.enum Nothing enumName id)))+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True++    it "encodes and roundtrips a simple named enum" \config -> do+      enumName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create enum type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", enumName, " as enum ('sad', 'ok', 'happy')"])+              mempty+              Decoders.noResult+          -- Test roundtrip+          Session.statement "happy"+            $ Statement.preparable+              (mconcat ["select $1 :: ", enumName])+              (Encoders.param (Encoders.nonNullable (Encoders.enum Nothing enumName id)))+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id)))))+        result `shouldBe` Right "happy"++  describe "Enums in composites" do+    it "encodes enums nested in named composites" \config -> do+      enumName <- Scripts.generateSymname+      compositeName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create enum type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", enumName, " as enum ('red', 'green', 'blue')"])+              mempty+              Decoders.noResult+          -- Create composite type with enum+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", compositeName, " as (id int8, color ", enumName, ")"])+              mempty+              Decoders.noResult+          -- Test encoding+          Session.statement (42 :: Int64, "green")+            $ Statement.preparable+              (mconcat ["select ($1 :: ", compositeName, ") = (42, 'green') :: ", compositeName])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.composite+                          Nothing+                          compositeName+                          ( divide+                              (\(a, b) -> (a, b))+                              (Encoders.field (Encoders.nonNullable Encoders.int8))+                              (Encoders.field (Encoders.nonNullable (Encoders.enum Nothing enumName id)))+                          )+                      )+                  )+              )+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True++    it "roundtrips enums nested in named composites" \config -> do+      enumName <- Scripts.generateSymname+      compositeName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create enum type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", enumName, " as enum ('red', 'green', 'blue')"])+              mempty+              Decoders.noResult+          -- Create composite type with enum+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", compositeName, " as (id int8, color ", enumName, ")"])+              mempty+              Decoders.noResult+          -- Test roundtrip+          Session.statement (42 :: Int64, "blue")+            $ Statement.preparable+              (mconcat ["select $1 :: ", compositeName])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.composite+                          Nothing+                          compositeName+                          ( divide+                              (\(a, b) -> (a, b))+                              (Encoders.field (Encoders.nonNullable Encoders.int8))+                              (Encoders.field (Encoders.nonNullable (Encoders.enum Nothing enumName id)))+                          )+                      )+                  )+              )+              ( Decoders.singleRow+                  ( Decoders.column+                      ( Decoders.nonNullable+                          ( Decoders.composite+                              Nothing+                              compositeName+                              ( (,)+                                  <$> Decoders.field (Decoders.nonNullable Decoders.int8)+                                  <*> Decoders.field (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id)))+                              )+                          )+                      )+                  )+              )+        result `shouldBe` Right (42 :: Int64, "blue")++  describe "Arrays of enums" do+    it "encodes arrays of named enums" \config -> do+      enumName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create enum type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", enumName, " as enum ('small', 'medium', 'large')"])+              mempty+              Decoders.noResult+          -- Test array encoding+          Session.statement ["small", "large", "medium"]+            $ Statement.preparable+              (mconcat ["select ($1 :: ", enumName, "[]) = array['small', 'large', 'medium'] :: ", enumName, "[]"])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.array+                          ( Encoders.dimension+                              foldl'+                              (Encoders.element (Encoders.nonNullable (Encoders.enum Nothing enumName id)))+                          )+                      )+                  )+              )+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True++    it "roundtrips arrays of named enums" \config -> do+      enumName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create enum type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", enumName, " as enum ('alpha', 'beta', 'gamma')"])+              mempty+              Decoders.noResult+          -- Test roundtrip+          Session.statement ["beta", "alpha", "gamma"]+            $ Statement.preparable+              (mconcat ["select $1 :: ", enumName, "[]"])+              ( Encoders.param+                  ( Encoders.nonNullable+                      ( Encoders.array+                          ( Encoders.dimension+                              foldl'+                              (Encoders.element (Encoders.nonNullable (Encoders.enum Nothing enumName id)))+                          )+                      )+                  )+              )+              ( Decoders.singleRow+                  ( Decoders.column+                      ( Decoders.nonNullable+                          ( Decoders.array+                              ( Decoders.dimension+                                  replicateM+                                  (Decoders.element (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id))))+                              )+                          )+                      )+                  )+              )+        result `shouldBe` Right ["beta", "alpha", "gamma"]++  describe "OID lookup verification" do+    it "requests OID for named enums (verified by successful execution)" \config -> do+      -- This test verifies that OID lookup happens by ensuring a named enum+      -- type works correctly - if OID lookup didn't happen, the statement would fail+      enumName <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Create enum type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", enumName, " as enum ('first', 'second')"])+              mempty+              Decoders.noResult+          -- Use named enum - this requires OID lookup to succeed+          Session.statement "second"+            $ Statement.preparable+              (mconcat ["select $1 :: ", enumName])+              (Encoders.param (Encoders.nonNullable (Encoders.enum Nothing enumName id)))+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id)))))+        result `shouldBe` Right "second"++  it "handles enum encoding and decoding" \config -> do+    name <- Scripts.generateSymname+    Scripts.onPreparableConnection config \connection -> do+      result <- Connection.use connection do+        -- First create the enum type+        Session.statement ()+          $ Statement.preparable+            (mconcat ["create type ", name, " as enum ('sad', 'ok', 'happy')"])+            mempty+            Decoders.noResult+        -- Then test encoding and decoding+        Session.statement "ok"+          $ Statement.preparable+            (mconcat ["select ($1 :: ", name, ")"])+            (Encoders.param (Encoders.nonNullable (Encoders.enum Nothing name id)))+            (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.enum Nothing name (Just . id)))))+      result `shouldBe` Right "ok"++  it "detects attempts to encode non-existent enum types" \config -> do+    Scripts.onPreparableConnection config \connection -> do+      result <- Connection.use connection do+        Session.statement "test_value"+          $ Statement.preparable+            "select $1"+            (Encoders.param (Encoders.nonNullable (Encoders.enum Nothing "this_enum_does_not_exist_in_db" id)))+            (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)))++      case result of+        Left (Errors.MissingTypesSessionError missingTypes) ->+          missingTypes `shouldBe` HashSet.fromList [(Nothing, "this_enum_does_not_exist_in_db")]+        _ ->+          expectationFailure ("Unexpected result: " <> show result)++  describe "Namespaced" do+    it "detects attempts to use non-existent type in non-existent schema" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          Session.statement "test"+            $ Statement.preparable+              "select $1::nonexistent_schema.nonexistent_type"+              (Encoders.param (Encoders.nonNullable (Encoders.enum (Just "nonexistent_schema") "nonexistent_type" id)))+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)))++        case result of+          Left (Errors.MissingTypesSessionError missingTypes) ->+            missingTypes `shouldBe` HashSet.fromList [(Just "nonexistent_schema", "nonexistent_type")]+          _ ->+            expectationFailure ("Unexpected result: " <> show result)++    it "detects attempts to use non-existent type in existing schema" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          Session.statement "test"+            $ Statement.preparable+              "select $1::public.this_type_does_not_exist"+              (Encoders.param (Encoders.nonNullable (Encoders.enum (Just "public") "this_type_does_not_exist" id)))+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)))++        -- The statement should fail when trying to use a non-existent type in existing schema+        case result of+          Left (Errors.MissingTypesSessionError missingTypes) -> do+            missingTypes `shouldBe` HashSet.fromList [(Just "public", "this_type_does_not_exist")]+          _ ->+            expectationFailure ("Unexpected result: " <> show result)++  it "detects attempts to encode arrays of non-existent enum types" \config -> do+    Scripts.onPreparableConnection config \connection -> do+      result <- Connection.use connection do+        Session.statement ["val1", "val2"]+          $ Statement.preparable+            "select $1::nonexistent_array_enum[]"+            ( Encoders.param+                ( Encoders.nonNullable+                    ( Encoders.array+                        ( Encoders.dimension+                            foldl'+                            (Encoders.element (Encoders.nonNullable (Encoders.enum Nothing "nonexistent_array_enum" id)))+                        )+                    )+                )+            )+            (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)))++      case result of+        Left (Errors.MissingTypesSessionError missingTypes) ->+          missingTypes `shouldBe` HashSet.fromList [(Nothing, "nonexistent_array_enum")]+        _ ->+          expectationFailure ("Unexpected result: " <> show result)
+ src/library-tests/Integration/Sharing/Encoders/HstoreSpec.hs view
@@ -0,0 +1,141 @@+module Integration.Sharing.Encoders.HstoreSpec (spec) where++import Data.HashMap.Strict qualified as HashMap+import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Hstore Encoders" do+    it "encodes empty hstore" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Enable hstore extension (unprepared), ignore if already exists+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS hstore"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          -- Test encoding empty hstore+          Session.statement+            ([] :: [(Text, Maybe Text)])+            $ Statement.preparable+              "select $1::hstore = ''::hstore"+              (Encoders.param (Encoders.nonNullable Encoders.hstore))+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True++    it "encodes hstore with single key-value pair" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Enable hstore extension (unprepared), ignore if already exists+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS hstore"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          -- Test encoding single key-value pair+          Session.statement+            [("key", Just "value")]+            $ Statement.preparable+              "select $1::hstore = 'key => value'::hstore"+              (Encoders.param (Encoders.nonNullable Encoders.hstore))+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True++    it "encodes hstore with multiple key-value pairs" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Enable hstore extension (unprepared), ignore if already exists+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS hstore"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          -- Test encoding multiple key-value pairs+          Session.statement+            [("a", Just "1"), ("b", Just "2"), ("c", Just "3")]+            $ Statement.preparable+              "select $1::hstore @> 'a => 1'::hstore AND $1::hstore @> 'b => 2'::hstore AND $1::hstore @> 'c => 3'::hstore"+              (Encoders.param (Encoders.nonNullable Encoders.hstore))+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True++    it "encodes hstore with null values" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Enable hstore extension (unprepared), ignore if already exists+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS hstore"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          -- Test encoding hstore with null values+          Session.statement+            [("key1", Just "value1"), ("key2", Nothing), ("key3", Just "value3")]+            $ Statement.preparable+              "select $1::hstore = 'key1 => value1, key2 => NULL, key3 => value3'::hstore"+              (Encoders.param (Encoders.nonNullable Encoders.hstore))+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True++    it "roundtrips hstore correctly" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let testData = HashMap.fromList [("key1", Just "value1"), ("key2", Nothing), ("key3", Just "value3")]+        result <- Connection.use connection do+          -- Enable hstore extension (unprepared), ignore if already exists+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS hstore"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          -- Test roundtrip+          Session.statement+            (HashMap.toList testData)+            $ Statement.preparable+              "select $1"+              (Encoders.param (Encoders.nonNullable Encoders.hstore))+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.hstore (\n f -> replicateM n f >>= pure . HashMap.fromList)))))+        result `shouldBe` Right testData++    it "encodes hstore with special characters" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- Enable hstore extension (unprepared), ignore if already exists+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS hstore"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          -- Test encoding hstore with special characters+          Session.statement+            [("key with spaces", Just "value with quotes")]+            $ Statement.preparable+              "select $1::hstore = '\"key with spaces\" => \"value with quotes\"'::hstore"+              (Encoders.param (Encoders.nonNullable Encoders.hstore))+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True
+ src/library-tests/Integration/Sharing/Encoders/InetSpec.hs view
@@ -0,0 +1,74 @@+module Integration.Sharing.Encoders.InetSpec (spec) where++import Data.IP (IPv4, IPv6)+import Data.IP qualified as IP+import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "INET Encoders" do+    it "encodes IPv4 address correctly" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select $1 = '192.168.1.1/32'::inet"+                (Encoders.param (Encoders.nonNullable Encoders.inet))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+            testAddr = read "192.168.1.1" :: IPv4+            testRange = IP.makeAddrRange testAddr 32+        result <- Connection.use connection (Session.statement (IP.IPv4Range testRange) statement)+        result `shouldBe` Right True++    it "roundtrips IPv4 CIDR" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select $1"+                (Encoders.param (Encoders.nonNullable Encoders.inet))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.inet)))+            testAddr = read "10.0.0.0" :: IPv4+            testRange = IP.makeAddrRange testAddr 8+        result <- Connection.use connection (Session.statement (IP.IPv4Range testRange) statement)+        result `shouldBe` Right (IP.IPv4Range testRange)++    it "roundtrips IPv6 address" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select $1"+                (Encoders.param (Encoders.nonNullable Encoders.inet))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.inet)))+            testAddr = read "2001:db8::1" :: IPv6+            testRange = IP.makeAddrRange testAddr 128+        result <- Connection.use connection (Session.statement (IP.IPv6Range testRange) statement)+        result `shouldBe` Right (IP.IPv6Range testRange)++  describe "MACADDR Encoders" do+    it "encodes MAC address correctly" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select $1 = '08:00:2b:01:02:03'::macaddr"+                (Encoders.param (Encoders.nonNullable Encoders.macaddr))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+            testMac = (0x08, 0x00, 0x2b, 0x01, 0x02, 0x03)+        result <- Connection.use connection (Session.statement testMac statement)+        result `shouldBe` Right True++    it "roundtrips MAC address" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select $1"+                (Encoders.param (Encoders.nonNullable Encoders.macaddr))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.macaddr)))+            testMac = (0xaa, 0xbb, 0xcc, 0xdd, 0xee, 0xff)+        result <- Connection.use connection (Session.statement testMac statement)+        result `shouldBe` Right testMac
+ src/library-tests/Integration/Sharing/Encoders/IntervalSpec.hs view
@@ -0,0 +1,33 @@+module Integration.Sharing.Encoders.IntervalSpec (spec) where++import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Interval Encoders" do+    it "encodes intervals correctly" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select $1 = interval '10 seconds'"+                (Encoders.param (Encoders.nonNullable Encoders.interval))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result <- Connection.use connection (Session.statement (10 :: DiffTime) statement)+        result `shouldBe` Right True++    it "roundtrips intervals correctly" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select $1"+                (Encoders.param (Encoders.nonNullable Encoders.interval))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.interval)))+        result <- Connection.use connection (Session.statement (10 :: DiffTime) statement)+        result `shouldBe` Right (10 :: DiffTime)
+ src/library-tests/Integration/Sharing/Encoders/JsonSpec.hs view
@@ -0,0 +1,63 @@+module Integration.Sharing.Encoders.JsonSpec (spec) where++import Data.Aeson qualified as Aeson+import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "JSON Encoders" do+    it "encodes JSON object correctly" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select $1::json"+                (Encoders.param (Encoders.nonNullable Encoders.json))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.json)))+            testValue = Aeson.object [("key", Aeson.String "value")]+        result <- Connection.use connection (Session.statement testValue statement)+        result `shouldBe` Right testValue++    it "roundtrips JSON array" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select $1"+                (Encoders.param (Encoders.nonNullable Encoders.json))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.json)))+            testValue = Aeson.Array (fromList [Aeson.Number 1, Aeson.Number 2])+        result <- Connection.use connection (Session.statement testValue statement)+        result `shouldBe` Right testValue++  describe "JSONB Encoders" do+    it "encodes JSONB object correctly" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select $1::jsonb"+                (Encoders.param (Encoders.nonNullable Encoders.jsonb))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.jsonb)))+            testValue = Aeson.object [("name", Aeson.String "test"), ("value", Aeson.Number 123)]+        result <- Connection.use connection (Session.statement testValue statement)+        result `shouldBe` Right testValue++    it "roundtrips JSONB with nested structure" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select $1"+                (Encoders.param (Encoders.nonNullable Encoders.jsonb))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.jsonb)))+            testValue =+              Aeson.object+                [ ("array", Aeson.Array (fromList [Aeson.Number 1, Aeson.Number 2])),+                  ("nested", Aeson.object [("inner", Aeson.String "value")])+                ]+        result <- Connection.use connection (Session.statement testValue statement)+        result `shouldBe` Right testValue
+ src/library-tests/Integration/Sharing/Encoders/UnknownSpec.hs view
@@ -0,0 +1,33 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++module Integration.Sharing.Encoders.UnknownSpec (spec) where++import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Unknown Type Encoders" do+    it "handles unknown type encoding" \config -> do+      name <- Scripts.generateSymname+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          -- First create the enum type+          Session.statement ()+            $ Statement.preparable+              (mconcat ["create type ", name, " as enum ('sad', 'ok', 'happy')"])+              mempty+              Decoders.noResult+          -- Then test encoding+          Session.statement "ok"+            $ Statement.preparable+              (mconcat ["select $1 = ('ok' :: ", name, ")"])+              (Encoders.param (Encoders.nonNullable Encoders.unknown))+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True
+ src/library-tests/Integration/Sharing/Encoders/UuidSpec.hs view
@@ -0,0 +1,50 @@+module Integration.Sharing.Encoders.UuidSpec (spec) where++import Data.UUID qualified as UUID+import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "UUID Encoders" do+    it "encodes UUID correctly" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select $1 = '550e8400-e29b-41d4-a716-446655440000'::uuid"+                (Encoders.param (Encoders.nonNullable Encoders.uuid))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        case UUID.fromString "550e8400-e29b-41d4-a716-446655440000" of+          Just testUuid -> do+            result <- Connection.use connection (Session.statement testUuid statement)+            result `shouldBe` Right True+          Nothing -> expectationFailure "Failed to parse test UUID"++    it "roundtrips UUID correctly" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select $1"+                (Encoders.param (Encoders.nonNullable Encoders.uuid))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.uuid)))+        case UUID.fromString "a0eebc99-9c0b-4ef8-bb6d-6bb9bd380a11" of+          Just testUuid -> do+            result <- Connection.use connection (Session.statement testUuid statement)+            result `shouldBe` Right testUuid+          Nothing -> expectationFailure "Failed to parse test UUID"++    it "encodes nil UUID correctly" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select $1"+                (Encoders.param (Encoders.nonNullable Encoders.uuid))+                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.uuid)))+        result <- Connection.use connection (Session.statement UUID.nil statement)+        result `shouldBe` Right UUID.nil
+ src/library-tests/Integration/Sharing/ErrorsSpec.hs view
@@ -0,0 +1,229 @@+module Integration.Sharing.ErrorsSpec (spec) where++import Data.Either+import Data.Vector qualified as Vector+import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Errors qualified as Errors+import Hasql.Pipeline qualified as Pipeline+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Syntax errors" do+    forM_ [False, True] \inPipeline -> do+      describe (if inPipeline then "Pipeline" else "Session") do+        forM_ [False, True] \preparable -> do+          describe (if preparable then "Preparable" else "Unpreparable") do+            it "gets reported properly" \config -> do+              Scripts.onPreparableConnection config \connection -> do+                result <- Connection.use connection do+                  let statement =+                        if preparable+                          then Statement.preparable "-" mempty Decoders.noResult+                          else Statement.unpreparable "-" mempty Decoders.noResult+                  if inPipeline+                    then Session.pipeline (Pipeline.statement () statement)+                    else Session.statement () statement++                shouldBe+                  result+                  ( Left+                      ( (Errors.StatementSessionError 1 0 "-" [] preparable)+                          ( Errors.ServerStatementError+                              ( Errors.ServerError+                                  "42601"+                                  "syntax error at or near \"-\""+                                  Nothing+                                  Nothing+                                  (Just 1)+                              )+                          )+                      )+                  )++  describe "Decoder mismatches" $ parallel do+    decoderMismatchByPreparedStatusAndExecutor True "Session" (Session.statement ())+    decoderMismatchByPreparedStatusAndExecutor False "Session" (Session.statement ())+    decoderMismatchByPreparedStatusAndExecutor True "Pipeline" (Session.pipeline . Pipeline.statement ())+    decoderMismatchByPreparedStatusAndExecutor False "Pipeline" (Session.pipeline . Pipeline.statement ())++decoderMismatchByPreparedStatusAndExecutor ::+  Bool ->+  Text ->+  (forall a. (Show a) => Statement.Statement () a -> Session.Session a) ->+  SpecWith Scripts.ScopeParams+decoderMismatchByPreparedStatusAndExecutor preparable executorName executor = do+  describe (if preparable then "Preparable" else "Unpreparable") do+    describe (toList executorName) do+      describe "UnexpectedColumnCount" do+        it "gets reported when result has more columns" \config -> do+          Scripts.onPreparableConnection config \connection -> do+            let statement =+                  (if preparable then Statement.preparable else Statement.unpreparable)+                    "select 1, 2"+                    mempty+                    (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))+            result <- Connection.use connection (executor statement)+            case result of+              Left (Errors.StatementSessionError _ _ _ _ _ (Errors.UnexpectedColumnCountStatementError expected actual)) -> do+                shouldBe expected 1+                shouldBe actual 2+              Left err ->+                expectationFailure ("Unexpected type of error: " <> show err)+              result ->+                expectationFailure ("Not an error: " <> show result)++        it "gets reported when result has fewer columns" \config -> do+          Scripts.onPreparableConnection config \connection -> do+            let statement =+                  (if preparable then Statement.preparable else Statement.unpreparable)+                    "select 1"+                    mempty+                    ( Decoders.singleRow+                        ( (,)+                            <$> Decoders.column (Decoders.nonNullable Decoders.int8)+                            <*> Decoders.column (Decoders.nonNullable Decoders.int8)+                        )+                    )+            result <- Connection.use connection (executor statement)+            case result of+              Left (Errors.StatementSessionError _ _ _ _ _ (Errors.UnexpectedColumnCountStatementError expected actual)) -> do+                shouldBe expected 2+                shouldBe actual 1+              Left err ->+                expectationFailure ("Unexpected type of error: " <> show err)+              result ->+                expectationFailure ("Not an error: " <> show result)++      describe "DecoderTypeMismatch" do+        describe "singleRow" do+          it "gets reported when column type mismatches decoder" \config -> do+            Scripts.onPreparableConnection config \connection -> do+              let statement =+                    (if preparable then Statement.preparable else Statement.unpreparable)+                      "select 1::int8, 'text'::text"+                      mempty+                      ( Decoders.singleRow+                          ( (,)+                              <$> Decoders.column (Decoders.nonNullable Decoders.int8)+                              <*> Decoders.column (Decoders.nonNullable Decoders.int8)+                          )+                      )+              result <- Connection.use connection (executor statement)+              case result of+                Left (Errors.StatementSessionError _ _ _ _ _ (Errors.UnexpectedColumnTypeStatementError column expected actual)) -> do+                  shouldBe column 1+                  shouldBe expected 20+                  shouldBe actual 25+                Left err ->+                  expectationFailure ("Unexpected type of error: " <> show err)+                result ->+                  expectationFailure ("Not an error: " <> show result)++        describe "rowMaybe" do+          it "gets reported when column type mismatches decoder" \config -> do+            Scripts.onPreparableConnection config \connection -> do+              let statement =+                    (if preparable then Statement.preparable else Statement.unpreparable)+                      "select 1::int8, 'text'::text"+                      mempty+                      ( Decoders.rowMaybe+                          ( (,)+                              <$> Decoders.column (Decoders.nonNullable Decoders.int8)+                              <*> Decoders.column (Decoders.nonNullable Decoders.int8)+                          )+                      )+              result <- Connection.use connection (executor statement)+              case result of+                Left (Errors.StatementSessionError _ _ _ _ _ (Errors.UnexpectedColumnTypeStatementError column expected actual)) -> do+                  shouldBe column 1+                  (expected, actual) `shouldBe` (20, 25)+                Left err ->+                  expectationFailure ("Unexpected type of error: " <> show err)+                result ->+                  expectationFailure ("Not an error: " <> show result)++        describe "rowVector" do+          it "gets reported when column type mismatches decoder" \config -> do+            Scripts.onPreparableConnection config \connection -> do+              let statement =+                    (if preparable then Statement.preparable else Statement.unpreparable)+                      "select int8 '1', text 'text'"+                      mempty+                      ( Decoders.rowVector+                          ( (,)+                              <$> Decoders.column (Decoders.nonNullable Decoders.int8)+                              <*> Decoders.column (Decoders.nonNullable Decoders.int8)+                          )+                      )+              result <- Connection.use connection (executor statement)+              case result of+                Left (Errors.StatementSessionError _ _ _ _ _ (Errors.UnexpectedColumnTypeStatementError column expected actual)) -> do+                  shouldBe column 1+                  (expected, actual) `shouldBe` (20, 25)+                Left err ->+                  expectationFailure ("Unexpected type of error: " <> show err)+                result ->+                  expectationFailure ("Not an error: " <> show result)++        describe "array" do+          describe "decoder:int8[]" do+            describe "column:int8" do+              it "reports properly" \config -> do+                Scripts.onPreparableConnection config \connection -> do+                  let statement =+                        (if preparable then Statement.preparable else Statement.unpreparable)+                          "select 1::int8"+                          mempty+                          ( Decoders.singleRow+                              (Decoders.column (Decoders.nonNullable (Decoders.vectorArray @Vector (Decoders.nonNullable Decoders.int8))))+                          )+                  result <- Connection.use connection (executor statement)+                  case result of+                    Left (Errors.StatementSessionError _ _ _ _ _ (Errors.UnexpectedColumnTypeStatementError column expected actual)) -> do+                      shouldBe column 0+                      (expected, actual) `shouldBe` (1016, 20)+                    Left err ->+                      expectationFailure ("Unexpected type of error: " <> show err)+                    result ->+                      expectationFailure ("Not an error: " <> show result)++          describe "decoder:int8[]" do+            describe "column:int8[]" do+              it "decodes properly" \config -> do+                Scripts.onPreparableConnection config \connection -> do+                  let statement =+                        (if preparable then Statement.preparable else Statement.unpreparable)+                          "select ARRAY[1::int8, 2::int8]"+                          mempty+                          ( Decoders.singleRow+                              (Decoders.column (Decoders.nonNullable (Decoders.vectorArray @Vector (Decoders.nonNullable Decoders.int8))))+                          )+                  result <- Connection.use connection (executor statement)+                  shouldBe result (Right (Vector.fromList [1, 2]))++          describe "decoder:int8" do+            describe "column:int8[]" do+              it "reports properly" \config -> do+                Scripts.onPreparableConnection config \connection -> do+                  let statement =+                        (if preparable then Statement.preparable else Statement.unpreparable)+                          "select ARRAY[1::int8, 2::int8]"+                          mempty+                          ( Decoders.singleRow+                              (Decoders.column (Decoders.nonNullable Decoders.int8))+                          )+                  result <- Connection.use connection (executor statement)+                  case result of+                    Left (Errors.StatementSessionError _ _ _ _ _ (Errors.UnexpectedColumnTypeStatementError column expected actual)) -> do+                      shouldBe column 0+                      (expected, actual) `shouldBe` (20, 1016)+                    Left err ->+                      expectationFailure ("Unexpected type of error: " <> show err)+                    result ->+                      expectationFailure ("Not an error: " <> show result)
+ src/library-tests/Integration/Sharing/PipelineSpec.hs view
@@ -0,0 +1,176 @@+module Integration.Sharing.PipelineSpec (spec) where++import Data.Either+import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Errors qualified as Errors+import Hasql.Pipeline qualified as Pipeline+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Dsls.Execution qualified as Execution+import Helpers.Scripts qualified as Scripts+import Helpers.Statements qualified as Statements+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Single-statement" do+    describe "Unprepared" do+      it "Collects results and sends params" \config -> do+        Scripts.onUnpreparableConnection config \connection -> do+          result <-+            (Connection.use connection . Session.pipeline)+              $ Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}+          shouldBe result (Right [0 .. 2])++    describe "Prepared" do+      it "Collects results and sends params" \config -> do+        Scripts.onPreparableConnection config \connection -> do+          result <-+            (Connection.use connection . Session.pipeline)+              $ Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}+          shouldBe result (Right [0 .. 2])++  describe "Multi-statement" do+    describe "On unprepared statements" do+      it "Collects results and sends params" \config -> do+        Scripts.onUnpreparableConnection config \connection -> do+          result <-+            (Connection.use connection . Session.pipeline)+              $ replicateM 2+              $ Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}+          shouldBe result (Right [[0 .. 2], [0 .. 2]])++    describe "On prepared statements" do+      it "Collects results and sends params" \config -> do+        Scripts.onPreparableConnection config \connection -> do+          result <-+            (Connection.use connection . Session.pipeline)+              $ replicateM 2+              $ Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}+          shouldBe result (Right [[0 .. 2], [0 .. 2]])++    describe "When a part in the middle fails" do+      describe "With query error" do+        it "Captures the error" \config -> do+          Scripts.onPreparableConnection config \connection -> do+            result <-+              (Connection.use connection . Session.pipeline)+                $ (,,)+                <$> Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}+                <*> Execution.pipelineByParams Statements.BrokenSyntax {start = 0, end = 2}+                <*> Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}+            case result of+              Left (Errors.StatementSessionError _ _ _ _ _ (Errors.ServerStatementError _)) -> pure ()+              _ -> expectationFailure $ "Unexpected result: " <> show result++        it "Leaves the connection usable" \config -> do+          Scripts.onPreparableConnection config \connection -> do+            result <-+              Connection.use connection do+                _ <-+                  catchError+                    ( Just+                        <$> Session.pipeline+                          ( (,,)+                              <$> Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}+                              <*> Execution.pipelineByParams Statements.BrokenSyntax {start = 0, end = 2}+                              <*> Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}+                          )+                    )+                    (const (pure Nothing))+                Execution.sessionByParams Statements.GenerateSeries {start = 0, end = 0}+            shouldBe result (Right [0])++      describe "With decoding error" do+        it "Captures the error" \config -> do+          Scripts.onPreparableConnection config \connection -> do+            result <-+              (Connection.use connection . Session.pipeline)+                $ (,,)+                <$> Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}+                <*> Execution.pipelineByParams Statements.WrongDecoder {start = 0, end = 2}+                <*> Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}+            case result of+              Left (Errors.StatementSessionError _ _ _ _ _ (Errors.UnexpectedColumnTypeStatementError {})) -> pure ()+              _ -> expectationFailure $ "Unexpected result: " <> show result++        it "Leaves the connection usable" \config -> do+          Scripts.onPreparableConnection config \connection -> do+            result <-+              Connection.use connection do+                _ <-+                  catchError+                    ( Just+                        <$> Session.pipeline+                          ( (,,)+                              <$> Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}+                              <*> Execution.pipelineByParams Statements.WrongDecoder {start = 0, end = 2}+                              <*> Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}+                          )+                    )+                    (const (pure Nothing))+                Execution.sessionByParams Statements.GenerateSeries {start = 0, end = 0}+            shouldBe result (Right [0])++  describe "Failing pipeline" do+    it "Does not cause errors in the next pipeline" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        -- Run an intentionally failing prepared statement in a pipeline to set the condition of the bug.+        result <- Connection.use connection do+          Session.pipeline do+            Pipeline.statement+              ()+              ( Statement.preparable+                  "select null :: int4"+                  mempty+                  (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))+              )+        case result of+          Right val ->+            expectationFailure ("First statement succeeded unexpectedly: " <> show val)+          Left _ ->+            pure ()++        -- Run a succeeding prepared statement in a pipeline to see if the cache is still in a good state.+        result <- Connection.use connection do+          Session.pipeline do+            Pipeline.statement+              ()+              ( Statement.preparable+                  "select 1"+                  mempty+                  (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))+              )+        -- If there is an error the cache got corrupted.+        case result of+          Right _ ->+            pure ()+          Left result ->+            expectationFailure ("Unexpected error: " <> show result)++    it "Handles failures within the same pipeline gracefully" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        -- Run an intentionally failing prepared statement in a pipeline to set the condition of the bug.+        result <- Connection.use connection do+          Session.pipeline do+            Pipeline.statement+              ()+              ( Statement.preparable+                  "select null :: int4"+                  mempty+                  (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))+              )+              <* Pipeline.statement+                ()+                ( Statement.preparable+                    "select 1"+                    mempty+                    (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))+                )+        case result of+          Right val ->+            expectationFailure ("First statement succeeded unexpectedly: " <> show val)+          Left _ ->+            pure ()
+ src/library-tests/Integration/Sharing/Session/CatchErrorSpec.hs view
@@ -0,0 +1,33 @@+module Integration.Sharing.Session.CatchErrorSpec (spec) where++import Data.Either+import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  it "Leaves the session usable" \config -> do+    Scripts.onPreparableConnection config \connection -> do+      let tryStatement =+            Statement.preparable+              "select $1 :: int8"+              (Encoders.param (Encoders.nonNullable Encoders.int8))+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))++      result <-+        Connection.use connection do+          -- First successful query+          a <- Session.statement (1 :: Int64) tryStatement+          -- This should fail but connection should remain usable+          () <- catchError (Session.script "absurd") (const (pure ()))+          -- Second successful query+          b <- Session.statement (2 :: Int64) tryStatement+          pure (a, b)++      result `shouldBe` Right (1, 2)
+ src/library-tests/Integration/Sharing/Session/ScriptSpec.hs view
@@ -0,0 +1,59 @@+module Integration.Sharing.Session.ScriptSpec (spec) where++import Data.Either+import Hasql.Connection qualified as Connection+import Hasql.Errors qualified as Errors+import Hasql.Session qualified as Session+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  it "returns ServerSessionError on syntax errors" \config -> do+    Scripts.onPreparableConnection config \connection -> do+      result <- Connection.use connection (Session.script "THIS IS INVALID SQL")+      case result of+        Left (Errors.ScriptSessionError _ _) -> pure ()+        _ -> expectationFailure $ "Expected ScriptSessionError with ExecutionScriptError, got: " <> show result++  it "handles multi-statement DDL scripts with comments" \config -> do+    Scripts.onPreparableConnection config \connection -> do+      tableName <- Scripts.generateSymname+      let sql =+            (mconcat . map (<> "\n"))+              [ "create table \"" <> tableName <> "_genre\" (",+                "  \"id\" int4 not null primary key,",+                "  \"name\" text not null unique",+                ");",+                "",+                "create table \"" <> tableName <> "_artist\" (",+                "  \"id\" int4 not null primary key,",+                "  \"name\" text not null",+                ");",+                "",+                "create table \"" <> tableName <> "_album\" (",+                "  \"id\" int4 not null primary key,",+                "  -- Album name.",+                "  \"name\" text not null,",+                "  -- The date the album was first released.",+                "  \"released\" date null",+                ");",+                "",+                "create table \"" <> tableName <> "_album_genre\" (",+                "  \"album\" int4 not null references \"" <> tableName <> "_album\",",+                "  \"genre\" int4 not null references \"" <> tableName <> "_genre\"",+                ");",+                "",+                "create table \"" <> tableName <> "_album_artist\" (",+                "  \"album\" int4 not null references \"" <> tableName <> "_album\",",+                "  \"artist\" int4 not null references \"" <> tableName <> "_artist\",",+                "  -- Whether it is the primary artist",+                "  \"primary\" bool not null,",+                "  primary key (\"album\", \"artist\")",+                ");"+              ]+      result <- Connection.use connection (Session.script sql)+      case result of+        Right () -> pure ()+        Left err -> expectationFailure $ "Expected success, got: " <> show err
+ src/library-tests/Integration/Sharing/Session/StatementSpec.hs view
@@ -0,0 +1,79 @@+module Integration.Sharing.Session.StatementSpec (spec) where++import Data.Either+import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Errors qualified as Errors+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Roundtrips" do+    it "handles simple values correctly" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection (Session.statement (42 :: Int64) echoStatement)+        result `shouldBe` Right 42++    it "reuses a prepared statement across executions in one session" \config -> do+      -- The first execution is a cache miss (separate PARSE roundtrip),+      -- the second a cache hit (single roundtrip). Both must succeed.+      Scripts.onPreparableConnection config \connection -> do+        result <-+          Connection.use connection do+            a <- Session.statement (1 :: Int64) echoStatement+            b <- Session.statement (2 :: Int64) echoStatement+            pure (a, b)+        result `shouldBe` Right (1, 2)++    it "keeps a prepared statement usable after an EXECUTE error" \config -> do+      -- Regression: PARSE succeeds, EXECUTE fails (division by zero). The+      -- statement is on the server under its cached name, so a later use on the+      -- same connection must hit the cache rather than re-issuing PARSE for an+      -- already-existing name ("prepared statement ... already exists").+      Scripts.onPreparableConnection config \connection -> do+        failure <- Connection.use connection (Session.statement 0 divStatement)+        failure `shouldSatisfy` isLeft+        success <- Connection.use connection (Session.statement 1 divStatement)+        success `shouldBe` Right 1++    it "works on an unpreparable connection" \config -> do+      Scripts.onUnpreparableConnection config \connection -> do+        result <- Connection.use connection (Session.statement (42 :: Int64) echoStatement)+        result `shouldBe` Right 42++  describe "Error Handling" do+    it "captures query errors correctly" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let statement =+              Statement.preparable+                "select true where 1 = any ($1) and $2"+                ( mconcat+                    [ fst >$< (Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8)))))),+                      snd >$< (Encoders.param (Encoders.nonNullable Encoders.text))+                    ]+                )+                (fmap (maybe False (const True)) (Decoders.rowMaybe (Decoders.column (Decoders.nonNullable Decoders.bool))))+        result <- Connection.use connection (Session.statement ([3, 7] :: [Int64], "a") statement)+        case result of+          Left (Errors.StatementSessionError _ _ _ _ _ (Errors.ServerStatementError _)) -> pure ()+          _ -> expectationFailure $ "Unexpected result: " <> show result++echoStatement :: Statement.Statement Int64 Int64+echoStatement =+  Statement.preparable+    "select $1"+    (Encoders.param (Encoders.nonNullable Encoders.int8))+    (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))++-- | Parses fine, but fails at execution time when given 0 (division by zero).+divStatement :: Statement.Statement Int64 Int64+divStatement =+  Statement.preparable+    "select 1 / $1"+    (Encoders.param (Encoders.nonNullable Encoders.int8))+    (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))
+ src/library-tests/Integration/Sharing/SessionSpec.hs view
@@ -0,0 +1,38 @@+module Integration.Sharing.SessionSpec (spec) where++import Data.Either+import Hasql.Connection qualified as Connection+import Helpers.Dsls.Execution qualified as Execution+import Helpers.Scripts qualified as Scripts+import Helpers.Statements qualified as Statements+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  it "Does not lose the server-side session state on timeout" \config -> do+    Scripts.onPreparableConnection config \connection -> do+      varname <- Execution.generateVarname+      result <- timeout 50_000 do+        Connection.use connection do+          Execution.sessionByParams (Statements.SetConfig varname "1" False)+          Execution.sessionByParams (Statements.Sleep 0.1)++      result `shouldBe` Nothing++      result <- Connection.use connection do+        Execution.sessionByParams (Statements.CurrentSetting varname True)++      result `shouldBe` Right (Just "1")++  it "Does not lose the server-side session state between uses" \config -> do+    Scripts.onPreparableConnection config \connection -> do+      varname <- Execution.generateVarname++      result <- Connection.use connection do+        Execution.sessionByParams (Statements.SetConfig varname "1" False)+      result `shouldSatisfy` isRight++      result <- Connection.use connection do+        Execution.sessionByParams (Statements.CurrentSetting varname True)+      result `shouldBe` Right (Just "1")
+ src/library-tests/Integration/Sharing/SpecHook.hs view
@@ -0,0 +1,30 @@+-- Docs: https://hspec.github.io/hspec-discover.html+module Integration.Sharing.SpecHook where++import Helpers.Scripts qualified as Scripts+import Pqi qualified+import Prelude+import Test.Hspec+import TestcontainersPostgresql qualified++type HookedSpec = SpecWith Scripts.ScopeParams++hook :: HookedSpec -> SpecWith Pqi.Adapter+hook hookedSpec =+  parallel do+    byDistro "postgres:9"+    byDistro "postgres:18"+  where+    byDistro tagName =+      describe (toList tagName)+        $ aroundAllWith+          ( \action adapter ->+              TestcontainersPostgresql.run+                TestcontainersPostgresql.Config+                  { tagName,+                    auth = TestcontainersPostgresql.CredentialsAuth "postgres" "postgres",+                    forwardLogs = False+                  }+                (\(host, port) -> action (adapter, host, port))+          )+          hookedSpec
+ src/library-tests/Integration/Sharing/StatementSpec.hs view
@@ -0,0 +1,436 @@+module Integration.Sharing.StatementSpec (spec) where++import Data.Either+import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Errors qualified as Errors+import Hasql.Pipeline qualified as Pipeline+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Dsls.Execution qualified as Execution+import Helpers.Scripts qualified as Scripts+import Helpers.Statements.CountPreparedStatements qualified as CountPreparedStatements+import Prelude+import Test.Hspec++spec :: SpecWith Scripts.ScopeParams+spec = do+  describe "Statement Functionality" do+    describe "Prepared statements" do+      it "allows reuse of the same prepared statement on different types" \config -> do+        Scripts.onPreparableConnection config \connection -> do+          let statement1 =+                Statement.preparable+                  "select $1"+                  (Encoders.param (Encoders.nonNullable Encoders.text))+                  (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)))+          let statement2 =+                Statement.preparable+                  "select $1"+                  (Encoders.param (Encoders.nonNullable Encoders.int8))+                  (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))++          result <-+            Connection.use connection do+              result1 <- Session.statement "ok" statement1+              result2 <- Session.statement (1 :: Int64) statement2+              return (result1, result2)+          result `shouldBe` Right ("ok", 1 :: Int64)++    describe "Row counting" do+      it "counts affected rows correctly" \config -> do+        tableName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          let dropTable = Statement.preparable ("drop table if exists " <> tableName) mempty Decoders.noResult+          let createTable = Statement.preparable ("create table " <> tableName <> " (id bigserial not null, name varchar not null, primary key (id))") mempty Decoders.noResult+          let insertRow = Statement.unpreparable ("insert into " <> tableName <> " (name) values ('a')") mempty Decoders.noResult+          let deleteRows = Statement.unpreparable ("delete from " <> tableName) mempty Decoders.rowsAffected++          result <-+            Connection.use connection do+              Session.statement () dropTable+              Session.statement () createTable+              replicateM_ 100 (Session.statement () insertRow)+              affectedRows <- Session.statement () deleteRows+              Session.statement () dropTable+              return affectedRows+          result `shouldBe` Right 100++    describe "Auto-incremented columns" do+      it "returns auto-incremented column results" \config -> do+        tableName <- Scripts.generateSymname+        Scripts.onPreparableConnection config \connection -> do+          let dropTable = Statement.preparable ("drop table if exists " <> tableName) mempty Decoders.noResult+          let createTable = Statement.preparable ("create table " <> tableName <> " (id bigserial not null, name varchar not null, primary key (id))") mempty Decoders.noResult+          let insertRow = Statement.unpreparable ("insert into " <> tableName <> " (name) values ('a') returning id") mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))+          let insertRow2 = Statement.unpreparable ("insert into " <> tableName <> " (name) values ('b') returning id") mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))++          result <-+            Connection.use connection do+              Session.statement () dropTable+              Session.statement () createTable+              id1 <- Session.statement () insertRow+              id2 <- Session.statement () insertRow2+              Session.statement () dropTable+              return (id1, id2)+          result `shouldBe` Right (1 :: Int64, 2 :: Int64)++    describe "List decoding" do+      it "decodes lists correctly" \config -> do+        Scripts.onPreparableConnection config \connection -> do+          let statement =+                Statement.preparable+                  "values (1 :: int8, 2 :: int8), (3,4), (5,6)"+                  mempty+                  (Decoders.rowList ((,) <$> (Decoders.column (Decoders.nonNullable Decoders.int8)) <*> (Decoders.column (Decoders.nonNullable Decoders.int8))))+          result <- Connection.use connection (Session.statement () statement)+          result `shouldBe` Right [(1 :: Int64, 2 :: Int64), (3, 4), (5, 6)]++    describe "IN simulation" do+      it "works with arrays" \config -> do+        Scripts.onPreparableConnection config \connection -> do+          let statement =+                Statement.preparable+                  "select true where 1 = any ($1)"+                  (Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8))))))+                  (fmap (maybe False (const True)) (Decoders.rowMaybe (Decoders.column (Decoders.nonNullable Decoders.bool))))+          result <- Connection.use connection do+            result1 <- Session.statement ([1, 2] :: [Int64]) statement+            result2 <- Session.statement ([2, 3] :: [Int64]) statement+            return (result1, result2)+          result `shouldBe` Right (True, False)++    describe "NOT IN simulation" do+      it "works with arrays" \config -> do+        Scripts.onPreparableConnection config \connection -> do+          let statement =+                Statement.preparable+                  "select true where 3 <> all ($1)"+                  (Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8))))))+                  (fmap (maybe False (const True)) (Decoders.rowMaybe (Decoders.column (Decoders.nonNullable Decoders.bool))))+          result <- Connection.use connection do+            result1 <- Session.statement ([1, 2] :: [Int64]) statement+            result2 <- Session.statement ([2, 3] :: [Int64]) statement+            return (result1, result2)+          result `shouldBe` Right (True, False)++    describe "Preparation" do+      it "Do get prepared when configuration allows" \config -> do+        Scripts.onPreparableConnection config \connection -> do+          -- Execute a preparable statement+          result <-+            Connection.use connection do+              Session.statement+                ()+                ( Statement.preparable+                    "select 1 + 1"+                    mempty+                    (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))+                )+          result `shouldBe` Right 2++          -- Query pg_prepared_statements to verify it was prepared+          preparedCount <-+            Connection.use connection do+              Execution.sessionByParams CountPreparedStatements.CountPreparedStatements++          preparedCount `shouldSatisfy` \case+            Right count -> count > 0+            Left _ -> False++      it "Do not get prepared when configuration forbids it" \config -> do+        Scripts.onUnpreparableConnection config \connection -> do+          -- Execute a statement marked as preparable+          result <-+            Connection.use connection do+              Session.statement+                ()+                ( Statement.preparable+                    "select 2 + 2"+                    mempty+                    (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))+                )+          result `shouldBe` Right 4++          -- Query pg_prepared_statements to verify it was NOT prepared+          preparedCount <-+            Connection.use connection do+              Execution.sessionByParams CountPreparedStatements.CountPreparedStatements++          preparedCount `shouldBe` Right 0++    describe "Cache resilience after a failing prepared statement" do+      describe "Session" do+        it "Failing statements don't cause misses in updates of the prepared statement cache" \config -> do+          Scripts.onPreparableConnection config \connection -> do+            -- Run an intentionally failing prepared statement to set the condition of the bug.+            result <- Connection.use connection do+              Session.statement+                ()+                ( Statement.preparable+                    "select null"+                    mempty+                    (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))+                )+            shouldBe (isLeft result) True+            -- Run a succeeding prepared statement to see if the cache is still in a good state.+            result <- Connection.use connection do+              Session.statement+                ()+                ( Statement.preparable+                    "select 1"+                    mempty+                    (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))+                )+            -- If there is an error the cache got corrupted.+            case result of+              Right _ ->+                pure ()+              Left result ->+                expectationFailure ("Unexpected error: " <> show result)++        it "Syntax errors in prepared statements don't corrupt the cache for subsequent uses of the same statement" \config -> do+          Scripts.onPreparableConnection config \connection -> do+            let brokenStatement =+                  Statement.preparable+                    "S"+                    mempty+                    Decoders.noResult+            -- First run: syntax error.+            result1 <- Connection.use connection do+              Session.statement () brokenStatement+            error1 <- case result1 of+              Left error1 -> pure error1+              Right _ -> fail "First run unexpectedly succeeded"++            -- Second run of the same statement: should also produce a syntax error,+            -- not "prepared statement does not exist".+            result2 <- Connection.use connection do+              Session.statement () brokenStatement+            error2 <- case result2 of+              Left error2 -> pure error2+              Right _ -> fail "Second run unexpectedly succeeded"+            shouldBe error2 error1++      describe "Pipeline" do+        it "Failing pipeline statements don't cause misses in updates of the prepared statement cache" \config -> do+          Scripts.onPreparableConnection config \connection -> do+            -- Run an intentionally failing prepared statement in a pipeline to set the condition of the bug.+            result <- Connection.use connection do+              Session.pipeline do+                Pipeline.statement+                  ()+                  ( Statement.preparable+                      "select null :: int4"+                      mempty+                      (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))+                  )+            case result of+              Right val ->+                expectationFailure ("First statement succeeded unexpectedly: " <> show val)+              Left _ ->+                pure ()++            -- Run a succeeding prepared statement in a pipeline to see if the cache is still in a good state.+            result <- Connection.use connection do+              Session.pipeline do+                Pipeline.statement+                  ()+                  ( Statement.preparable+                      "select 1"+                      mempty+                      (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))+                  )+            -- If there is an error the cache got corrupted.+            case result of+              Right _ ->+                pure ()+              Left result ->+                expectationFailure ("Unexpected error: " <> show result)++        it "Syntax errors in pipeline prepared statements don't corrupt the cache for subsequent uses of the same statement" \config -> do+          Scripts.onPreparableConnection config \connection -> do+            let brokenStatement =+                  Statement.preparable+                    "S"+                    mempty+                    Decoders.noResult+            -- First run: syntax error.+            result1 <- Connection.use connection do+              Session.pipeline (Pipeline.statement () brokenStatement)+            shouldBe (isLeft result1) True+            -- Second run of the same statement: should also produce a syntax error,+            -- not "prepared statement does not exist".+            result2 <- Connection.use connection do+              Session.pipeline (Pipeline.statement () brokenStatement)+            case result2 of+              Left (Errors.StatementSessionError _ _ _ _ _ (Errors.ServerStatementError (Errors.ServerError "42601" _ _ _ _))) ->+                pure ()+              Left other ->+                expectationFailure ("Unexpected error on second run: " <> show other)+              Right _ ->+                expectationFailure "Second run unexpectedly succeeded"++        it "A pipeline with a broken statement first and a valid one after it can be retried with the same syntax error" \config -> do+          Scripts.onPreparableConnection config \connection -> do+            let broken = Statement.preparable "S" mempty Decoders.noResult+                ok = Statement.preparable "select 1" mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))+            result1 <- Connection.use connection do+              Session.pipeline do+                (,)+                  <$> Pipeline.statement () broken+                  <*> Pipeline.statement () ok+            error1 <- case result1 of+              Left error1 -> pure error1+              Right _ -> fail "First run unexpectedly succeeded"++            result2 <- Connection.use connection do+              Session.pipeline do+                (,)+                  <$> Pipeline.statement () broken+                  <*> Pipeline.statement () ok+            error2 <- case result2 of+              Left error2 -> pure error2+              Right _ -> fail "Second run unexpectedly succeeded"+            shouldBe error2 error1++        it "A valid statement after a broken pipeline statement still prepares in a later pipeline" \config -> do+          Scripts.onPreparableConnection config \connection -> do+            let broken = Statement.preparable "S" mempty Decoders.noResult+                trailing = Statement.preparable "select 1" mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))+            result1 <- Connection.use connection do+              Session.pipeline do+                (,)+                  <$> Pipeline.statement () broken+                  <*> Pipeline.statement () trailing+            shouldBe (isLeft result1) True++            result2 <- Connection.use connection do+              Session.pipeline do+                Pipeline.statement () trailing+            case result2 of+              Right val -> val `shouldBe` 1+              Left err -> expectationFailure ("Unexpected error on follow-up pipeline: " <> show err)++        it "A pipeline with successful statements followed by a broken one can be retried without 'already exists' errors" \config -> do+          Scripts.onPreparableConnection config \connection -> do+            let ok1 = Statement.preparable "select 1" mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))+                ok2 = Statement.preparable "select 2" mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))+                broken = Statement.preparable "S" mempty Decoders.noResult+            -- First run: pipeline with two OK statements and a broken one at the end.+            result1 <- Connection.use connection do+              Session.pipeline do+                (,,)+                  <$> Pipeline.statement () ok1+                  <*> Pipeline.statement () ok2+                  <*> Pipeline.statement () broken+            error1 <- case result1 of+              Left error1 -> pure error1+              Right _ -> fail "First run unexpectedly succeeded"++            -- Second run of the same pipeline: must fail with the SAME syntax error,+            -- not "prepared statement already exists".+            result2 <- Connection.use connection do+              Session.pipeline do+                (,,)+                  <$> Pipeline.statement () ok1+                  <*> Pipeline.statement () ok2+                  <*> Pipeline.statement () broken+            error2 <- case result2 of+              Left error2 -> pure error2+              Right _ -> fail "Second run unexpectedly succeeded"+            shouldBe error2 error1++            -- Also, a standalone valid statement should still work afterwards.+            result3 <- Connection.use connection do+              Session.statement () ok1+            case result3 of+              Right val -> val `shouldBe` 1+              Left err -> expectationFailure ("Unexpected error on standalone statement: " <> show err)++        it "A pipeline with a broken statement in the middle can be retried without 'already exists' errors" \config -> do+          Scripts.onPreparableConnection config \connection -> do+            let ok1 = Statement.preparable "select 1" mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))+                broken = Statement.preparable "S" mempty Decoders.noResult+                ok2 = Statement.preparable "select 2" mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))+            -- First run: pipeline with broken statement in the middle.+            result1 <- Connection.use connection do+              Session.pipeline do+                (,,)+                  <$> Pipeline.statement () ok1+                  <*> Pipeline.statement () broken+                  <*> Pipeline.statement () ok2+            shouldBe (isLeft result1) True++            -- Second run of the same pipeline: must fail with the same syntax error.+            result2 <- Connection.use connection do+              Session.pipeline do+                (,,)+                  <$> Pipeline.statement () ok1+                  <*> Pipeline.statement () broken+                  <*> Pipeline.statement () ok2+            case result2 of+              Left (Errors.StatementSessionError _ _ _ _ _ (Errors.ServerStatementError (Errors.ServerError "42601" _ _ _ _))) ->+                pure ()+              Left other ->+                expectationFailure ("Unexpected error on second run: " <> show other)+              Right _ ->+                expectationFailure "Second run unexpectedly succeeded"++            -- Standalone valid statements should still work afterwards.+            result3 <- Connection.use connection do+              Session.statement () ok1+            case result3 of+              Right val -> val `shouldBe` 1+              Left err -> expectationFailure ("Unexpected error on standalone ok1: " <> show err)+            result4 <- Connection.use connection do+              Session.statement () ok2+            case result4 of+              Right val -> val `shouldBe` 2+              Left err -> expectationFailure ("Unexpected error on standalone ok2: " <> show err)++    describe "Decoder compatibility cache" $ parallel do+      decoderCompatibilityCacheByExecutor "Session" (Session.statement ())+      decoderCompatibilityCacheByExecutor "Pipeline" (Session.pipeline . Pipeline.statement ())++decoderCompatibilityCacheByExecutor ::+  Text ->+  (forall a. (Show a) => Statement.Statement () a -> Session.Session a) ->+  SpecWith Scripts.ScopeParams+decoderCompatibilityCacheByExecutor executorName executor = do+  describe (toList executorName) do+    it "does not hide decoder mismatches from a previously verified statement" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        let sql = "select 1::int8, 'text'::text"+            correctStatement =+              Statement.preparable+                sql+                mempty+                ( Decoders.singleRow+                    ( (,)+                        <$> Decoders.column (Decoders.nonNullable Decoders.int8)+                        <*> Decoders.column (Decoders.nonNullable Decoders.text)+                    )+                )+            mismatchingStatement =+              Statement.preparable+                sql+                mempty+                ( Decoders.singleRow+                    ( (,)+                        <$> Decoders.column (Decoders.nonNullable Decoders.int8)+                        <*> Decoders.column (Decoders.nonNullable Decoders.int8)+                    )+                )+        firstResult <- Connection.use connection (executor correctStatement)+        shouldBe firstResult (Right (1, "text"))+        secondResult <- Connection.use connection (executor mismatchingStatement)+        case secondResult of+          Left (Errors.StatementSessionError _ _ _ _ _ (Errors.UnexpectedColumnTypeStatementError column expected actual)) -> do+            shouldBe column 1+            (expected, actual) `shouldBe` (20, 25)+          Left err ->+            expectationFailure ("Unexpected type of error: " <> show err)+          result ->+            expectationFailure ("Not an error: " <> show result)
+ src/library-tests/Integration/SpecHook.hs view
@@ -0,0 +1,8 @@+module Integration.SpecHook (hook) where++import Helpers.Adapters qualified as Adapters+import Pqi qualified+import Test.Hspec++hook :: SpecWith Pqi.Adapter -> Spec+hook = Adapters.hook
− src/library-tests/Isolated/ByUnit/Connection/AcquireSpec.hs 
@@ -1,215 +0,0 @@-module Isolated.ByUnit.Connection.AcquireSpec (spec) where--import Hasql.Connection qualified-import Hasql.Connection qualified as Connection-import Hasql.Connection.Settings qualified as Settings-import Hasql.Errors qualified as Errors-import Test.Hspec-import TestcontainersPostgresql qualified-import Prelude--spec :: Spec-spec = do-  describe "By result" do-    describe "Left" do-      describe "Networking" do-        it "Fails on server missing" do-          let settings =-                Settings.hostAndPort "nopostgresql.net" 5432-          result <- Connection.acquire settings-          case result of-            Right conn -> do-              Connection.release conn-              expectationFailure "Expected connection to fail with authentication error, but it succeeded"-            Left (Errors.NetworkingConnectionError _) ->-              pure ()-            Left err ->-              expectationFailure ("Expected NetworkingConnectionError, but got: " <> show err)--  describe "postgres:9" do-    it "Succeeds" do-      TestcontainersPostgresql.run-        TestcontainersPostgresql.Config-          { tagName = "postgres:9",-            auth = TestcontainersPostgresql.CredentialsAuth "postgres" "postgres",-            forwardLogs = False-          }-        \(host, port) -> do-          let settings =-                mconcat-                  [ Settings.hostAndPort host port,-                    Settings.user "postgres",-                    Settings.password "postgres",-                    Settings.dbname "postgres"-                  ]-          result <- Connection.acquire settings-          case result of-            Right conn -> do-              Connection.release conn-            Left err -> do-              expectationFailure ("Expected connection to succeed, but it failed with error: " <> show err)--  describe "postgres:18" do-    it "Succeeds" do-      TestcontainersPostgresql.run-        TestcontainersPostgresql.Config-          { tagName = "postgres:18",-            auth = TestcontainersPostgresql.CredentialsAuth "postgres" "postgres",-            forwardLogs = False-          }-        \(host, port) -> do-          let settings =-                mconcat-                  [ Settings.hostAndPort host port,-                    Settings.user "postgres",-                    Settings.password "postgres",-                    Settings.dbname "postgres"-                  ]-          result <- Connection.acquire settings-          case result of-            Right conn -> do-              Connection.release conn-            Left err -> do-              expectationFailure ("Expected connection to succeed, but it failed with error: " <> show err)--    it "Fails with authentication error on incorrect password" do-      TestcontainersPostgresql.run-        TestcontainersPostgresql.Config-          { tagName = "postgres:18",-            auth = TestcontainersPostgresql.CredentialsAuth "postgres" "postgres",-            forwardLogs = False-          }-        \(host, port) -> do-          let settings =-                mconcat-                  [ Settings.hostAndPort host port,-                    Settings.user "postgres",-                    Settings.password "",-                    Settings.dbname "postgres1"-                  ]-          result <- Connection.acquire settings-          case result of-            Right conn -> do-              Connection.release conn-              expectationFailure "Expected connection to fail with authentication error, but it succeeded"-            Left (Errors.AuthenticationConnectionError _) ->-              pure ()-            Left err ->-              expectationFailure ("Expected AuthenticationConnectionError, but got: " <> show err)--    it "Fails with authentication error on incorrect user" do-      TestcontainersPostgresql.run-        TestcontainersPostgresql.Config-          { tagName = "postgres:18",-            auth = TestcontainersPostgresql.CredentialsAuth "postgres" "postgres",-            forwardLogs = False-          }-        \(host, port) -> do-          let settings =-                mconcat-                  [ Settings.hostAndPort host port,-                    Settings.user "postgres1",-                    Settings.password "",-                    Settings.dbname "postgres"-                  ]-          result <- Connection.acquire settings-          case result of-            Right conn -> do-              Connection.release conn-              expectationFailure "Expected connection to fail with authentication error, but it succeeded"-            Left (Errors.AuthenticationConnectionError _) ->-              pure ()-            Left err ->-              expectationFailure ("Expected AuthenticationConnectionError, but got: " <> show err)--  describe "postgres:9" do-    byDistro "postgres:9"--  describe "postgres:18" do-    byDistro "postgres:18"--byDistro :: Text -> Spec-byDistro tagName = do-  let itConnects :: Text -> Text -> Spec-      itConnects username password =-        describe ("username: " <> toList username) do-          describe ("password: " <> toList password) do-            it "connects" do-              TestcontainersPostgresql.run-                TestcontainersPostgresql.Config-                  { tagName,-                    auth = TestcontainersPostgresql.CredentialsAuth username password,-                    forwardLogs = False-                  }-                ( \(host, port) -> do-                    result <--                      Hasql.Connection.acquire-                        ( mconcat-                            [ Settings.hostAndPort host port,-                              Settings.user username,-                              Settings.password password-                            ]-                        )-                    case result of-                      Left err -> expectationFailure ("Connection failed: " <> show err <> ". Host: " <> show host <> ", port: " <> show port)-                      Right connection -> do-                        Hasql.Connection.release connection-                        pure ()-                )-   in do-        itConnects "user" "new password"-        itConnects "user" "new\\password"-        itConnects "user" "new'password"-        itConnects "new user" "password"--  describe "Connection errors" do-    describe "NetworkingConnectionError" do-      it "is reported for invalid host" do-        result <--          Hasql.Connection.acquire-            ( mconcat-                [ Settings.hostAndPort "nonexistent.invalid.host" 5432,-                  Settings.user "postgres",-                  Settings.password ""-                ]-            )-        case result of-          Left (Errors.NetworkingConnectionError _) -> pure ()-          Left err -> expectationFailure ("Expected NetworkingConnectionError, got: " <> show err)-          Right _conn -> expectationFailure "Expected connection to fail"--      it "is reported for connection refused" do-        result <--          Hasql.Connection.acquire-            ( mconcat-                [ Settings.hostAndPort "127.0.0.1" 1,-                  Settings.user "postgres",-                  Settings.password ""-                ]-            )-        case result of-          Left (Errors.NetworkingConnectionError _) -> pure ()-          Left err -> expectationFailure ("Expected NetworkingConnectionError, got: " <> show err)-          Right _conn -> expectationFailure "Expected connection to fail"--    describe "AuthenticationConnectionError" do-      it "is reported for invalid credentials" do-        TestcontainersPostgresql.run-          TestcontainersPostgresql.Config-            { tagName,-              auth = TestcontainersPostgresql.CredentialsAuth "password" "correctpassword",-              forwardLogs = False-            }-          \(host, port) -> do-            result <--              Hasql.Connection.acquire-                ( mconcat-                    [ Settings.hostAndPort host port,-                      Settings.user "incorrectuser",-                      Settings.password "incorrectpassword"-                    ]-                )-            case result of-              Left (Errors.AuthenticationConnectionError _) -> pure ()-              Left err -> expectationFailure ("Expected AuthenticationConnectionError, got: " <> show err)-              Right _conn -> expectationFailure "Expected connection to fail with authentication error"
− src/library-tests/Pure/ByUnit/ErrorsSpec.hs 
@@ -1,247 +0,0 @@-module Pure.ByUnit.ErrorsSpec (spec) where--import Data.HashSet qualified as HashSet-import Hasql.Errors qualified as Errors-import Test.Hspec-import Prelude--spec :: Spec-spec = do-  describe "ConnectionError" do-    describe "toMessage" do-      it "renders NetworkingConnectionError" do-        (Errors.toMessage (Errors.NetworkingConnectionError "timeout"))-          `shouldBe` "Networking error while connecting to the database"--      it "renders AuthenticationConnectionError" do-        (Errors.toMessage (Errors.AuthenticationConnectionError "invalid password"))-          `shouldBe` "Authentication error while connecting to the database"--    describe "toDetails" do-      it "includes reason for NetworkingConnectionError" do-        (Errors.toDetails (Errors.NetworkingConnectionError "connection timeout"))-          `shouldBe` [("reason", "connection timeout")]--    describe "isTransient" do-      it "NetworkingConnectionError is transient" do-        (Errors.isTransient (Errors.NetworkingConnectionError "timeout"))-          `shouldBe` True--      it "AuthenticationConnectionError is not transient" do-        (Errors.isTransient (Errors.AuthenticationConnectionError "invalid password"))-          `shouldBe` False--    describe "toDetailedText" do-      it "renders NetworkingConnectionError with details" do-        (Errors.toDetailedText (Errors.NetworkingConnectionError "connection refused"))-          `shouldBe` "Networking error while connecting to the database\n\-                     \  reason: connection refused"--  describe "ServerError" do-    describe "toMessage" do-      it "renders ServerError" do-        (Errors.toMessage (Errors.ServerError "42P01" "relation does not exist" Nothing Nothing Nothing))-          `shouldBe` "Server error"--    describe "toDetails" do-      it "includes all fields when provided" do-        (Errors.toDetails (Errors.ServerError "42P01" "relation \"users\" does not exist" (Just "The relation users does not exist.") (Just "Check your table name.") (Just 15)))-          `shouldBe` [ ("code", "42P01"),-                       ("message", "relation \"users\" does not exist"),-                       ("detail", "The relation users does not exist."),-                       ("hint", "Check your table name."),-                       ("position", "15")-                     ]--      it "excludes optional fields when not provided" do-        (Errors.toDetails (Errors.ServerError "42601" "syntax error" Nothing Nothing Nothing))-          `shouldBe` [ ("code", "42601"),-                       ("message", "syntax error")-                     ]--    describe "toDetailedText" do-      it "renders ServerError with all details" do-        (Errors.toDetailedText (Errors.ServerError "42P01" "relation \"users\" does not exist" (Just "The relation users does not exist.") (Just "Check your table name.") (Just 15)))-          `shouldBe` "Server error\n\-                     \  code: 42P01\n\-                     \  message: relation \"users\" does not exist\n\-                     \  detail: The relation users does not exist.\n\-                     \  hint: Check your table name.\n\-                     \  position: 15"--  describe "CellError" do-    describe "toMessage" do-      it "renders UnexpectedNullCellError" do-        (Errors.toMessage Errors.UnexpectedNullCellError)-          `shouldBe` "Unexpected null value"--      it "renders DeserializationCellError" do-        (Errors.toMessage (Errors.DeserializationCellError "invalid integer format"))-          `shouldBe` "Failed to deserialize cell"--    describe "toDetails" do-      it "includes no details for UnexpectedNullCellError" do-        (Errors.toDetails Errors.UnexpectedNullCellError)-          `shouldBe` []--      it "includes reason for DeserializationCellError" do-        (Errors.toDetails (Errors.DeserializationCellError "expected integer, got text"))-          `shouldBe` [("reason", "expected integer, got text")]--    describe "toDetailedText" do-      it "renders DeserializationCellError with details" do-        (Errors.toDetailedText (Errors.DeserializationCellError "invalid timestamp format"))-          `shouldBe` "Failed to deserialize cell\n\-                     \  reason: invalid timestamp format"--  describe "RowError" do-    describe "toMessage" do-      it "renders CellRowError with nested message" do-        (Errors.toMessage (Errors.CellRowError 2 23 Errors.UnexpectedNullCellError))-          `shouldBe` "Unexpected null value"--      it "renders RefinementRowError" do-        (Errors.toMessage (Errors.RefinementRowError "age must be positive"))-          `shouldBe` "Refinement error"--    describe "toDetails" do-      it "includes column index, oid, and nested cell error details" do-        (Errors.toDetails (Errors.CellRowError 3 1043 (Errors.DeserializationCellError "invalid format")))-          `shouldBe` [ ("columnIndex", "3"),-                       ("oid", "1043"),-                       ("reason", "invalid format")-                     ]--    describe "toDetailedText" do-      it "renders CellRowError with all details" do-        (Errors.toDetailedText (Errors.CellRowError 2 1043 (Errors.DeserializationCellError "invalid text encoding")))-          `shouldBe` "Failed to deserialize cell\n  columnIndex: 2\n  oid: 1043\n  reason: invalid text encoding"--  describe "StatementError" do-    describe "toMessage" do-      it "renders ServerStatementError with nested message" do-        (Errors.toMessage (Errors.ServerStatementError (Errors.ServerError "42P01" "relation does not exist" Nothing Nothing Nothing)))-          `shouldBe` "Server error"--      it "renders UnexpectedRowCountStatementError" do-        (Errors.toMessage (Errors.UnexpectedRowCountStatementError 1 1 0))-          `shouldBe` "Unexpected number of rows"--      it "renders UnexpectedColumnTypeStatementError" do-        (Errors.toMessage (Errors.UnexpectedColumnTypeStatementError 1 23 1043))-          `shouldBe` "Unexpected column type"--    describe "toDetails" do-      it "includes expected and actual for UnexpectedRowCountStatementError" do-        (Errors.toDetails (Errors.UnexpectedRowCountStatementError 1 1 5))-          `shouldBe` [("expectedMin", "1"), ("expectedMax", "1"), ("actual", "5")]--      it "includes column index and oids for UnexpectedColumnTypeStatementError" do-        (Errors.toDetails (Errors.UnexpectedColumnTypeStatementError 2 23 1043))-          `shouldBe` [("columnIndex", "2"), ("expectedOid", "23"), ("actualOid", "1043")]--    describe "toDetailedText" do-      it "renders UnexpectedRowCountStatementError with details" do-        (Errors.toDetailedText (Errors.UnexpectedRowCountStatementError 1 1 0))-          `shouldBe` "Unexpected number of rows\n  expectedMin: 1\n  expectedMax: 1\n  actual: 0"--      it "renders RowStatementError with nested details" do-        (Errors.toDetailedText (Errors.RowStatementError 3 (Errors.CellRowError 1 23 Errors.UnexpectedNullCellError)))-          `shouldBe` "Unexpected null value\n  rowIndex: 3\n  columnIndex: 1\n  oid: 23"--  describe "SessionError" do-    describe "toMessage" do-      it "renders StatementSessionError with nested message" do-        (Errors.toMessage (Errors.StatementSessionError 1 0 "SELECT 1" [] True (Errors.UnexpectedRowCountStatementError 1 1 0)))-          `shouldBe` "Unexpected number of rows"--      it "renders ConnectionSessionError" do-        (Errors.toMessage (Errors.ConnectionSessionError "connection lost"))-          `shouldBe` "Connection error"--      it "renders MissingTypesSessionError" do-        (Errors.toMessage (Errors.MissingTypesSessionError (HashSet.fromList [(Just "public", "custom_type"), (Nothing, "enum_type")])))-          `shouldBe` "Types not found in database"--    describe "toDetails" do-      it "includes statement context and nested error details" do-        (Errors.toDetails (Errors.StatementSessionError 3 1 "SELECT * FROM users WHERE id = $1" ["42"] True (Errors.ServerStatementError (Errors.ServerError "42P01" "relation does not exist" Nothing Nothing Nothing))))-          `shouldBe` [ ("totalStatements", "3"),-                       ("statementIndex", "1"),-                       ("sql", "SELECT * FROM users WHERE id = $1"),-                       ("parameters", "42"),-                       ("prepared", "true"),-                       ("code", "42P01"),-                       ("message", "relation does not exist")-                     ]--      it "includes multiple parameters" do-        (Errors.toDetails (Errors.StatementSessionError 1 0 "INSERT INTO users (name, age) VALUES ($1, $2)" ["Alice", "30"] False (Errors.UnexpectedRowCountStatementError 1 1 0)))-          `shouldBe` [ ("totalStatements", "1"),-                       ("statementIndex", "0"),-                       ("sql", "INSERT INTO users (name, age) VALUES ($1, $2)"),-                       ("parameters", "Alice, 30"),-                       ("prepared", "false"),-                       ("expectedMin", "1"),-                       ("expectedMax", "1"),-                       ("actual", "0")-                     ]--    describe "isTransient" do-      it "ConnectionSessionError is transient" do-        (Errors.isTransient (Errors.ConnectionSessionError "connection lost"))-          `shouldBe` True--      it "StatementSessionError is not transient" do-        (Errors.isTransient (Errors.StatementSessionError 1 0 "SELECT 1" [] True (Errors.UnexpectedRowCountStatementError 1 1 0)))-          `shouldBe` False--    describe "toDetailedText" do-      it "renders StatementSessionError with all context" do-        (Errors.toDetailedText (Errors.StatementSessionError 1 0 "SELECT * FROM users" [] True (Errors.UnexpectedRowCountStatementError 1 1 10)))-          `shouldBe` "Unexpected number of rows\n\-                     \  totalStatements: 1\n\-                     \  statementIndex: 0\n\-                     \  sql: SELECT * FROM users\n\-                     \  parameters:\n\-                     \  prepared: true\n\-                     \  expectedMin: 1\n\-                     \  expectedMax: 1\n\-                     \  actual: 10"--  describe "toDetailedText with multiline values" do-    it "indents multiline detail values correctly" do-      (Errors.toDetailedText (Errors.ServerError "42601" "syntax error" (Just "Line 1: syntax error\nLine 2: near unexpected token\nLine 3: suggestion here") Nothing Nothing))-        `shouldBe` "Server error\n\-                   \  code: 42601\n\-                   \  message: syntax error\n\-                   \  detail:\n\-                   \    Line 1: syntax error\n\-                   \    Line 2: near unexpected token\n\-                   \    Line 3: suggestion here"--    it "indents multiline hint values correctly" do-      (Errors.toDetailedText (Errors.ServerError "42P01" "relation not found" Nothing (Just "Perhaps you meant:\n  users\n  user_accounts\n  user_profiles") Nothing))-        `shouldBe` "Server error\n\-                   \  code: 42P01\n\-                   \  message: relation not found\n\-                   \  hint:\n\-                   \    Perhaps you meant:\n\-                   \      users\n\-                   \      user_accounts\n\-                   \      user_profiles"--    it "handles multiline SQL in StatementSessionError" do-      (Errors.toDetailedText (Errors.StatementSessionError 1 0 "SELECT *\nFROM users\nWHERE id = $1" ["1"] False (Errors.UnexpectedRowCountStatementError 1 1 0)))-        `shouldBe` "Unexpected number of rows\n\-                   \  totalStatements: 1\n\-                   \  statementIndex: 0\n\-                   \  sql:\n\-                   \    SELECT *\n\-                   \    FROM users\n\-                   \    WHERE id = $1\n\-                   \  parameters: 1\n\-                   \  prepared: false\n\-                   \  expectedMin: 1\n\-                   \  expectedMax: 1\n\-                   \  actual: 0"
+ src/library-tests/Pure/ErrorsSpec.hs view
@@ -0,0 +1,247 @@+module Pure.ErrorsSpec (spec) where++import Data.HashSet qualified as HashSet+import Hasql.Errors qualified as Errors+import Prelude+import Test.Hspec++spec :: Spec+spec = do+  describe "ConnectionError" do+    describe "toMessage" do+      it "renders NetworkingConnectionError" do+        (Errors.toMessage (Errors.NetworkingConnectionError "timeout"))+          `shouldBe` "Networking error while connecting to the database"++      it "renders AuthenticationConnectionError" do+        (Errors.toMessage (Errors.AuthenticationConnectionError "invalid password"))+          `shouldBe` "Authentication error while connecting to the database"++    describe "toDetails" do+      it "includes reason for NetworkingConnectionError" do+        (Errors.toDetails (Errors.NetworkingConnectionError "connection timeout"))+          `shouldBe` [("reason", "connection timeout")]++    describe "isTransient" do+      it "NetworkingConnectionError is transient" do+        (Errors.isTransient (Errors.NetworkingConnectionError "timeout"))+          `shouldBe` True++      it "AuthenticationConnectionError is not transient" do+        (Errors.isTransient (Errors.AuthenticationConnectionError "invalid password"))+          `shouldBe` False++    describe "toDetailedText" do+      it "renders NetworkingConnectionError with details" do+        (Errors.toDetailedText (Errors.NetworkingConnectionError "connection refused"))+          `shouldBe` "Networking error while connecting to the database\n\+                     \  reason: connection refused"++  describe "ServerError" do+    describe "toMessage" do+      it "renders ServerError" do+        (Errors.toMessage (Errors.ServerError "42P01" "relation does not exist" Nothing Nothing Nothing))+          `shouldBe` "Server error"++    describe "toDetails" do+      it "includes all fields when provided" do+        (Errors.toDetails (Errors.ServerError "42P01" "relation \"users\" does not exist" (Just "The relation users does not exist.") (Just "Check your table name.") (Just 15)))+          `shouldBe` [ ("code", "42P01"),+                       ("message", "relation \"users\" does not exist"),+                       ("detail", "The relation users does not exist."),+                       ("hint", "Check your table name."),+                       ("position", "15")+                     ]++      it "excludes optional fields when not provided" do+        (Errors.toDetails (Errors.ServerError "42601" "syntax error" Nothing Nothing Nothing))+          `shouldBe` [ ("code", "42601"),+                       ("message", "syntax error")+                     ]++    describe "toDetailedText" do+      it "renders ServerError with all details" do+        (Errors.toDetailedText (Errors.ServerError "42P01" "relation \"users\" does not exist" (Just "The relation users does not exist.") (Just "Check your table name.") (Just 15)))+          `shouldBe` "Server error\n\+                     \  code: 42P01\n\+                     \  message: relation \"users\" does not exist\n\+                     \  detail: The relation users does not exist.\n\+                     \  hint: Check your table name.\n\+                     \  position: 15"++  describe "CellError" do+    describe "toMessage" do+      it "renders UnexpectedNullCellError" do+        (Errors.toMessage Errors.UnexpectedNullCellError)+          `shouldBe` "Unexpected null value"++      it "renders DeserializationCellError" do+        (Errors.toMessage (Errors.DeserializationCellError "invalid integer format"))+          `shouldBe` "Failed to deserialize cell"++    describe "toDetails" do+      it "includes no details for UnexpectedNullCellError" do+        (Errors.toDetails Errors.UnexpectedNullCellError)+          `shouldBe` []++      it "includes reason for DeserializationCellError" do+        (Errors.toDetails (Errors.DeserializationCellError "expected integer, got text"))+          `shouldBe` [("reason", "expected integer, got text")]++    describe "toDetailedText" do+      it "renders DeserializationCellError with details" do+        (Errors.toDetailedText (Errors.DeserializationCellError "invalid timestamp format"))+          `shouldBe` "Failed to deserialize cell\n\+                     \  reason: invalid timestamp format"++  describe "RowError" do+    describe "toMessage" do+      it "renders CellRowError with nested message" do+        (Errors.toMessage (Errors.CellRowError 2 23 Errors.UnexpectedNullCellError))+          `shouldBe` "Unexpected null value"++      it "renders RefinementRowError" do+        (Errors.toMessage (Errors.RefinementRowError "age must be positive"))+          `shouldBe` "Refinement error"++    describe "toDetails" do+      it "includes column index, oid, and nested cell error details" do+        (Errors.toDetails (Errors.CellRowError 3 1043 (Errors.DeserializationCellError "invalid format")))+          `shouldBe` [ ("columnIndex", "3"),+                       ("oid", "1043"),+                       ("reason", "invalid format")+                     ]++    describe "toDetailedText" do+      it "renders CellRowError with all details" do+        (Errors.toDetailedText (Errors.CellRowError 2 1043 (Errors.DeserializationCellError "invalid text encoding")))+          `shouldBe` "Failed to deserialize cell\n  columnIndex: 2\n  oid: 1043\n  reason: invalid text encoding"++  describe "StatementError" do+    describe "toMessage" do+      it "renders ServerStatementError with nested message" do+        (Errors.toMessage (Errors.ServerStatementError (Errors.ServerError "42P01" "relation does not exist" Nothing Nothing Nothing)))+          `shouldBe` "Server error"++      it "renders UnexpectedRowCountStatementError" do+        (Errors.toMessage (Errors.UnexpectedRowCountStatementError 1 1 0))+          `shouldBe` "Unexpected number of rows"++      it "renders UnexpectedColumnTypeStatementError" do+        (Errors.toMessage (Errors.UnexpectedColumnTypeStatementError 1 23 1043))+          `shouldBe` "Unexpected column type"++    describe "toDetails" do+      it "includes expected and actual for UnexpectedRowCountStatementError" do+        (Errors.toDetails (Errors.UnexpectedRowCountStatementError 1 1 5))+          `shouldBe` [("expectedMin", "1"), ("expectedMax", "1"), ("actual", "5")]++      it "includes column index and oids for UnexpectedColumnTypeStatementError" do+        (Errors.toDetails (Errors.UnexpectedColumnTypeStatementError 2 23 1043))+          `shouldBe` [("columnIndex", "2"), ("expectedOid", "23"), ("actualOid", "1043")]++    describe "toDetailedText" do+      it "renders UnexpectedRowCountStatementError with details" do+        (Errors.toDetailedText (Errors.UnexpectedRowCountStatementError 1 1 0))+          `shouldBe` "Unexpected number of rows\n  expectedMin: 1\n  expectedMax: 1\n  actual: 0"++      it "renders RowStatementError with nested details" do+        (Errors.toDetailedText (Errors.RowStatementError 3 (Errors.CellRowError 1 23 Errors.UnexpectedNullCellError)))+          `shouldBe` "Unexpected null value\n  rowIndex: 3\n  columnIndex: 1\n  oid: 23"++  describe "SessionError" do+    describe "toMessage" do+      it "renders StatementSessionError with nested message" do+        (Errors.toMessage (Errors.StatementSessionError 1 0 "SELECT 1" [] True (Errors.UnexpectedRowCountStatementError 1 1 0)))+          `shouldBe` "Unexpected number of rows"++      it "renders ConnectionSessionError" do+        (Errors.toMessage (Errors.ConnectionSessionError "connection lost"))+          `shouldBe` "Connection error"++      it "renders MissingTypesSessionError" do+        (Errors.toMessage (Errors.MissingTypesSessionError (HashSet.fromList [(Just "public", "custom_type"), (Nothing, "enum_type")])))+          `shouldBe` "Types not found in database"++    describe "toDetails" do+      it "includes statement context and nested error details" do+        (Errors.toDetails (Errors.StatementSessionError 3 1 "SELECT * FROM users WHERE id = $1" ["42"] True (Errors.ServerStatementError (Errors.ServerError "42P01" "relation does not exist" Nothing Nothing Nothing))))+          `shouldBe` [ ("totalStatements", "3"),+                       ("statementIndex", "1"),+                       ("sql", "SELECT * FROM users WHERE id = $1"),+                       ("parameters", "42"),+                       ("prepared", "true"),+                       ("code", "42P01"),+                       ("message", "relation does not exist")+                     ]++      it "includes multiple parameters" do+        (Errors.toDetails (Errors.StatementSessionError 1 0 "INSERT INTO users (name, age) VALUES ($1, $2)" ["Alice", "30"] False (Errors.UnexpectedRowCountStatementError 1 1 0)))+          `shouldBe` [ ("totalStatements", "1"),+                       ("statementIndex", "0"),+                       ("sql", "INSERT INTO users (name, age) VALUES ($1, $2)"),+                       ("parameters", "Alice, 30"),+                       ("prepared", "false"),+                       ("expectedMin", "1"),+                       ("expectedMax", "1"),+                       ("actual", "0")+                     ]++    describe "isTransient" do+      it "ConnectionSessionError is transient" do+        (Errors.isTransient (Errors.ConnectionSessionError "connection lost"))+          `shouldBe` True++      it "StatementSessionError is not transient" do+        (Errors.isTransient (Errors.StatementSessionError 1 0 "SELECT 1" [] True (Errors.UnexpectedRowCountStatementError 1 1 0)))+          `shouldBe` False++    describe "toDetailedText" do+      it "renders StatementSessionError with all context" do+        (Errors.toDetailedText (Errors.StatementSessionError 1 0 "SELECT * FROM users" [] True (Errors.UnexpectedRowCountStatementError 1 1 10)))+          `shouldBe` "Unexpected number of rows\n\+                     \  totalStatements: 1\n\+                     \  statementIndex: 0\n\+                     \  sql: SELECT * FROM users\n\+                     \  parameters:\n\+                     \  prepared: true\n\+                     \  expectedMin: 1\n\+                     \  expectedMax: 1\n\+                     \  actual: 10"++  describe "toDetailedText with multiline values" do+    it "indents multiline detail values correctly" do+      (Errors.toDetailedText (Errors.ServerError "42601" "syntax error" (Just "Line 1: syntax error\nLine 2: near unexpected token\nLine 3: suggestion here") Nothing Nothing))+        `shouldBe` "Server error\n\+                   \  code: 42601\n\+                   \  message: syntax error\n\+                   \  detail:\n\+                   \    Line 1: syntax error\n\+                   \    Line 2: near unexpected token\n\+                   \    Line 3: suggestion here"++    it "indents multiline hint values correctly" do+      (Errors.toDetailedText (Errors.ServerError "42P01" "relation not found" Nothing (Just "Perhaps you meant:\n  users\n  user_accounts\n  user_profiles") Nothing))+        `shouldBe` "Server error\n\+                   \  code: 42P01\n\+                   \  message: relation not found\n\+                   \  hint:\n\+                   \    Perhaps you meant:\n\+                   \      users\n\+                   \      user_accounts\n\+                   \      user_profiles"++    it "handles multiline SQL in StatementSessionError" do+      (Errors.toDetailedText (Errors.StatementSessionError 1 0 "SELECT *\nFROM users\nWHERE id = $1" ["1"] False (Errors.UnexpectedRowCountStatementError 1 1 0)))+        `shouldBe` "Unexpected number of rows\n\+                   \  totalStatements: 1\n\+                   \  statementIndex: 0\n\+                   \  sql:\n\+                   \    SELECT *\n\+                   \    FROM users\n\+                   \    WHERE id = $1\n\+                   \  parameters: 1\n\+                   \  prepared: false\n\+                   \  expectedMin: 1\n\+                   \  expectedMax: 1\n\+                   \  actual: 0"
− src/library-tests/Sharing/ByBug/ExceptionConnectionResetRaceSpec.hs 
@@ -1,91 +0,0 @@-module Sharing.ByBug.ExceptionConnectionResetRaceSpec (spec) where--import Control.Concurrent-import Control.Exception-import Data.IORef-import Hasql.Connection qualified as Connection-import Hasql.Session qualified as Session-import Helpers.Dsls.Execution qualified as Execution-import Helpers.Scripts qualified as Scripts-import Helpers.Statements.SelectProvidedInt8 qualified as Statements-import System.Timeout-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Exception during session with concurrent access" do-    it "Connection remains usable after exception in non-idle state with concurrent threads" \config -> Scripts.onPreparableConnection config \connection -> do-      -- This test reproduces the bug fixed in commit 62ebef2.-      -- The bug was that when an exception occurred during a session,-      -- the connection state was put back into the MVar BEFORE resetting the connection.-      -- This created a race condition where another thread could grab the corrupted connection.--      -- We'll create a scenario where:-      -- 1. Thread A starts a session that will throw an exception-      -- 2. Thread B repeatedly tries to use the connection-      -- 3. The exception in Thread A should not corrupt the connection for Thread B--      -- Counter to track successful operations by Thread B-      successCount <- newIORef (0 :: Int)-      errorCount <- newIORef (0 :: Int)--      -- Barrier to synchronize threads-      startBarrier <- newEmptyMVar-      doneBarrier <- newEmptyMVar--      -- Thread A: Throws exceptions repeatedly-      _ <- forkIO do-        takeMVar startBarrier-        replicateM_ 10 do-          -- Use the connection and throw an exception during the session-          _ <- try @SomeException do-            Connection.use connection do-              -- Start a transaction to put connection in non-idle state-              Session.script "BEGIN"-              -- Throw an exception while in transaction (non-idle state)-              liftIO (throwIO (userError "Intentional exception"))-          threadDelay 1000 -- Small delay to allow interleaving-        putMVar doneBarrier ()--      -- Thread B: Tries to use connection concurrently-      _ <- forkIO do-        takeMVar startBarrier-        replicateM_ 20 do-          result <- Connection.use connection (Execution.sessionByParams (Statements.SelectProvidedInt8 42))-          case result of-            Right 42 -> atomicModifyIORef' successCount (\n -> (n + 1, ()))-            _ -> atomicModifyIORef' errorCount (\n -> (n + 1, ()))-          threadDelay 500-        putMVar doneBarrier ()--      -- Start both threads-      putMVar startBarrier ()-      putMVar startBarrier ()--      -- Wait for both threads to complete with a timeout-      -- If the bug exists, threads may hang waiting for a corrupted connection-      result <- timeout (5 * 1000000) do-        -- 5 seconds timeout-        takeMVar doneBarrier-        takeMVar doneBarrier--      case result of-        Nothing -> do-          -- Test timed out - this indicates the bug is present-          expectationFailure "Test timed out waiting for threads to complete. This indicates the connection became deadlocked due to the race condition bug."-        Just () -> do-          -- Threads completed successfully-          -- Check results-          successes <- readIORef successCount-          errors <- readIORef errorCount--          -- Thread B should have succeeded at least some times-          -- If the bug exists, we'd expect Thread B to get errors due to corrupted connection state-          successes `shouldSatisfy` (> 0)--          errors `shouldBe` 0--          -- Verify connection is still usable after all this-          finalResult <- Connection.use connection (Execution.sessionByParams (Statements.SelectProvidedInt8 99))-          finalResult `shouldBe` Right 99
− src/library-tests/Sharing/ByBug/PipelineAbortedInterruptionCleanupSpec.hs 
@@ -1,134 +0,0 @@-module Sharing.ByBug.PipelineAbortedInterruptionCleanupSpec (spec) where--import Data.Text qualified as Text-import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Pipeline qualified as Pipeline-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude---- | A statement that sleeps for the given number of seconds and succeeds.------ Used to widen the wall-clock window during which the client is blocked--- waiting on the network/socket for a pipelined result, so that an--- asynchronous interruption has a realistic chance of landing right around--- the moment the *next* statement in the same pipeline fails.-sleepStatement :: Statement.Statement Double ()-sleepStatement =-  Statement.preparable-    "select pg_sleep($1)"-    (Encoders.param (Encoders.nonNullable Encoders.float8))-    Decoders.noResult---- | A statement that is guaranteed to fail on the server.-failingStatement :: Statement.Statement () ()-failingStatement =-  Statement.preparable-    "select 1/0"-    Encoders.noParams-    Decoders.noResult---- | A pipeline of two statements: the first sleeps and succeeds, the--- second fails. Executing this via 'Session.pipeline' drives libpq's--- pipeline status through: Off -> On -> (once the sleep result has been--- received and the divide error has been processed) Aborted -> (normally)--- Off again, via the exit sequence inside 'toPipelineIO'.------ The bug under test concerns what happens if an asynchronous exception--- interrupts execution during the narrow "Aborted" window: right after--- libpq has registered the error result for the second statement (which--- flips its internal pipeline status to `PipelineAborted`) but before the--- driver has drained the trailing pipeline-sync marker and called--- `exitPipelineMode`. That window is only a couple of FFI calls wide, so--- reliably landing an async exception inside it requires many attempts--- across a fine-grained sweep of interrupt delays (see 'spec' below).------ Note: an earlier version of this test tried to widen the window by--- appending many trivial "filler" statements after the failing one (on--- the theory that draining their results would take measurably longer).--- That approach reproduced failures reliably, but for the wrong reason:--- `Comms.Session.drainResults` only drains one queued command's worth of--- results per call, so a large backlog of undrained filler results made--- `exitPipelineMode` fail with "cannot exit pipeline mode with uncollected--- results" regardless of whether the `PipelineOn`/`PipelineAborted` bug--- under test was present or fixed. That's a real, separate limitation of--- `drainResults`, but not the bug this test is about, so the pipeline here--- is kept to exactly two statements and 'attempt' below specifically--- checks for the "not allowed in pipeline mode" signature (the one the--- one-line `leavePipeline` fix actually addresses) rather than any--- "Failed to clean up after interruption" message.-racingPipelineSession :: Double -> Session.Session ()-racingPipelineSession sleepSeconds =-  Session.pipeline do-    Pipeline.statement sleepSeconds sleepStatement-      *> Pipeline.statement () failingStatement---- | Try once to reproduce the bug: acquire a fresh connection, race a--- `timeout` against the pipelined session (sleep-then-fail) tuned to fire--- right around the moment the pipeline transitions to the aborted state,--- and report whether `Connection.use` came back with the specific driver--- error that signals the `leavePipeline` bug: it only checks for--- `PipelineOn`, so when the connection is genuinely `PipelineAborted` at--- interruption time, cleanup skips leaving the pipeline and falls through--- to `bringTransactionStatusToIdle`, which tries to send "ABORT" as a--- serial command while still in pipeline mode -- something libpq flatly--- refuses ("PQsendQuery not allowed in pipeline mode").------ Note on why checking `Connection.use`'s own return value is enough: when--- `timeout` throws its internal exception into the thread running--- `Connection.use`, that exception is caught by `use`'s own--- @try \@SomeException@. If the bug is NOT triggered, `use` cleans up--- successfully and rethrows the very same timeout exception, so `timeout`--- observes it and returns 'Nothing'. If the bug IS triggered, `use`--- reports the cleanup failure as an ordinary `Left (DriverSessionError _)`--- return value instead of rethrowing, so `timeout` observes a normal--- return and reports 'Just (Left _)'.-attempt :: (Text, Word16) -> Double -> Int -> IO (Maybe Text)-attempt config sleepSeconds delayMicros =-  Scripts.onPreparableConnection config \connection -> do-    result <- timeout delayMicros do-      Connection.use connection (racingPipelineSession sleepSeconds)-    pure case result of-      Just (Left err) ->-        let rendered = Text.pack (show err)-         in if "Failed to clean up after interruption"-              `Text.isInfixOf` rendered-              && "not allowed in pipeline mode"-              `Text.isInfixOf` rendered-              then Just rendered-              else Nothing-      Just (Right ()) -> Nothing-      Nothing -> Nothing--spec :: SpecWith (Text, Word16)-spec = do-  describe "Interruption of a pipeline while it is in the Aborted status" do-    it "Connection.use recovers cleanly instead of reporting a driver cleanup failure" \config -> do-      -- We sweep the timeout across a window that straddles the moment the-      -- sleep statement finishes and the failing statement's error result-      -- gets processed by libpq (which is when the pipeline status flips-      -- from `PipelineOn` to `PipelineAborted`). The genuinely vulnerable-      -- window is only a couple of FFI calls wide (nowhere near as wide as-      -- our timer granularity), so we compensate with a large number of-      -- attempts spread finely across the window and a fresh connection-      -- each time, rather than trying to widen the window itself.-      let sleepMicros = 20000 :: Int -- 20ms sleep statement duration-          sleepSeconds = fromIntegral sleepMicros / 1000000-          delays = [sleepMicros + step | step <- [(-3000), (-2900) .. 6000]]-          attemptsPerDelay = 15--      results <--        sequence-          [ attempt config sleepSeconds d-          | d <- delays,-            _ <- [1 :: Int .. attemptsPerDelay]-          ]--      let reproductions = [msg | Just msg <- results]--      reproductions-        `shouldBe` []
− src/library-tests/Sharing/ByFeature/ConcurrencySpec.hs 
@@ -1,39 +0,0 @@-module Sharing.ByFeature.ConcurrencySpec (spec) where--import Control.Concurrent-import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  it "handles concurrent connections properly" \config -> do-    Scripts.onPreparableConnection config \connection1 -> do-      Scripts.onPreparableConnection config \connection2 -> do-        let selectSleep =-              Statement.preparable-                "select pg_sleep($1)"-                (Encoders.param (Encoders.nonNullable Encoders.float8))-                Decoders.noResult--        beginVar <- newEmptyMVar-        finishVar <- newEmptyMVar--        _ <- forkIO do-          putMVar beginVar ()-          _ <- Connection.use connection1 (Session.statement (0.2 :: Double) selectSleep)-          void (tryPutMVar finishVar False)--        _ <- forkIO do-          takeMVar beginVar-          _ <- Connection.use connection2 (Session.statement (0.1 :: Double) selectSleep)-          void (tryPutMVar finishVar True)--        -- The second connection should finish first (True)-        result <- takeMVar finishVar-        result `shouldBe` True
− src/library-tests/Sharing/ByFeature/DecoderCompatibilityCacheSpec.hs 
@@ -1,57 +0,0 @@-module Sharing.ByFeature.DecoderCompatibilityCacheSpec (spec) where--import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Errors qualified as Errors-import Hasql.Pipeline qualified as Pipeline-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = parallel do-  byExecutor "Session" (Session.statement ())-  byExecutor "Pipeline" (Session.pipeline . Pipeline.statement ())--byExecutor ::-  Text ->-  (forall a. (Show a) => Statement.Statement () a -> Session.Session a) ->-  SpecWith (Text, Word16)-byExecutor executorName executor = do-  describe (toList executorName) do-    it "does not hide decoder mismatches from a previously verified statement" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let sql = "select 1::int8, 'text'::text"-            correctStatement =-              Statement.preparable-                sql-                mempty-                ( Decoders.singleRow-                    ( (,)-                        <$> Decoders.column (Decoders.nonNullable Decoders.int8)-                        <*> Decoders.column (Decoders.nonNullable Decoders.text)-                    )-                )-            mismatchingStatement =-              Statement.preparable-                sql-                mempty-                ( Decoders.singleRow-                    ( (,)-                        <$> Decoders.column (Decoders.nonNullable Decoders.int8)-                        <*> Decoders.column (Decoders.nonNullable Decoders.int8)-                    )-                )-        firstResult <- Connection.use connection (executor correctStatement)-        shouldBe firstResult (Right (1, "text"))-        secondResult <- Connection.use connection (executor mismatchingStatement)-        case secondResult of-          Left (Errors.StatementSessionError _ _ _ _ _ (Errors.UnexpectedColumnTypeStatementError column expected actual)) -> do-            shouldBe column 1-            (expected, actual) `shouldBe` (20, 25)-          Left err ->-            expectationFailure ("Unexpected type of error: " <> show err)-          result ->-            expectationFailure ("Not an error: " <> show result)
− src/library-tests/Sharing/ByFeature/DecoderCompatibilityCheckSpec.hs 
@@ -1,196 +0,0 @@-module Sharing.ByFeature.DecoderCompatibilityCheckSpec (spec) where--import Data.Either-import Data.Vector qualified as Vector-import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Errors qualified as Errors-import Hasql.Pipeline qualified as Pipeline-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = parallel do-  byPreparedStatusAndExecutor True "Session" (Session.statement ())-  byPreparedStatusAndExecutor False "Session" (Session.statement ())-  byPreparedStatusAndExecutor True "Pipeline" (Session.pipeline . Pipeline.statement ())-  byPreparedStatusAndExecutor False "Pipeline" (Session.pipeline . Pipeline.statement ())--byPreparedStatusAndExecutor ::-  Bool ->-  Text ->-  (forall a. (Show a) => Statement.Statement () a -> Session.Session a) ->-  SpecWith (Text, Word16)-byPreparedStatusAndExecutor preparable executorName executor = do-  describe (if preparable then "Preparable" else "Unpreparable") do-    describe (toList executorName) do-      describe "UnexpectedColumnCount" do-        it "gets reported when result has more columns" \config -> do-          Scripts.onPreparableConnection config \connection -> do-            let statement =-                  (if preparable then Statement.preparable else Statement.unpreparable)-                    "select 1, 2"-                    mempty-                    (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))-            result <- Connection.use connection (executor statement)-            case result of-              Left (Errors.StatementSessionError _ _ _ _ _ (Errors.UnexpectedColumnCountStatementError expected actual)) -> do-                shouldBe expected 1-                shouldBe actual 2-              Left err ->-                expectationFailure ("Unexpected type of error: " <> show err)-              result ->-                expectationFailure ("Not an error: " <> show result)--        it "gets reported when result has fewer columns" \config -> do-          Scripts.onPreparableConnection config \connection -> do-            let statement =-                  (if preparable then Statement.preparable else Statement.unpreparable)-                    "select 1"-                    mempty-                    ( Decoders.singleRow-                        ( (,)-                            <$> Decoders.column (Decoders.nonNullable Decoders.int8)-                            <*> Decoders.column (Decoders.nonNullable Decoders.int8)-                        )-                    )-            result <- Connection.use connection (executor statement)-            case result of-              Left (Errors.StatementSessionError _ _ _ _ _ (Errors.UnexpectedColumnCountStatementError expected actual)) -> do-                shouldBe expected 2-                shouldBe actual 1-              Left err ->-                expectationFailure ("Unexpected type of error: " <> show err)-              result ->-                expectationFailure ("Not an error: " <> show result)--      describe "DecoderTypeMismatch" do-        describe "singleRow" do-          it "gets reported when column type mismatches decoder" \config -> do-            Scripts.onPreparableConnection config \connection -> do-              let statement =-                    (if preparable then Statement.preparable else Statement.unpreparable)-                      "select 1::int8, 'text'::text"-                      mempty-                      ( Decoders.singleRow-                          ( (,)-                              <$> Decoders.column (Decoders.nonNullable Decoders.int8)-                              <*> Decoders.column (Decoders.nonNullable Decoders.int8)-                          )-                      )-              result <- Connection.use connection (executor statement)-              case result of-                Left (Errors.StatementSessionError _ _ _ _ _ (Errors.UnexpectedColumnTypeStatementError column expected actual)) -> do-                  shouldBe column 1-                  shouldBe expected 20-                  shouldBe actual 25-                Left err ->-                  expectationFailure ("Unexpected type of error: " <> show err)-                result ->-                  expectationFailure ("Not an error: " <> show result)--        describe "rowMaybe" do-          it "gets reported when column type mismatches decoder" \config -> do-            Scripts.onPreparableConnection config \connection -> do-              let statement =-                    (if preparable then Statement.preparable else Statement.unpreparable)-                      "select 1::int8, 'text'::text"-                      mempty-                      ( Decoders.rowMaybe-                          ( (,)-                              <$> Decoders.column (Decoders.nonNullable Decoders.int8)-                              <*> Decoders.column (Decoders.nonNullable Decoders.int8)-                          )-                      )-              result <- Connection.use connection (executor statement)-              case result of-                Left (Errors.StatementSessionError _ _ _ _ _ (Errors.UnexpectedColumnTypeStatementError column expected actual)) -> do-                  shouldBe column 1-                  (expected, actual) `shouldBe` (20, 25)-                Left err ->-                  expectationFailure ("Unexpected type of error: " <> show err)-                result ->-                  expectationFailure ("Not an error: " <> show result)--        describe "rowVector" do-          it "gets reported when column type mismatches decoder" \config -> do-            Scripts.onPreparableConnection config \connection -> do-              let statement =-                    (if preparable then Statement.preparable else Statement.unpreparable)-                      "select int8 '1', text 'text'"-                      mempty-                      ( Decoders.rowVector-                          ( (,)-                              <$> Decoders.column (Decoders.nonNullable Decoders.int8)-                              <*> Decoders.column (Decoders.nonNullable Decoders.int8)-                          )-                      )-              result <- Connection.use connection (executor statement)-              case result of-                Left (Errors.StatementSessionError _ _ _ _ _ (Errors.UnexpectedColumnTypeStatementError column expected actual)) -> do-                  shouldBe column 1-                  (expected, actual) `shouldBe` (20, 25)-                Left err ->-                  expectationFailure ("Unexpected type of error: " <> show err)-                result ->-                  expectationFailure ("Not an error: " <> show result)--        describe "array" do-          describe "decoder:int8[]" do-            describe "column:int8" do-              it "reports properly" \config -> do-                Scripts.onPreparableConnection config \connection -> do-                  let statement =-                        (if preparable then Statement.preparable else Statement.unpreparable)-                          "select 1::int8"-                          mempty-                          ( Decoders.singleRow-                              (Decoders.column (Decoders.nonNullable (Decoders.vectorArray @Vector (Decoders.nonNullable Decoders.int8))))-                          )-                  result <- Connection.use connection (executor statement)-                  case result of-                    Left (Errors.StatementSessionError _ _ _ _ _ (Errors.UnexpectedColumnTypeStatementError column expected actual)) -> do-                      shouldBe column 0-                      (expected, actual) `shouldBe` (1016, 20)-                    Left err ->-                      expectationFailure ("Unexpected type of error: " <> show err)-                    result ->-                      expectationFailure ("Not an error: " <> show result)--          describe "decoder:int8[]" do-            describe "column:int8[]" do-              it "decodes properly" \config -> do-                Scripts.onPreparableConnection config \connection -> do-                  let statement =-                        (if preparable then Statement.preparable else Statement.unpreparable)-                          "select ARRAY[1::int8, 2::int8]"-                          mempty-                          ( Decoders.singleRow-                              (Decoders.column (Decoders.nonNullable (Decoders.vectorArray @Vector (Decoders.nonNullable Decoders.int8))))-                          )-                  result <- Connection.use connection (executor statement)-                  shouldBe result (Right (Vector.fromList [1, 2]))--          describe "decoder:int8" do-            describe "column:int8[]" do-              it "reports properly" \config -> do-                Scripts.onPreparableConnection config \connection -> do-                  let statement =-                        (if preparable then Statement.preparable else Statement.unpreparable)-                          "select ARRAY[1::int8, 2::int8]"-                          mempty-                          ( Decoders.singleRow-                              (Decoders.column (Decoders.nonNullable Decoders.int8))-                          )-                  result <- Connection.use connection (executor statement)-                  case result of-                    Left (Errors.StatementSessionError _ _ _ _ _ (Errors.UnexpectedColumnTypeStatementError column expected actual)) -> do-                      shouldBe column 0-                      (expected, actual) `shouldBe` (20, 1016)-                    Left err ->-                      expectationFailure ("Unexpected type of error: " <> show err)-                    result ->-                      expectationFailure ("Not an error: " <> show result)
− src/library-tests/Sharing/ByFeature/PreparedStatementCacheSpec.hs 
@@ -1,243 +0,0 @@-module Sharing.ByFeature.PreparedStatementCacheSpec (spec) where--import Data.Either-import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Errors qualified as Errors-import Hasql.Pipeline qualified as Pipeline-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Session" do-    it "Failing statements don't cause misses in updates of the prepared statement cache" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        -- Run an intentionally failing prepared statement to set the condition of the bug.-        result <- Connection.use connection do-          Session.statement-            ()-            ( Statement.preparable-                "select null"-                mempty-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))-            )-        shouldBe (isLeft result) True-        -- Run a succeeding prepared statement to see if the cache is still in a good state.-        result <- Connection.use connection do-          Session.statement-            ()-            ( Statement.preparable-                "select 1"-                mempty-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))-            )-        -- If there is an error the cache got corrupted.-        case result of-          Right _ ->-            pure ()-          Left result ->-            expectationFailure ("Unexpected error: " <> show result)--    it "Syntax errors in prepared statements don't corrupt the cache for subsequent uses of the same statement" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let brokenStatement =-              Statement.preparable-                "S"-                mempty-                Decoders.noResult-        -- First run: syntax error.-        result1 <- Connection.use connection do-          Session.statement () brokenStatement-        error1 <- case result1 of-          Left error1 -> pure error1-          Right _ -> fail "First run unexpectedly succeeded"--        -- Second run of the same statement: should also produce a syntax error,-        -- not "prepared statement does not exist".-        result2 <- Connection.use connection do-          Session.statement () brokenStatement-        error2 <- case result2 of-          Left error2 -> pure error2-          Right _ -> fail "Second run unexpectedly succeeded"-        shouldBe error2 error1--  describe "Pipeline" do-    it "Failing pipeline statements don't cause misses in updates of the prepared statement cache" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        -- Run an intentionally failing prepared statement in a pipeline to set the condition of the bug.-        result <- Connection.use connection do-          Session.pipeline do-            Pipeline.statement-              ()-              ( Statement.preparable-                  "select null :: int4"-                  mempty-                  (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))-              )-        case result of-          Right val ->-            expectationFailure ("First statement succeeded unexpectedly: " <> show val)-          Left _ ->-            pure ()--        -- Run a succeeding prepared statement in a pipeline to see if the cache is still in a good state.-        result <- Connection.use connection do-          Session.pipeline do-            Pipeline.statement-              ()-              ( Statement.preparable-                  "select 1"-                  mempty-                  (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))-              )-        -- If there is an error the cache got corrupted.-        case result of-          Right _ ->-            pure ()-          Left result ->-            expectationFailure ("Unexpected error: " <> show result)--    it "Syntax errors in pipeline prepared statements don't corrupt the cache for subsequent uses of the same statement" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let brokenStatement =-              Statement.preparable-                "S"-                mempty-                Decoders.noResult-        -- First run: syntax error.-        result1 <- Connection.use connection do-          Session.pipeline (Pipeline.statement () brokenStatement)-        shouldBe (isLeft result1) True-        -- Second run of the same statement: should also produce a syntax error,-        -- not "prepared statement does not exist".-        result2 <- Connection.use connection do-          Session.pipeline (Pipeline.statement () brokenStatement)-        case result2 of-          Left (Errors.StatementSessionError _ _ _ _ _ (Errors.ServerStatementError (Errors.ServerError "42601" _ _ _ _))) ->-            pure ()-          Left other ->-            expectationFailure ("Unexpected error on second run: " <> show other)-          Right _ ->-            expectationFailure "Second run unexpectedly succeeded"--    it "A pipeline with a broken statement first and a valid one after it can be retried with the same syntax error" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let broken = Statement.preparable "S" mempty Decoders.noResult-            ok = Statement.preparable "select 1" mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))-        result1 <- Connection.use connection do-          Session.pipeline do-            (,)-              <$> Pipeline.statement () broken-              <*> Pipeline.statement () ok-        error1 <- case result1 of-          Left error1 -> pure error1-          Right _ -> fail "First run unexpectedly succeeded"--        result2 <- Connection.use connection do-          Session.pipeline do-            (,)-              <$> Pipeline.statement () broken-              <*> Pipeline.statement () ok-        error2 <- case result2 of-          Left error2 -> pure error2-          Right _ -> fail "Second run unexpectedly succeeded"-        shouldBe error2 error1--    it "A valid statement after a broken pipeline statement still prepares in a later pipeline" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let broken = Statement.preparable "S" mempty Decoders.noResult-            trailing = Statement.preparable "select 1" mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))-        result1 <- Connection.use connection do-          Session.pipeline do-            (,)-              <$> Pipeline.statement () broken-              <*> Pipeline.statement () trailing-        shouldBe (isLeft result1) True--        result2 <- Connection.use connection do-          Session.pipeline do-            Pipeline.statement () trailing-        case result2 of-          Right val -> val `shouldBe` 1-          Left err -> expectationFailure ("Unexpected error on follow-up pipeline: " <> show err)--    it "A pipeline with successful statements followed by a broken one can be retried without 'already exists' errors" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let ok1 = Statement.preparable "select 1" mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))-            ok2 = Statement.preparable "select 2" mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))-            broken = Statement.preparable "S" mempty Decoders.noResult-        -- First run: pipeline with two OK statements and a broken one at the end.-        result1 <- Connection.use connection do-          Session.pipeline do-            (,,)-              <$> Pipeline.statement () ok1-              <*> Pipeline.statement () ok2-              <*> Pipeline.statement () broken-        error1 <- case result1 of-          Left error1 -> pure error1-          Right _ -> fail "First run unexpectedly succeeded"--        -- Second run of the same pipeline: must fail with the SAME syntax error,-        -- not "prepared statement already exists".-        result2 <- Connection.use connection do-          Session.pipeline do-            (,,)-              <$> Pipeline.statement () ok1-              <*> Pipeline.statement () ok2-              <*> Pipeline.statement () broken-        error2 <- case result2 of-          Left error2 -> pure error2-          Right _ -> fail "Second run unexpectedly succeeded"-        shouldBe error2 error1--        -- Also, a standalone valid statement should still work afterwards.-        result3 <- Connection.use connection do-          Session.statement () ok1-        case result3 of-          Right val -> val `shouldBe` 1-          Left err -> expectationFailure ("Unexpected error on standalone statement: " <> show err)--    it "A pipeline with a broken statement in the middle can be retried without 'already exists' errors" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let ok1 = Statement.preparable "select 1" mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))-            broken = Statement.preparable "S" mempty Decoders.noResult-            ok2 = Statement.preparable "select 2" mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))-        -- First run: pipeline with broken statement in the middle.-        result1 <- Connection.use connection do-          Session.pipeline do-            (,,)-              <$> Pipeline.statement () ok1-              <*> Pipeline.statement () broken-              <*> Pipeline.statement () ok2-        shouldBe (isLeft result1) True--        -- Second run of the same pipeline: must fail with the same syntax error.-        result2 <- Connection.use connection do-          Session.pipeline do-            (,,)-              <$> Pipeline.statement () ok1-              <*> Pipeline.statement () broken-              <*> Pipeline.statement () ok2-        case result2 of-          Left (Errors.StatementSessionError _ _ _ _ _ (Errors.ServerStatementError (Errors.ServerError "42601" _ _ _ _))) ->-            pure ()-          Left other ->-            expectationFailure ("Unexpected error on second run: " <> show other)-          Right _ ->-            expectationFailure "Second run unexpectedly succeeded"--        -- Standalone valid statements should still work afterwards.-        result3 <- Connection.use connection do-          Session.statement () ok1-        case result3 of-          Right val -> val `shouldBe` 1-          Left err -> expectationFailure ("Unexpected error on standalone ok1: " <> show err)-        result4 <- Connection.use connection do-          Session.statement () ok2-        case result4 of-          Right val -> val `shouldBe` 2-          Left err -> expectationFailure ("Unexpected error on standalone ok2: " <> show err)
− src/library-tests/Sharing/ByFeature/PreparedStatementsSpec.hs 
@@ -1,58 +0,0 @@-module Sharing.ByFeature.PreparedStatementsSpec (spec) where--import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Dsls.Execution qualified as Execution-import Helpers.Scripts qualified as Scripts-import Helpers.Statements.CountPreparedStatements qualified as CountPreparedStatements-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Prepared statements" do-    it "Do get prepared when configuration allows" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        -- Execute a preparable statement-        result <--          Connection.use connection do-            Session.statement-              ()-              ( Statement.preparable-                  "select 1 + 1"-                  mempty-                  (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))-              )-        result `shouldBe` Right 2--        -- Query pg_prepared_statements to verify it was prepared-        preparedCount <--          Connection.use connection do-            Execution.sessionByParams CountPreparedStatements.CountPreparedStatements--        preparedCount `shouldSatisfy` \case-          Right count -> count > 0-          Left _ -> False--    it "Do not get prepared when configuration forbids it" \config -> do-      Scripts.onUnpreparableConnection config \connection -> do-        -- Execute a statement marked as preparable-        result <--          Connection.use connection do-            Session.statement-              ()-              ( Statement.preparable-                  "select 2 + 2"-                  mempty-                  (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))-              )-        result `shouldBe` Right 4--        -- Query pg_prepared_statements to verify it was NOT prepared-        preparedCount <--          Connection.use connection do-            Execution.sessionByParams CountPreparedStatements.CountPreparedStatements--        preparedCount `shouldBe` Right 0
− src/library-tests/Sharing/ByFeature/SyntaxErrorsSpec.hs 
@@ -1,45 +0,0 @@-module Sharing.ByFeature.SyntaxErrorsSpec (spec) where--import Data.Either-import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Errors qualified as Errors-import Hasql.Pipeline qualified as Pipeline-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  forM_ [False, True] \inPipeline -> do-    describe (if inPipeline then "Pipeline" else "Session") do-      forM_ [False, True] \preparable -> do-        describe (if preparable then "Preparable" else "Unpreparable") do-          it "gets reported properly" \config -> do-            Scripts.onPreparableConnection config \connection -> do-              result <- Connection.use connection do-                let statement =-                      if preparable-                        then Statement.preparable "-" mempty Decoders.noResult-                        else Statement.unpreparable "-" mempty Decoders.noResult-                if inPipeline-                  then Session.pipeline (Pipeline.statement () statement)-                  else Session.statement () statement--              shouldBe-                result-                ( Left-                    ( (Errors.StatementSessionError 1 0 "-" [] preparable)-                        ( Errors.ServerStatementError-                            ( Errors.ServerError-                                "42601"-                                "syntax error at or near \"-\""-                                Nothing-                                Nothing-                                (Just 1)-                            )-                        )-                    )-                )
− src/library-tests/Sharing/ByUnit/Connection/UseSpec.hs 
@@ -1,166 +0,0 @@-module Sharing.ByUnit.Connection.UseSpec (spec) where--import Data.Either-import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Pipeline qualified as Pipeline-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Dsls.Execution qualified as Execution-import Helpers.Scripts qualified as Scripts-import Helpers.Statements.SelectOne qualified as Statements.SelectOne-import Helpers.Statements.Sleep qualified as Statements-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Transactions" do-    it "Do not cause \"in progress after error\"" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let sumStatement =-              Statement.preparable-                "select ($1 + $2)"-                ( mconcat-                    [ fst >$< Encoders.param (Encoders.nonNullable Encoders.int8),-                      snd >$< Encoders.param (Encoders.nonNullable Encoders.int8)-                    ]-                )-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))--        result <--          Connection.use connection do-            Session.script "."--        result `shouldSatisfy` isLeft--        result <--          Connection.use connection do-            Session.script "begin;"-            s <- Session.statement (1 :: Int64, 2 :: Int64) sumStatement-            Session.script "end;"-            return s--        result `shouldBe` Right (3 :: Int64)--  describe "Pipeline Mode" do-    it "Leaves the connection usable after timeout in pipeline" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let selectStatement =-              Statement.preparable-                "select $1::int"-                (Encoders.param (Encoders.nonNullable Encoders.int4))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))--        -- Timeout during a pipeline operation-        result <--          timeout 50_000 do-            Connection.use connection-              $ Session.pipeline-              $ (,)-              <$> Pipeline.statement 42 selectStatement-              <*> Execution.pipelineByParams (Statements.Sleep 0.1)--        result `shouldBe` Nothing--        -- Try to use pipeline again after timeout cleanup-        -- This should work but fails with "connection not idle" without the fix-        result2 <--          Connection.use connection-            $ Session.pipeline-            $ Pipeline.statement 99 selectStatement--        result2 `shouldBe` Right 99--  describe "Timing out" do-    describe "On a statement" do-      it "Leaves the connection usable" \config -> Scripts.onPreparableConnection config \connection -> do-        result <--          timeout 50_000 do-            Connection.use connection do-              Execution.sessionByParams (Statements.Sleep 0.1)--        result `shouldBe` Nothing--        result <--          Connection.use connection do-            Execution.sessionByParams Statements.SelectOne.SelectOne--        result `shouldBe` Right 1--    describe "On a transaction" do-      it "Leaves the connection usable" \config -> Scripts.onPreparableConnection config \connection -> do-        -- Start a transaction and timeout during it-        result <--          timeout 50_000 do-            Connection.use connection do-              Session.script "begin;"-              Execution.sessionByParams (Statements.Sleep 0.1)-              Session.script "commit;"--        result `shouldBe` Nothing--        -- Connection should still be usable after timeout in transaction-        result <--          Connection.use connection do-            Execution.sessionByParams Statements.SelectOne.SelectOne--        result `shouldBe` Right 1--      it "Lets us start another transaction" do-        let checkTransactionStatus =-              Statement.preparable-                "select case when pg_advisory_lock(1) is null then 0 else 1 end"-                mempty-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))-         in \config -> Scripts.onPreparableConnection config \connection -> do-              -- Timeout during a transaction-              result <--                timeout 50_000 do-                  Connection.use connection do-                    Session.script "begin;"-                    Execution.sessionByParams (Statements.Sleep 0.1)--              result `shouldBe` Nothing--              -- Verify we can start a new transaction without "already in progress" error-              result <--                Connection.use connection do-                  Session.script "begin;"-                  s <- Session.statement () checkTransactionStatus-                  Session.script "commit;"-                  return s--              result `shouldBe` Right 1--      it "Does not corrupt the prepared statement registry" do-        let returnIntStatement =-              Statement.preparable-                "select $1::int"-                (Encoders.param (Encoders.nonNullable Encoders.int4))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))-         in \config -> Scripts.onPreparableConnection config \connection -> do-              -- Use a prepared statement first-              result <--                Connection.use connection do-                  Session.statement 42 returnIntStatement--              result `shouldBe` Right 42--              -- Timeout during transaction (causes connection reset)-              result <--                timeout 50_000 do-                  Connection.use connection do-                    Session.script "begin;"-                    Execution.sessionByParams (Statements.Sleep 0.1)-                    Session.script "commit;"--              result `shouldBe` Nothing--              -- The prepared statement should work again without "does not exist" error-              result <--                Connection.use connection do-                  Session.statement 99 returnIntStatement--              result `shouldBe` Right 99
− src/library-tests/Sharing/ByUnit/Decoders/CitextSpec.hs 
@@ -1,85 +0,0 @@-module Sharing.ByUnit.Decoders.CitextSpec (spec) where--import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Citext Decoders" do-    it "decodes a citext value" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          catchError-            ( Session.statement ()-                $ Statement.unpreparable-                  "CREATE EXTENSION IF NOT EXISTS citext"-                  Encoders.noParams-                  Decoders.noResult-            )-            (const (pure ()))-          Session.statement ()-            $ Statement.preparable-              "select 'Hello World'::citext"-              mempty-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.citext)))-        result `shouldBe` Right "Hello World"--    it "decodes a citext value preserving case" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          catchError-            ( Session.statement ()-                $ Statement.unpreparable-                  "CREATE EXTENSION IF NOT EXISTS citext"-                  Encoders.noParams-                  Decoders.noResult-            )-            (const (pure ()))-          Session.statement ()-            $ Statement.preparable-              "select 'HeLLo WoRLd'::citext"-              mempty-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.citext)))-        result `shouldBe` Right "HeLLo WoRLd"--    it "decodes a nullable citext value" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          catchError-            ( Session.statement ()-                $ Statement.unpreparable-                  "CREATE EXTENSION IF NOT EXISTS citext"-                  Encoders.noParams-                  Decoders.noResult-            )-            (const (pure ()))-          Session.statement ()-            $ Statement.preparable-              "select null::citext"-              mempty-              (Decoders.singleRow (Decoders.column (Decoders.nullable Decoders.citext)))-        result `shouldBe` Right (Nothing :: Maybe Text)--    it "decodes citext case-insensitive comparison in SQL" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          catchError-            ( Session.statement ()-                $ Statement.unpreparable-                  "CREATE EXTENSION IF NOT EXISTS citext"-                  Encoders.noParams-                  Decoders.noResult-            )-            (const (pure ()))-          Session.statement ()-            $ Statement.preparable-              "select 'hello'::citext = 'HELLO'::citext"-              mempty-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        result `shouldBe` Right True
− src/library-tests/Sharing/ByUnit/Decoders/Composite/OidMismatchSpec.hs 
@@ -1,165 +0,0 @@-module Sharing.ByUnit.Decoders.Composite.OidMismatchSpec (spec) where--import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Errors qualified as Errors-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Composite field OID mismatch detection" do-    describe "Decoder field type mismatch" do-      it "detects when decoder expects int4 but actual field is int8" \config -> do-        typeName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create composite type with int8 field-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", typeName, " as (x int8)"])-                mempty-                Decoders.noResult-            -- Try to decode with int4 decoder-            Session.statement ()-              $ Statement.preparable-                (mconcat ["select row(42) :: ", typeName])-                mempty-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            ( Decoders.composite-                                Nothing-                                typeName-                                -- Using int4 decoder for int8 field - should fail-                                (Decoders.field (Decoders.nonNullable Decoders.int4))-                            )-                        )-                    )-                )-          -- The error should indicate a decoding failure due to type mismatch-          case result of-            Left (Errors.StatementSessionError _ _ _ _ _ (Errors.RowStatementError _ (Errors.CellRowError _ _ (Errors.DeserializationCellError msg)))) -> do-              -- PostgreSQL binary decoder should detect the OID mismatch-              toList msg `shouldContain` "Unexpected OID"-            Left err ->-              expectationFailure ("Unexpected type of error: " <> show err)-            Right _ ->-              expectationFailure "Expected an error but got success"--      it "detects when decoder expects int8 but actual field is int4" \config -> do-        typeName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create composite type with int4 field-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", typeName, " as (x int4)"])-                mempty-                Decoders.noResult-            -- Try to decode with int8 decoder-            Session.statement ()-              $ Statement.preparable-                (mconcat ["select row(42) :: ", typeName])-                mempty-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            ( Decoders.composite-                                Nothing-                                typeName-                                -- Using int8 decoder for int4 field - should fail-                                (Decoders.field (Decoders.nonNullable Decoders.int8))-                            )-                        )-                    )-                )-          -- The error should indicate a decoding failure due to type mismatch-          case result of-            Left (Errors.StatementSessionError _ _ _ _ _ (Errors.RowStatementError _ (Errors.CellRowError _ _ (Errors.DeserializationCellError msg)))) -> do-              -- PostgreSQL binary decoder should detect the OID mismatch-              toList msg `shouldContain` "Unexpected OID"-            Left err ->-              expectationFailure ("Unexpected type of error: " <> show err)-            Right _ ->-              expectationFailure "Expected an error but got success"--      it "detects when decoder expects text but actual field is int8" \config -> do-        typeName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create composite type with int8 field-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", typeName, " as (x int8)"])-                mempty-                Decoders.noResult-            -- Try to decode with text decoder-            Session.statement ()-              $ Statement.preparable-                (mconcat ["select row(42) :: ", typeName])-                mempty-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            ( Decoders.composite-                                Nothing-                                typeName-                                -- Using text decoder for int8 field - should fail-                                (Decoders.field (Decoders.nonNullable Decoders.text))-                            )-                        )-                    )-                )-          -- The error should indicate a decoding failure due to type mismatch-          case result of-            Left (Errors.StatementSessionError _ _ _ _ _ (Errors.RowStatementError _ (Errors.CellRowError _ _ (Errors.DeserializationCellError _msg)))) -> do-              -- PostgreSQL binary decoder should detect the type mismatch-              pure ()-            Left err ->-              expectationFailure ("Unexpected type of error: " <> show err)-            Right _ ->-              expectationFailure "Expected an error but got success"--    describe "Multiple fields with mismatches" do-      it "detects mismatch in second field" \config -> do-        typeName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create composite type with int8, int4 fields-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", typeName, " as (a int8, b int4)"])-                mempty-                Decoders.noResult-            -- Try to decode with correct first field but wrong second field-            Session.statement ()-              $ Statement.preparable-                (mconcat ["select row(1, 2) :: ", typeName])-                mempty-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            ( Decoders.composite-                                Nothing-                                typeName-                                ( (,)-                                    <$> Decoders.field (Decoders.nonNullable Decoders.int8)-                                    -- Using int8 decoder for int4 field - should fail-                                    <*> Decoders.field (Decoders.nonNullable Decoders.int8)-                                )-                            )-                        )-                    )-                )-          -- The error should indicate a decoding failure-          case result of-            Left (Errors.StatementSessionError _ _ _ _ _ (Errors.RowStatementError _ (Errors.CellRowError _ _ (Errors.DeserializationCellError _msg)))) -> do-              pure ()-            Left err ->-              expectationFailure ("Unexpected type of error: " <> show err)-            Right _ ->-              expectationFailure "Expected an error but got success"
− src/library-tests/Sharing/ByUnit/Decoders/CompositeSpec.hs 
@@ -1,777 +0,0 @@-module Sharing.ByUnit.Decoders.CompositeSpec (spec) where--import Data.HashSet qualified as HashSet-import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Errors qualified as Errors-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Named Composite Decoders" do-    describe "Simple composites" do-      it "decodes a simple named composite from static SQL" \config -> do-        typeName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create composite type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", typeName, " as (x int8, y bool)"])-                mempty-                Decoders.noResult-            -- Test decoding from static value-            Session.statement ()-              $ Statement.preparable-                (mconcat ["select (42, true) :: ", typeName])-                mempty-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            ( Decoders.composite-                                Nothing-                                typeName-                                ( (,)-                                    <$> Decoders.field (Decoders.nonNullable Decoders.int8)-                                    <*> Decoders.field (Decoders.nonNullable Decoders.bool)-                                )-                            )-                        )-                    )-                )-          result `shouldBe` Right (42 :: Int64, True)--      it "decodes a simple named composite with different values" \config -> do-        typeName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create composite type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", typeName, " as (a text, b int4)"])-                mempty-                Decoders.noResult-            -- Test decoding-            Session.statement ()-              $ Statement.preparable-                (mconcat ["select ('hello', 123) :: ", typeName])-                mempty-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            ( Decoders.composite-                                Nothing-                                typeName-                                ( (,)-                                    <$> Decoders.field (Decoders.nonNullable Decoders.text)-                                    <*> Decoders.field (Decoders.nonNullable Decoders.int4)-                                )-                            )-                        )-                    )-                )-          result `shouldBe` Right ("hello", 123 :: Int32)--    describe "Nested composites" do-      it "decodes nested named composites from static SQL" \config -> do-        innerType <- Scripts.generateSymname-        outerType <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create inner composite type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", innerType, " as (x int8, y bool)"])-                mempty-                Decoders.noResult-            -- Create outer composite type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", outerType, " as (\"inner\" ", innerType, ", z text)"])-                mempty-                Decoders.noResult-            -- Test nested decoding-            Session.statement ()-              $ Statement.preparable-                (mconcat ["select ((42, true), 'world') :: ", outerType])-                mempty-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            ( Decoders.composite-                                Nothing-                                outerType-                                ( (,)-                                    <$> Decoders.field-                                      ( Decoders.nonNullable-                                          ( Decoders.composite-                                              Nothing-                                              innerType-                                              ( (,)-                                                  <$> Decoders.field (Decoders.nonNullable Decoders.int8)-                                                  <*> Decoders.field (Decoders.nonNullable Decoders.bool)-                                              )-                                          )-                                      )-                                    <*> Decoders.field (Decoders.nonNullable Decoders.text)-                                )-                            )-                        )-                    )-                )-          result `shouldBe` Right ((42 :: Int64, True), "world")--      it "decodes deeply nested named composites" \config -> do-        type1 <- Scripts.generateSymname-        type2 <- Scripts.generateSymname-        type3 <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create level 1 composite-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", type1, " as (val int8)"])-                mempty-                Decoders.noResult-            -- Create level 2 composite-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", type2, " as (\"inner\" ", type1, ", flag bool)"])-                mempty-                Decoders.noResult-            -- Create level 3 composite-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", type3, " as (\"nested\" ", type2, ", name text)"])-                mempty-                Decoders.noResult-            -- Test deeply nested decoding-            Session.statement ()-              $ Statement.preparable-                (mconcat ["select row (row (row (99), true), 'deep') :: ", type3])-                mempty-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            ( Decoders.composite-                                Nothing-                                type3-                                ( (,)-                                    <$> Decoders.field-                                      ( Decoders.nonNullable-                                          ( Decoders.composite-                                              Nothing-                                              type2-                                              ( (,)-                                                  <$> Decoders.field-                                                    ( Decoders.nonNullable-                                                        ( Decoders.composite-                                                            Nothing-                                                            type1-                                                            (Decoders.field (Decoders.nonNullable Decoders.int8))-                                                        )-                                                    )-                                                  <*> Decoders.field (Decoders.nonNullable Decoders.bool)-                                              )-                                          )-                                      )-                                    <*> Decoders.field (Decoders.nonNullable Decoders.text)-                                )-                            )-                        )-                    )-                )-          result `shouldBe` Right ((99 :: Int64, True), "deep")--    describe "Arrays of composites" do-      it "decodes arrays of primitives" \config -> do-        typeName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", typeName, " as (x int4[])"])-                mempty-                Decoders.noResult-            Session.statement ()-              $ Statement.preparable-                (mconcat ["select row(array[1,2,3])", " :: ", typeName])-                mempty-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            ( Decoders.composite-                                Nothing-                                typeName-                                ( Decoders.field-                                    ( Decoders.nonNullable-                                        ( Decoders.array-                                            ( Decoders.dimension-                                                replicateM-                                                ( Decoders.element-                                                    (Decoders.nonNullable Decoders.int4)-                                                )-                                            )-                                        )-                                    )-                                )-                            )-                        )-                    )-                )-          result `shouldBe` Right [1, 2, 3]--      it "decodes arrays of named composites from static SQL" \config -> do-        typeName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create composite type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", typeName, " as (x int8, y bool)"])-                mempty-                Decoders.noResult-            -- Test array decoding-            Session.statement ()-              $ Statement.preparable-                (mconcat ["select array[(1, true), (2, false), (3, true)] :: ", typeName, "[]"])-                mempty-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            ( Decoders.array-                                ( Decoders.dimension-                                    replicateM-                                    ( Decoders.element-                                        ( Decoders.nonNullable-                                            ( Decoders.composite-                                                Nothing-                                                typeName-                                                ( (,)-                                                    <$> Decoders.field (Decoders.nonNullable Decoders.int8)-                                                    <*> Decoders.field (Decoders.nonNullable Decoders.bool)-                                                )-                                            )-                                        )-                                    )-                                )-                            )-                        )-                    )-                )-          result `shouldBe` Right [(1 :: Int64, True), (2, False), (3, True)]--      it "decodes 2D arrays of named composites" \config -> do-        typeName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create composite type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", typeName, " as (val int4)"])-                mempty-                Decoders.noResult-            -- Test 2D array decoding-            Session.statement ()-              $ Statement.preparable-                (mconcat ["select array[array[row (1), row (2)], array[row (3), row (4)]] :: ", typeName, "[][]"])-                mempty-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            ( Decoders.array-                                ( Decoders.dimension-                                    replicateM-                                    ( Decoders.dimension-                                        replicateM-                                        ( Decoders.element-                                            ( Decoders.nonNullable-                                                ( Decoders.composite-                                                    Nothing-                                                    typeName-                                                    (Decoders.field (Decoders.nonNullable Decoders.int4))-                                                )-                                            )-                                        )-                                    )-                                )-                            )-                        )-                    )-                )-          result `shouldBe` Right [[1 :: Int32, 2], [3, 4]]--    describe "Composites with array fields" do-      it "decodes a composite with an enum array field" \config -> do-        enumType <- Scripts.generateSymname-        compositeType <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create enum type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", enumType, " as enum ('red', 'green', 'blue')"])-                mempty-                Decoders.noResult-            -- Create composite type with enum array field-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", compositeType, " as (id int8, colors ", enumType, "[])"])-                mempty-                Decoders.noResult-            -- Test decoding composite with enum array field-            Session.statement ()-              $ Statement.preparable-                (mconcat ["select (42, array['red', 'green', 'blue'] :: ", enumType, "[]) :: ", compositeType])-                mempty-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            ( Decoders.composite-                                Nothing-                                compositeType-                                ( (,)-                                    <$> Decoders.field (Decoders.nonNullable Decoders.int8)-                                    <*> Decoders.field-                                      ( Decoders.nonNullable-                                          ( Decoders.array-                                              ( Decoders.dimension-                                                  replicateM-                                                  ( Decoders.element-                                                      ( Decoders.nonNullable-                                                          ( Decoders.enum-                                                              Nothing-                                                              enumType-                                                              Just-                                                          )-                                                      )-                                                  )-                                              )-                                          )-                                      )-                                )-                            )-                        )-                    )-                )-          result `shouldBe` Right (42 :: Int64, ["red", "green", "blue"])--      it "decodes a composite with multiple enum array fields" \config -> do-        enum1 <- Scripts.generateSymname-        enum2 <- Scripts.generateSymname-        compositeType <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create first enum type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", enum1, " as enum ('small', 'medium', 'large')"])-                mempty-                Decoders.noResult-            -- Create second enum type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", enum2, " as enum ('low', 'high')"])-                mempty-                Decoders.noResult-            -- Create composite type with multiple enum array fields-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", compositeType, " as (sizes ", enum1, "[], priorities ", enum2, "[])"])-                mempty-                Decoders.noResult-            -- Test decoding composite with multiple enum array fields-            Session.statement ()-              $ Statement.preparable-                (mconcat ["select (array['small', 'large'] :: ", enum1, "[], array['high', 'low'] :: ", enum2, "[]) :: ", compositeType])-                mempty-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            ( Decoders.composite-                                Nothing-                                compositeType-                                ( (,)-                                    <$> Decoders.field-                                      ( Decoders.nonNullable-                                          ( Decoders.array-                                              ( Decoders.dimension-                                                  replicateM-                                                  ( Decoders.element-                                                      ( Decoders.nonNullable-                                                          ( Decoders.enum-                                                              Nothing-                                                              enum1-                                                              Just-                                                          )-                                                      )-                                                  )-                                              )-                                          )-                                      )-                                    <*> Decoders.field-                                      ( Decoders.nonNullable-                                          ( Decoders.array-                                              ( Decoders.dimension-                                                  replicateM-                                                  ( Decoders.element-                                                      ( Decoders.nonNullable-                                                          ( Decoders.enum-                                                              Nothing-                                                              enum2-                                                              Just-                                                          )-                                                      )-                                                  )-                                              )-                                          )-                                      )-                                )-                            )-                        )-                    )-                )-          result `shouldBe` Right (["small", "large"], ["high", "low"])--      it "decodes a composite with mixed scalar and enum array fields" \config -> do-        enumType <- Scripts.generateSymname-        compositeType <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create enum type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", enumType, " as enum ('A', 'B', 'C')"])-                mempty-                Decoders.noResult-            -- Create composite type with mixed fields-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", compositeType, " as (name text, age int4, grades ", enumType, "[])"])-                mempty-                Decoders.noResult-            -- Test decoding composite with mixed fields-            Session.statement ()-              $ Statement.preparable-                (mconcat ["select ('Alice', 25, array['A', 'B', 'A'] :: ", enumType, "[]) :: ", compositeType])-                mempty-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            ( Decoders.composite-                                Nothing-                                compositeType-                                ( do-                                    name <- Decoders.field (Decoders.nonNullable Decoders.text)-                                    age <- Decoders.field (Decoders.nonNullable Decoders.int4)-                                    grades <--                                      Decoders.field-                                        ( Decoders.nonNullable-                                            ( Decoders.array-                                                ( Decoders.dimension-                                                    replicateM-                                                    ( Decoders.element-                                                        ( Decoders.nonNullable-                                                            ( Decoders.enum-                                                                Nothing-                                                                enumType-                                                                ( \case-                                                                    "A" -> Just 'A'-                                                                    "B" -> Just 'B'-                                                                    "C" -> Just 'C'-                                                                    _ -> Nothing-                                                                )-                                                            )-                                                        )-                                                    )-                                                )-                                            )-                                        )-                                    pure (name, age, grades)-                                )-                            )-                        )-                    )-                )-          result `shouldBe` Right ("Alice", 25 :: Int32, ['A', 'B', 'A'])--      it "decodes nested composite with enum array field" \config -> do-        enumType <- Scripts.generateSymname-        innerType <- Scripts.generateSymname-        outerType <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create enum type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", enumType, " as enum ('x', 'y', 'z')"])-                mempty-                Decoders.noResult-            -- Create inner composite type with enum array field-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", innerType, " as (values ", enumType, "[])"])-                mempty-                Decoders.noResult-            -- Create outer composite type containing the inner type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", outerType, " as (id int4, data ", innerType, ")"])-                mempty-                Decoders.noResult-            -- Test nested decoding-            Session.statement ()-              $ Statement.preparable-                (mconcat ["select (100, row(array['x', 'y', 'z'] :: ", enumType, "[]) :: ", innerType, ") :: ", outerType])-                mempty-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            ( Decoders.composite-                                Nothing-                                outerType-                                ( (,)-                                    <$> Decoders.field (Decoders.nonNullable Decoders.int4)-                                    <*> Decoders.field-                                      ( Decoders.nonNullable-                                          ( Decoders.composite-                                              Nothing-                                              innerType-                                              ( Decoders.field-                                                  ( Decoders.nonNullable-                                                      ( Decoders.array-                                                          ( Decoders.dimension-                                                              replicateM-                                                              ( Decoders.element-                                                                  ( Decoders.nonNullable-                                                                      ( Decoders.enum-                                                                          Nothing-                                                                          enumType-                                                                          ( \case-                                                                              "x" -> Just 'x'-                                                                              "y" -> Just 'y'-                                                                              "z" -> Just 'z'-                                                                              _ -> Nothing-                                                                          )-                                                                      )-                                                                  )-                                                              )-                                                          )-                                                      )-                                                  )-                                              )-                                          )-                                      )-                                )-                            )-                        )-                    )-                )-          result `shouldBe` Right (100 :: Int32, ['x', 'y', 'z'])--      it "decodes a composite with 2D enum array field" \config -> do-        enumType <- Scripts.generateSymname-        compositeType <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create enum type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", enumType, " as enum ('0', '1')"])-                mempty-                Decoders.noResult-            -- Create composite type with 2D enum array field-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", compositeType, " as (matrix ", enumType, "[][])"])-                mempty-                Decoders.noResult-            -- Test decoding composite with 2D enum array field-            Session.statement ()-              $ Statement.preparable-                (mconcat ["select row(array[array['0', '1'], array['1', '0']] :: ", enumType, "[][]) :: ", compositeType])-                mempty-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            ( Decoders.composite-                                Nothing-                                compositeType-                                ( Decoders.field-                                    ( Decoders.nonNullable-                                        ( Decoders.array-                                            ( Decoders.dimension-                                                replicateM-                                                ( Decoders.dimension-                                                    replicateM-                                                    ( Decoders.element-                                                        ( Decoders.nonNullable-                                                            ( Decoders.enum-                                                                Nothing-                                                                enumType-                                                                ( \case-                                                                    "0" -> Just (0 :: Int)-                                                                    "1" -> Just 1-                                                                    _ -> Nothing-                                                                )-                                                            )-                                                        )-                                                    )-                                                )-                                            )-                                        )-                                    )-                                )-                            )-                        )-                    )-                )-          result `shouldBe` Right [[0, 1], [1, 0]]--    describe "OID compatibility checking" do-      it "fails when decoder expects a composite but gets a different type" \config -> do-        typeName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create composite type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", typeName, " as (x int8, y bool)"])-                mempty-                Decoders.noResult-            -- Try to decode text as the composite type (should fail during deserialization)-            Session.statement ()-              $ Statement.preparable-                "select 'some text'::text"-                mempty-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            ( Decoders.composite-                                Nothing-                                typeName-                                ( (,)-                                    <$> Decoders.field (Decoders.nonNullable Decoders.int8)-                                    <*> Decoders.field (Decoders.nonNullable Decoders.bool)-                                )-                            )-                        )-                    )-                )-          -- Should fail with a cell error because text cannot be decoded as a composite-          case result of-            Left (Errors.StatementSessionError _ _ _ _ _ (Errors.UnexpectedColumnTypeStatementError 0 _ _)) ->-              pure ()-            Left err ->-              expectationFailure ("Unexpected type of error: " <> show err)-            Right _ ->-              expectationFailure "Expected an error but got success"--      it "fails when decoder expects one composite type but gets another" \config -> do-        type1 <- Scripts.generateSymname-        type2 <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create first composite type with two fields-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", type1, " as (x int8, y text)"])-                mempty-                Decoders.noResult-            -- Create second composite type with different structure-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", type2, " as (a bool)"])-                mempty-                Decoders.noResult-            -- Try to decode type2 value as type1 (should fail during deserialization)-            -- type2 has 1 field, type1 decoder expects 2 fields-            Session.statement ()-              $ Statement.preparable-                (mconcat ["select row (true) :: ", type2])-                mempty-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            ( Decoders.composite-                                Nothing-                                type1-                                ( (,)-                                    <$> Decoders.field (Decoders.nonNullable Decoders.int8)-                                    <*> Decoders.field (Decoders.nonNullable Decoders.text)-                                )-                            )-                        )-                    )-                )-          -- Should fail with a cell error because the field count doesn't match-          case result of-            Left (Errors.StatementSessionError _ _ _ _ _ (Errors.UnexpectedColumnTypeStatementError 0 _ _)) ->-              pure ()-            Left err ->-              expectationFailure ("Unexpected type of error: " <> show err)-            Right _ ->-              expectationFailure "Expected an error but got success"--      it "correctly validates matching composite type OIDs" \config -> do-        typeName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create composite type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", typeName, " as (x int8, y bool)"])-                mempty-                Decoders.noResult-            -- Decode with correct type - should succeed-            Session.statement ()-              $ Statement.preparable-                (mconcat ["select row (42, true) :: ", typeName])-                mempty-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            ( Decoders.composite-                                Nothing-                                typeName-                                ( (,)-                                    <$> Decoders.field (Decoders.nonNullable Decoders.int8)-                                    <*> Decoders.field (Decoders.nonNullable Decoders.bool)-                                )-                            )-                        )-                    )-                )-          result `shouldBe` Right (42 :: Int64, True)--  it "detects attempts to decode non-existent composite types" \config -> do-    Scripts.onPreparableConnection config \connection -> do-      result <- Connection.use connection do-        Session.statement ()-          $ Statement.preparable-            "select row(42, text 'test')"-            mempty-            ( Decoders.singleRow-                ( Decoders.column-                    ( Decoders.nonNullable-                        ( Decoders.composite-                            Nothing-                            "nonexistent_composite_type"-                            ( (,)-                                <$> Decoders.field (Decoders.nonNullable Decoders.int4)-                                <*> Decoders.field (Decoders.nonNullable Decoders.text)-                            )-                        )-                    )-                )-            )--      case result of-        Left (Errors.MissingTypesSessionError missingTypes) ->-          missingTypes `shouldBe` HashSet.fromList [(Nothing, "nonexistent_composite_type")]-        _ ->-          expectationFailure ("Unexpected result: " <> show result)
− src/library-tests/Sharing/ByUnit/Decoders/CustomSpec.hs 
@@ -1,286 +0,0 @@-module Sharing.ByUnit.Decoders.CustomSpec (spec) where--import Data.ByteString qualified as ByteString-import Data.HashSet qualified as HashSet-import Data.Text.Encoding (encodeUtf8)-import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Errors qualified as Errors-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Basic custom decoders" do-    it "decodes a custom type with runtime OID lookup" \config -> do-      enumName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create enum type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", enumName, " as enum ('alpha', 'beta', 'gamma')"])-              mempty-              Decoders.noResult-          -- Test custom decoder with runtime OID lookup-          Session.statement ()-            $ Statement.preparable-              (mconcat ["select 'beta' :: ", enumName])-              mempty-              ( Decoders.singleRow-                  ( Decoders.column-                      ( Decoders.nonNullable-                          ( Decoders.custom-                              Nothing-                              enumName-                              Nothing-                              []-                              (\_ bytes -> Right (ByteString.length bytes, bytes))-                          )-                      )-                  )-              )-        -- Should successfully decode with length and bytes-        case result of-          Right (len, bytes) -> do-            len `shouldBe` 4-            bytes `shouldBe` "beta"-          Left err ->-            expectationFailure ("Unexpected error: " <> show err)--    it "decodes a custom type with static OIDs" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Test custom decoder with static OIDs for int4 (type OID 23, array OID 1007)-          Session.statement ()-            $ Statement.preparable-              "select 42::int4"-              mempty-              ( Decoders.singleRow-                  ( Decoders.column-                      ( Decoders.nonNullable-                          ( Decoders.custom-                              Nothing-                              "int4"-                              (Just (23, 1007))-                              []-                              (\_ bytes -> Right (ByteString.length bytes))-                          )-                      )-                  )-              )-        -- int4 is encoded in 4 bytes-        result `shouldBe` Right 4--    it "decodes with dependent type OID requests" \config -> do-      enumName <- Scripts.generateSymname-      compositeName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create enum type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", enumName, " as enum ('small', 'large')"])-              mempty-              Decoders.noResult-          -- Create composite type with the enum-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", compositeName, " as (size ", enumName, ", count int4)"])-              mempty-              Decoders.noResult-          -- Test custom decoder requesting OIDs of dependent types-          Session.statement ()-            $ Statement.preparable-              (mconcat ["select ('large', 5) :: ", compositeName])-              mempty-              ( Decoders.singleRow-                  ( Decoders.column-                      ( Decoders.nonNullable-                          ( Decoders.custom-                              Nothing-                              compositeName-                              Nothing-                              [(Nothing, enumName), (Nothing, "int4")]-                              ( \lookupOid bytes -> do-                                  let (enumOidScalar, _enumOidArray) = lookupOid (Nothing, enumName)-                                      (int4OidScalar, _int4OidArray) = lookupOid (Nothing, "int4")-                                  -- Verify we got valid OIDs-                                  if enumOidScalar > 0 && int4OidScalar > 0-                                    then Right (enumOidScalar, int4OidScalar, ByteString.length bytes)-                                    else Left "Failed to resolve OIDs"-                              )-                          )-                      )-                  )-              )-        -- Should successfully get OIDs and byte length-        case result of-          Right (enumOid, int4Oid, len) -> do-            enumOid `shouldSatisfy` (> 0)-            int4Oid `shouldBe` 23-            len `shouldSatisfy` (> 0)-          Left err ->-            expectationFailure ("Unexpected error: " <> show err)--  describe "Error handling" do-    it "detects missing types in custom decoders" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          Session.statement ()-            $ Statement.preparable-              "select 'test'::text"-              mempty-              ( Decoders.singleRow-                  ( Decoders.column-                      ( Decoders.nonNullable-                          ( Decoders.custom-                              Nothing-                              "nonexistent_custom_type"-                              Nothing-                              []-                              (\_ bytes -> Right bytes)-                          )-                      )-                  )-              )--        case result of-          Left (Errors.MissingTypesSessionError missingTypes) ->-            missingTypes `shouldBe` HashSet.fromList [(Nothing, "nonexistent_custom_type")]-          _ ->-            expectationFailure ("Unexpected result: " <> show result)--    it "detects missing dependent types in custom decoders" \config -> do-      customTypeName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create a custom type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", customTypeName, " as (id int4)"])-              mempty-              Decoders.noResult-          -- Try to decode it but request a non-existent dependent type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["select (42) :: ", customTypeName])-              mempty-              ( Decoders.singleRow-                  ( Decoders.column-                      ( Decoders.nonNullable-                          ( Decoders.custom-                              Nothing-                              customTypeName-                              Nothing-                              [(Nothing, "nonexistent_dependency")]-                              (\_ bytes -> Right bytes)-                          )-                      )-                  )-              )--        case result of-          Left (Errors.MissingTypesSessionError missingTypes) ->-            missingTypes `shouldBe` HashSet.fromList [(Nothing, "nonexistent_dependency")]-          _ ->-            expectationFailure ("Unexpected result: " <> show result)--    it "handles decoding errors in custom decoders" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          Session.statement ()-            $ Statement.preparable-              "select 42::int4"-              mempty-              ( Decoders.singleRow-                  ( Decoders.column-                      ( Decoders.nonNullable-                          ( Decoders.custom-                              Nothing-                              "int4"-                              (Just (23, 1007))-                              []-                              (\_ _ -> Left "Custom decoding error")-                          )-                      )-                  )-              )--        case result of-          Left (Errors.StatementSessionError {}) -> pure ()-          _ ->-            expectationFailure "Expected statement error"--  describe "Roundtrip tests" do-    it "roundtrips custom encoded and decoded values" \config -> do-      enumName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create enum type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", enumName, " as enum ('one', 'two', 'three')"])-              mempty-              Decoders.noResult-          -- Test roundtrip using custom encoder and decoder-          Session.statement "two"-            $ Statement.preparable-              (mconcat ["select $1 :: ", enumName])-              (Encoders.param (Encoders.nonNullable (Encoders.custom Nothing enumName Nothing [] (\_ val -> encodeUtf8 val) id)))-              ( Decoders.singleRow-                  ( Decoders.column-                      ( Decoders.nonNullable-                          ( Decoders.custom-                              Nothing-                              enumName-                              Nothing-                              []-                              (\_ bytes -> Right bytes)-                          )-                      )-                  )-              )-        result `shouldBe` Right "two"--  describe "Schema-qualified types" do-    it "decodes custom types from specific schemas" \config -> do-      schemaName <- Scripts.generateSymname-      typeName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create schema-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create schema ", schemaName])-              mempty-              Decoders.noResult-          -- Create enum type in that schema-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", schemaName, ".", typeName, " as enum ('x', 'y')"])-              mempty-              Decoders.noResult-          -- Test custom decoder with schema qualification-          Session.statement ()-            $ Statement.preparable-              (mconcat ["select 'y' :: ", schemaName, ".", typeName])-              mempty-              ( Decoders.singleRow-                  ( Decoders.column-                      ( Decoders.nonNullable-                          ( Decoders.custom-                              (Just schemaName)-                              typeName-                              Nothing-                              []-                              (\_ bytes -> Right bytes)-                          )-                      )-                  )-              )-        result `shouldBe` Right "y"
− src/library-tests/Sharing/ByUnit/Decoders/DomainSpec.hs 
@@ -1,194 +0,0 @@-module Sharing.ByUnit.Decoders.DomainSpec (spec) where--import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Domain type decoding" do-    describe "Simple scalar domains" do-      it "decodes a domain based on int8 using int8 codec" \config -> do-        domainName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create domain type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create domain ", domainName, " as int8"])-                mempty-                Decoders.noResult-            -- Test decoding from static value-            Session.statement ()-              $ Statement.preparable-                (mconcat ["select 42 :: ", domainName])-                mempty-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))-          result `shouldBe` Right (42 :: Int64)--      it "decodes a domain based on text using text codec" \config -> do-        domainName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create domain type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create domain ", domainName, " as text"])-                mempty-                Decoders.noResult-            -- Test decoding from static value-            Session.statement ()-              $ Statement.preparable-                (mconcat ["select 'hello' :: ", domainName])-                mempty-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)))-          result `shouldBe` Right "hello"--      it "decodes a domain based on bool using bool codec" \config -> do-        domainName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create domain type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create domain ", domainName, " as bool"])-                mempty-                Decoders.noResult-            -- Test decoding from static value-            Session.statement ()-              $ Statement.preparable-                (mconcat ["select true :: ", domainName])-                mempty-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-          result `shouldBe` Right True--      it "roundtrips a domain based on numeric" \config -> do-        domainName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create domain type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create domain ", domainName, " as numeric"])-                mempty-                Decoders.noResult-            -- Test roundtrip-            Session.statement (123.456 :: Scientific)-              $ Statement.preparable-                (mconcat ["select $1 :: ", domainName])-                (Encoders.param (Encoders.nonNullable Encoders.numeric))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.numeric)))-          result `shouldBe` Right (123.456 :: Scientific)--    describe "Domain with constraints" do-      it "decodes domain values that satisfy constraints" \config -> do-        domainName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create domain type with constraint-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create domain ", domainName, " as int8 check (value > 0)"])-                mempty-                Decoders.noResult-            -- Decode value that satisfies constraint-            Session.statement ()-              $ Statement.preparable-                (mconcat ["select 42 :: ", domainName])-                mempty-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))-          result `shouldBe` Right (42 :: Int64)--    describe "Domain type cast compatibility for composite usage" do-      it "decodes domain value cast to base type from composite field" \config -> do-        domainName <- Scripts.generateSymname-        compositeName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create domain type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create domain ", domainName, " as int8"])-                mempty-                Decoders.noResult-            -- Create composite type with domain field-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", compositeName, " as (x ", domainName, ", y bool)"])-                mempty-                Decoders.noResult-            -- Extract and cast domain field to base type for decoding-            Session.statement ()-              $ Statement.preparable-                (mconcat ["select ((42 :: ", domainName, ") :: int8)"])-                mempty-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))-          result `shouldBe` Right (42 :: Int64)--    describe "Domain type cast compatibility for array usage" do-      it "decodes array cast from domain array to base type array" \config -> do-        domainName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create domain type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create domain ", domainName, " as int8"])-                mempty-                Decoders.noResult-            -- Decode base type array-            Session.statement ()-              $ Statement.preparable-                "select ARRAY[1,2,3] :: int8[]"-                mempty-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.listArray (Decoders.nonNullable Decoders.int8)))))-          result `shouldBe` Right ([1, 2, 3] :: [Int64])--      it "roundtrips array using base type codec" \config -> do-        domainName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create domain type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create domain ", domainName, " as text"])-                mempty-                Decoders.noResult-            -- Test roundtrip using base type codec-            Session.statement (["a", "b", "c"] :: [Text])-              $ Statement.preparable-                "select $1 :: text[]"-                ( Encoders.param-                    ( Encoders.nonNullable-                        (Encoders.foldableArray (Encoders.nonNullable Encoders.text))-                    )-                )-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.listArray (Decoders.nonNullable Decoders.text)))))-          result `shouldBe` Right (["a", "b", "c"] :: [Text])--      it "decodes base type array that can work with domain arrays via cast" \config -> do-        domainName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create domain type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create domain ", domainName, " as int8"])-                mempty-                Decoders.noResult-            -- Demonstrate that base codec works for arrays-            Session.statement ([10, 20, 30] :: [Int64])-              $ Statement.preparable-                "select $1 :: int8[]"-                ( Encoders.param-                    ( Encoders.nonNullable-                        (Encoders.foldableArray (Encoders.nonNullable Encoders.int8))-                    )-                )-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.listArray (Decoders.nonNullable Decoders.int8)))))-          result `shouldBe` Right ([10, 20, 30] :: [Int64])
− src/library-tests/Sharing/ByUnit/Decoders/EnumSpec.hs 
@@ -1,302 +0,0 @@-module Sharing.ByUnit.Decoders.EnumSpec (spec) where--import Data.HashSet qualified as HashSet-import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Errors qualified as Errors-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Simple enums" do-    it "decodes a simple named enum from static SQL" \config -> do-      enumName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create enum type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", enumName, " as enum ('sad', 'ok', 'happy')"])-              mempty-              Decoders.noResult-          -- Test decoding from static value-          Session.statement ()-            $ Statement.preparable-              (mconcat ["select 'happy' :: ", enumName])-              mempty-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id)))))-        result `shouldBe` Right "happy"--    it "decodes different enum values" \config -> do-      enumName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create enum type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", enumName, " as enum ('alpha', 'beta', 'gamma')"])-              mempty-              Decoders.noResult-          -- Test decoding multiple values-          r1 <--            Session.statement ()-              $ Statement.preparable-                (mconcat ["select 'alpha' :: ", enumName])-                mempty-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id)))))-          r2 <--            Session.statement ()-              $ Statement.preparable-                (mconcat ["select 'gamma' :: ", enumName])-                mempty-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id)))))-          return (r1, r2)-        result `shouldBe` Right ("alpha", "gamma")--  describe "Enums in composites" do-    it "decodes enums nested in named composites from static SQL" \config -> do-      enumName <- Scripts.generateSymname-      compositeName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create enum type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", enumName, " as enum ('red', 'green', 'blue')"])-              mempty-              Decoders.noResult-          -- Create composite type with enum-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", compositeName, " as (id int8, color ", enumName, ")"])-              mempty-              Decoders.noResult-          -- Test decoding-          Session.statement ()-            $ Statement.preparable-              (mconcat ["select (42, 'green') :: ", compositeName])-              mempty-              ( Decoders.singleRow-                  ( Decoders.column-                      ( Decoders.nonNullable-                          ( Decoders.composite-                              Nothing-                              compositeName-                              ( (,)-                                  <$> Decoders.field (Decoders.nonNullable Decoders.int8)-                                  <*> Decoders.field (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id)))-                              )-                          )-                      )-                  )-              )-        result `shouldBe` Right (42 :: Int64, "green")--    it "decodes multiple levels of nesting with enums" \config -> do-      enumName <- Scripts.generateSymname-      innerType <- Scripts.generateSymname-      outerType <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create enum type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", enumName, " as enum ('small', 'medium', 'large')"])-              mempty-              Decoders.noResult-          -- Create inner composite with enum-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", innerType, " as (size ", enumName, ", count int4)"])-              mempty-              Decoders.noResult-          -- Create outer composite-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", outerType, " as (\"inner\" ", innerType, ", name text)"])-              mempty-              Decoders.noResult-          -- Test decoding-          Session.statement ()-            $ Statement.preparable-              (mconcat ["select (('large', 5), 'test') :: ", outerType])-              mempty-              ( Decoders.singleRow-                  ( Decoders.column-                      ( Decoders.nonNullable-                          ( Decoders.composite-                              Nothing-                              outerType-                              ( (,)-                                  <$> Decoders.field-                                    ( Decoders.nonNullable-                                        ( Decoders.composite-                                            Nothing-                                            innerType-                                            ( (,)-                                                <$> Decoders.field (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id)))-                                                <*> Decoders.field (Decoders.nonNullable Decoders.int4)-                                            )-                                        )-                                    )-                                  <*> Decoders.field (Decoders.nonNullable Decoders.text)-                              )-                          )-                      )-                  )-              )-        result `shouldBe` Right (("large", 5 :: Int32), "test")--  describe "Arrays of enums" do-    it "decodes arrays of named enums from static SQL" \config -> do-      enumName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create enum type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", enumName, " as enum ('first', 'second', 'third')"])-              mempty-              Decoders.noResult-          -- Test array decoding-          Session.statement ()-            $ Statement.preparable-              (mconcat ["select array['first', 'third', 'second'] :: ", enumName, "[]"])-              mempty-              ( Decoders.singleRow-                  ( Decoders.column-                      ( Decoders.nonNullable-                          ( Decoders.array-                              ( Decoders.dimension-                                  replicateM-                                  (Decoders.element (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id))))-                              )-                          )-                      )-                  )-              )-        result `shouldBe` Right ["first", "third", "second"]--    it "decodes 2D arrays of named enums" \config -> do-      enumName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create enum type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", enumName, " as enum ('a', 'b', 'c')"])-              mempty-              Decoders.noResult-          -- Test 2D array decoding-          Session.statement ()-            $ Statement.preparable-              (mconcat ["select array[array['a', 'b'], array['c', 'a']] :: ", enumName, "[][]"])-              mempty-              ( Decoders.singleRow-                  ( Decoders.column-                      ( Decoders.nonNullable-                          ( Decoders.array-                              ( Decoders.dimension-                                  replicateM-                                  ( Decoders.dimension-                                      replicateM-                                      (Decoders.element (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id))))-                                  )-                              )-                          )-                      )-                  )-              )-        result `shouldBe` Right [["a", "b"], ["c", "a"]]--    it "decodes arrays of composites containing enums" \config -> do-      enumName <- Scripts.generateSymname-      compositeName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create enum type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", enumName, " as enum ('low', 'high')"])-              mempty-              Decoders.noResult-          -- Create composite type with enum-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", compositeName, " as (priority ", enumName, ", id int4)"])-              mempty-              Decoders.noResult-          -- Test decoding array of composites with enums-          Session.statement ()-            $ Statement.preparable-              (mconcat ["select array[('high', 1), ('low', 2)] :: ", compositeName, "[]"])-              mempty-              ( Decoders.singleRow-                  ( Decoders.column-                      ( Decoders.nonNullable-                          ( Decoders.array-                              ( Decoders.dimension-                                  replicateM-                                  ( Decoders.element-                                      ( Decoders.nonNullable-                                          ( Decoders.composite-                                              Nothing-                                              compositeName-                                              ( (,)-                                                  <$> Decoders.field (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id)))-                                                  <*> Decoders.field (Decoders.nonNullable Decoders.int4)-                                              )-                                          )-                                      )-                                  )-                              )-                          )-                      )-                  )-              )-        result `shouldBe` Right [("high", 1 :: Int32), ("low", 2)]--  it "detects attempts to decode non-existent enum types" \config -> do-    Scripts.onPreparableConnection config \connection -> do-      result <- Connection.use connection do-        Session.statement ()-          $ Statement.preparable-            "select 'value'::text"-            mempty-            (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.enum Nothing "nonexistent_enum_type" (Just . id)))))--      case result of-        Left (Errors.MissingTypesSessionError missingTypes) ->-          missingTypes `shouldBe` HashSet.fromList [(Nothing, "nonexistent_enum_type")]-        _ ->-          expectationFailure ("Unexpected result: " <> show result)--  it "detects attempts to decode arrays of non-existent enum types" \config -> do-    Scripts.onPreparableConnection config \connection -> do-      result <- Connection.use connection do-        Session.statement ()-          $ Statement.preparable-            "select array['a', 'b']::text[]"-            mempty-            ( Decoders.singleRow-                ( Decoders.column-                    ( Decoders.nonNullable-                        ( Decoders.array-                            ( Decoders.dimension-                                replicateM-                                (Decoders.element (Decoders.nonNullable (Decoders.enum Nothing "nonexistent_array_enum" (Just . id))))-                            )-                        )-                    )-                )-            )--      case result of-        Left (Errors.MissingTypesSessionError missingTypes) ->-          missingTypes `shouldBe` HashSet.fromList [(Nothing, "nonexistent_array_enum")]-        _ ->-          expectationFailure ("Unexpected result: " <> show result)
− src/library-tests/Sharing/ByUnit/Decoders/Float8Spec.hs 
@@ -1,27 +0,0 @@-module Sharing.ByUnit.Decoders.Float8Spec (spec) where--import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  it "decodes static value properly" \config -> do-    Scripts.onPreparableConnection config \connection -> do-      let statement =-            Statement.preparable-              "select 3.14 :: float8"-              mempty-              ( Decoders.singleRow-                  ( Decoders.column-                      ( Decoders.nonNullable-                          Decoders.float8-                      )-                  )-              )-      result <- Connection.use connection (Session.statement () statement)-      result `shouldBe` Right 3.14
− src/library-tests/Sharing/ByUnit/Decoders/HstoreSpec.hs 
@@ -1,114 +0,0 @@-module Sharing.ByUnit.Decoders.HstoreSpec (spec) where--import Data.HashMap.Strict qualified as HashMap-import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Hstore Decoders" do-    it "decodes empty hstore" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Enable hstore extension (unprepared), ignore if already exists-          catchError-            ( Session.statement ()-                $ Statement.unpreparable-                  "CREATE EXTENSION IF NOT EXISTS hstore"-                  Encoders.noParams-                  Decoders.noResult-            )-            (const (pure ()))-          -- Test decoding empty hstore-          Session.statement ()-            $ Statement.preparable-              "select ''::hstore"-              Encoders.noParams-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.hstore (\n f -> replicateM n f >>= pure . HashMap.fromList)))))-        result `shouldBe` Right (HashMap.empty :: HashMap.HashMap Text (Maybe Text))--    it "decodes hstore with single key-value pair" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Enable hstore extension (unprepared), ignore if already exists-          catchError-            ( Session.statement ()-                $ Statement.unpreparable-                  "CREATE EXTENSION IF NOT EXISTS hstore"-                  Encoders.noParams-                  Decoders.noResult-            )-            (const (pure ()))-          -- Test decoding single key-value pair-          Session.statement ()-            $ Statement.preparable-              "select 'key => value'::hstore"-              Encoders.noParams-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.hstore (\n f -> replicateM n f >>= pure . HashMap.fromList)))))-        result `shouldBe` Right (HashMap.fromList [("key", Just "value")] :: HashMap.HashMap Text (Maybe Text))--    it "decodes hstore with multiple key-value pairs" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Enable hstore extension (unprepared), ignore if already exists-          catchError-            ( Session.statement ()-                $ Statement.unpreparable-                  "CREATE EXTENSION IF NOT EXISTS hstore"-                  Encoders.noParams-                  Decoders.noResult-            )-            (const (pure ()))-          -- Test decoding multiple key-value pairs-          Session.statement ()-            $ Statement.preparable-              "select 'a => 1, b => 2, c => 3'::hstore"-              Encoders.noParams-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.hstore (\n f -> replicateM n f >>= pure . HashMap.fromList)))))-        result `shouldBe` Right (HashMap.fromList [("a", Just "1"), ("b", Just "2"), ("c", Just "3")] :: HashMap.HashMap Text (Maybe Text))--    it "decodes hstore with null values" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Enable hstore extension (unprepared), ignore if already exists-          catchError-            ( Session.statement ()-                $ Statement.unpreparable-                  "CREATE EXTENSION IF NOT EXISTS hstore"-                  Encoders.noParams-                  Decoders.noResult-            )-            (const (pure ()))-          -- Test decoding hstore with null values-          Session.statement ()-            $ Statement.preparable-              "select 'key1 => value1, key2 => NULL, key3 => value3'::hstore"-              Encoders.noParams-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.hstore (\n f -> replicateM n f >>= pure . HashMap.fromList)))))-        result `shouldBe` Right (HashMap.fromList [("key1", Just "value1"), ("key2", Nothing), ("key3", Just "value3")] :: HashMap.HashMap Text (Maybe Text))--    it "decodes hstore with special characters" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Enable hstore extension (unprepared), ignore if already exists-          catchError-            ( Session.statement ()-                $ Statement.unpreparable-                  "CREATE EXTENSION IF NOT EXISTS hstore"-                  Encoders.noParams-                  Decoders.noResult-            )-            (const (pure ()))-          -- Test decoding hstore with special characters-          Session.statement ()-            $ Statement.preparable-              "select '\"key with spaces\" => \"value with quotes\"'::hstore"-              Encoders.noParams-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.hstore (\n f -> replicateM n f >>= pure . HashMap.fromList)))))-        result `shouldBe` Right (HashMap.fromList [("key with spaces", Just "value with quotes")] :: HashMap.HashMap Text (Maybe Text))
− src/library-tests/Sharing/ByUnit/Decoders/InetSpec.hs 
@@ -1,72 +0,0 @@-module Sharing.ByUnit.Decoders.InetSpec (spec) where--import Data.IP (IPv4, IPv6)-import Data.IP qualified as IP-import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "INET Decoders" do-    it "decodes IPv4 address" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select '192.168.1.1/32'::inet"-                Encoders.noParams-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.inet)))-        result <- Connection.use connection (Session.statement () statement)-        let expectedAddr = read "192.168.1.1" :: IPv4-            expectedRange = IP.makeAddrRange expectedAddr 32-        result `shouldBe` Right (IP.IPv4Range expectedRange)--    it "decodes IPv4 CIDR" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select '10.0.0.0/8'::inet"-                Encoders.noParams-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.inet)))-        result <- Connection.use connection (Session.statement () statement)-        let expectedAddr = read "10.0.0.0" :: IPv4-            expectedRange = IP.makeAddrRange expectedAddr 8-        result `shouldBe` Right (IP.IPv4Range expectedRange)--    it "decodes IPv6 address" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select '::1/128'::inet"-                Encoders.noParams-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.inet)))-        result <- Connection.use connection (Session.statement () statement)-        let expectedAddr = read "::1" :: IPv6-            expectedRange = IP.makeAddrRange expectedAddr 128-        result `shouldBe` Right (IP.IPv6Range expectedRange)--  describe "MACADDR Decoders" do-    it "decodes MAC address" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select '08:00:2b:01:02:03'::macaddr"-                Encoders.noParams-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.macaddr)))-        result <- Connection.use connection (Session.statement () statement)-        result `shouldBe` Right (0x08, 0x00, 0x2b, 0x01, 0x02, 0x03)--    it "decodes another MAC address format" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select 'ff:ff:ff:ff:ff:ff'::macaddr"-                Encoders.noParams-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.macaddr)))-        result <- Connection.use connection (Session.statement () statement)-        result `shouldBe` Right (0xff, 0xff, 0xff, 0xff, 0xff, 0xff)
− src/library-tests/Sharing/ByUnit/Decoders/IntervalSpec.hs 
@@ -1,23 +0,0 @@-module Sharing.ByUnit.Decoders.IntervalSpec (spec) where--import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Interval Decoders" do-    it "decodes intervals correctly" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select interval '10 seconds'"-                Encoders.noParams-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.interval)))-        result <- Connection.use connection (Session.statement () statement)-        result `shouldBe` Right (10 :: DiffTime)
− src/library-tests/Sharing/ByUnit/Decoders/JsonSpec.hs 
@@ -1,85 +0,0 @@-module Sharing.ByUnit.Decoders.JsonSpec (spec) where--import Data.Aeson qualified as Aeson-import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "JSON Decoders" do-    it "decodes JSON null" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select 'null'::json"-                Encoders.noParams-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.json)))-        result <- Connection.use connection (Session.statement () statement)-        result `shouldBe` Right Aeson.Null--    it "decodes JSON number" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select '42'::json"-                Encoders.noParams-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.json)))-        result <- Connection.use connection (Session.statement () statement)-        result `shouldBe` Right (Aeson.Number 42)--    it "decodes JSON string" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select '\"hello\"'::json"-                Encoders.noParams-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.json)))-        result <- Connection.use connection (Session.statement () statement)-        result `shouldBe` Right (Aeson.String "hello")--    it "decodes JSON array" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select '[1,2,3]'::json"-                Encoders.noParams-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.json)))-        result <- Connection.use connection (Session.statement () statement)-        result `shouldBe` Right (Aeson.Array (fromList [Aeson.Number 1, Aeson.Number 2, Aeson.Number 3]))--    it "decodes JSON object" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select '{\"name\":\"John\",\"age\":30}'::json"-                Encoders.noParams-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.json)))-        result <- Connection.use connection (Session.statement () statement)-        result `shouldBe` Right (Aeson.object [("name", Aeson.String "John"), ("age", Aeson.Number 30)])--  describe "JSONB Decoders" do-    it "decodes JSONB object" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select '{\"key\":\"value\"}'::jsonb"-                Encoders.noParams-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.jsonb)))-        result <- Connection.use connection (Session.statement () statement)-        result `shouldBe` Right (Aeson.object [("key", Aeson.String "value")])--    it "decodes JSONB array" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select '[true, false]'::jsonb"-                Encoders.noParams-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.jsonb)))-        result <- Connection.use connection (Session.statement () statement)-        result `shouldBe` Right (Aeson.Array (fromList [Aeson.Bool True, Aeson.Bool False]))
− src/library-tests/Sharing/ByUnit/Decoders/RecordSpec.hs 
@@ -1,259 +0,0 @@-module Sharing.ByUnit.Decoders.RecordSpec (spec) where--import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Unnamed Composite Decoders" do-    describe "Simple composites" do-      it "decodes a simple unnamed composite from static SQL" \config -> do-        Scripts.onPreparableConnection config \connection -> do-          let statement =-                Statement.preparable-                  "select (1, true)"-                  mempty-                  ( Decoders.singleRow-                      ( Decoders.column-                          ( Decoders.nonNullable-                              ( Decoders.record-                                  ( (,)-                                      <$> Decoders.field (Decoders.nonNullable Decoders.int4)-                                      <*> Decoders.field (Decoders.nonNullable Decoders.bool)-                                  )-                              )-                          )-                      )-                  )-          result <- Connection.use connection (Session.statement () statement)-          result `shouldBe` Right (1, True)--      it "decodes unnamed composites with different types" \config -> do-        Scripts.onPreparableConnection config \connection -> do-          let statement =-                Statement.preparable-                  "select (text 'hello', 123)"-                  mempty-                  ( Decoders.singleRow-                      ( Decoders.column-                          ( Decoders.nonNullable-                              ( Decoders.record-                                  ( (,)-                                      <$> Decoders.field (Decoders.nonNullable Decoders.text)-                                      <*> Decoders.field (Decoders.nonNullable Decoders.int4)-                                  )-                              )-                          )-                      )-                  )-          result <- Connection.use connection (Session.statement () statement)-          result `shouldBe` Right ("hello", 123 :: Int32)--      it "decodes unnamed composites with three fields" \config -> do-        Scripts.onPreparableConnection config \connection -> do-          let statement =-                Statement.preparable-                  "select (42, text 'test', 3.14 :: float8)"-                  mempty-                  ( Decoders.singleRow-                      ( Decoders.column-                          ( Decoders.nonNullable-                              ( Decoders.record-                                  ( (,,)-                                      <$> Decoders.field (Decoders.nonNullable Decoders.int4)-                                      <*> Decoders.field (Decoders.nonNullable Decoders.text)-                                      <*> Decoders.field (Decoders.nonNullable Decoders.float8)-                                  )-                              )-                          )-                      )-                  )-          result <- Connection.use connection (Session.statement () statement)-          result `shouldBe` Right (42, "test", 3.14 :: Double)--    describe "Nested composites" do-      it "decodes nested unnamed composites from static SQL" \config -> do-        Scripts.onPreparableConnection config \connection -> do-          let statement =-                Statement.preparable-                  "select ((1, true), (text 'hello', 3))"-                  mempty-                  ( Decoders.singleRow-                      ( Decoders.column-                          ( Decoders.nonNullable-                              ( Decoders.record-                                  ( (,)-                                      <$> Decoders.field-                                        ( Decoders.nonNullable-                                            ( Decoders.record-                                                ( (,)-                                                    <$> Decoders.field (Decoders.nonNullable Decoders.int4)-                                                    <*> Decoders.field (Decoders.nonNullable Decoders.bool)-                                                )-                                            )-                                        )-                                      <*> Decoders.field-                                        ( Decoders.nonNullable-                                            ( Decoders.record-                                                ( (,)-                                                    <$> Decoders.field (Decoders.nonNullable Decoders.text)-                                                    <*> Decoders.field (Decoders.nonNullable Decoders.int4)-                                                )-                                            )-                                        )-                                  )-                              )-                          )-                      )-                  )-          result <- Connection.use connection (Session.statement () statement)-          result `shouldBe` Right ((1, True), ("hello", 3))--      it "decodes deeply nested unnamed composites" \config -> do-        Scripts.onPreparableConnection config \connection -> do-          let statement =-                Statement.preparable-                  "select ((row (99), (true, text 'test')), text 'outer')"-                  mempty-                  ( Decoders.singleRow-                      ( Decoders.column-                          ( Decoders.nonNullable-                              ( Decoders.record-                                  ( (,)-                                      <$> Decoders.field-                                        ( Decoders.nonNullable-                                            ( Decoders.record-                                                ( (,)-                                                    <$> Decoders.field-                                                      ( Decoders.nonNullable-                                                          ( Decoders.record-                                                              (Decoders.field (Decoders.nonNullable Decoders.int4))-                                                          )-                                                      )-                                                    <*> Decoders.field-                                                      ( Decoders.nonNullable-                                                          ( Decoders.record-                                                              ( (,)-                                                                  <$> Decoders.field (Decoders.nonNullable Decoders.bool)-                                                                  <*> Decoders.field (Decoders.nonNullable Decoders.text)-                                                              )-                                                          )-                                                      )-                                                )-                                            )-                                        )-                                      <*> Decoders.field (Decoders.nonNullable Decoders.text)-                                  )-                              )-                          )-                      )-                  )-          result <- Connection.use connection (Session.statement () statement)-          result `shouldBe` Right ((99, (True, "test")), "outer")--    describe "Arrays of composites" do-      it "decodes arrays of unnamed composites from static SQL" \config -> do-        Scripts.onPreparableConnection config \connection -> do-          let statement =-                Statement.preparable-                  "select array[(1, true), (2, false), (3, true)]"-                  mempty-                  ( Decoders.singleRow-                      ( Decoders.column-                          ( Decoders.nonNullable-                              ( Decoders.array-                                  ( Decoders.dimension-                                      replicateM-                                      ( Decoders.element-                                          ( Decoders.nonNullable-                                              ( Decoders.record-                                                  ( (,)-                                                      <$> Decoders.field (Decoders.nonNullable Decoders.int4)-                                                      <*> Decoders.field (Decoders.nonNullable Decoders.bool)-                                                  )-                                              )-                                          )-                                      )-                                  )-                              )-                          )-                      )-                  )-          result <- Connection.use connection (Session.statement () statement)-          result `shouldBe` Right [(1, True), (2, False), (3, True)]--      it "decodes 2D arrays of unnamed composites" \config -> do-        Scripts.onPreparableConnection config \connection -> do-          let statement =-                Statement.preparable-                  "select array[array[(1, text 'a'), (2, text 'b')], array[(3, text 'c'), (4, text 'd')]]"-                  mempty-                  ( Decoders.singleRow-                      ( Decoders.column-                          ( Decoders.nonNullable-                              ( Decoders.array-                                  ( Decoders.dimension-                                      replicateM-                                      ( Decoders.dimension-                                          replicateM-                                          ( Decoders.element-                                              ( Decoders.nonNullable-                                                  ( Decoders.record-                                                      ( (,)-                                                          <$> Decoders.field (Decoders.nonNullable Decoders.int4)-                                                          <*> Decoders.field (Decoders.nonNullable Decoders.text)-                                                      )-                                                  )-                                              )-                                          )-                                      )-                                  )-                              )-                          )-                      )-                  )-          result <- Connection.use connection (Session.statement () statement)-          result `shouldBe` Right [[(1 :: Int32, "a"), (2, "b")], [(3, "c"), (4, "d")]]--      it "decodes arrays of nested unnamed composites" \config -> do-        Scripts.onPreparableConnection config \connection -> do-          let statement =-                Statement.preparable-                  "select array[((1, true), text 'x'), ((2, false), text 'y')]"-                  mempty-                  ( Decoders.singleRow-                      ( Decoders.column-                          ( Decoders.nonNullable-                              ( Decoders.array-                                  ( Decoders.dimension-                                      replicateM-                                      ( Decoders.element-                                          ( Decoders.nonNullable-                                              ( Decoders.record-                                                  ( (,)-                                                      <$> Decoders.field-                                                        ( Decoders.nonNullable-                                                            ( Decoders.record-                                                                ( (,)-                                                                    <$> Decoders.field (Decoders.nonNullable Decoders.int4)-                                                                    <*> Decoders.field (Decoders.nonNullable Decoders.bool)-                                                                )-                                                            )-                                                        )-                                                      <*> Decoders.field (Decoders.nonNullable Decoders.text)-                                                  )-                                              )-                                          )-                                      )-                                  )-                              )-                          )-                      )-                  )-          result <- Connection.use connection (Session.statement () statement)-          result `shouldBe` Right [((1, True), "x"), ((2, False), "y")]
− src/library-tests/Sharing/ByUnit/Decoders/UuidSpec.hs 
@@ -1,36 +0,0 @@-module Sharing.ByUnit.Decoders.UuidSpec (spec) where--import Data.UUID qualified as UUID-import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "UUID Decoders" do-    it "decodes UUID from static value" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select '550e8400-e29b-41d4-a716-446655440000'::uuid"-                Encoders.noParams-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.uuid)))-        result <- Connection.use connection (Session.statement () statement)-        case UUID.fromString "550e8400-e29b-41d4-a716-446655440000" of-          Just expectedUuid -> result `shouldBe` Right expectedUuid-          Nothing -> expectationFailure "Failed to parse expected UUID"--    it "decodes nil UUID" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select '00000000-0000-0000-0000-000000000000'::uuid"-                Encoders.noParams-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.uuid)))-        result <- Connection.use connection (Session.statement () statement)-        result `shouldBe` Right UUID.nil
− src/library-tests/Sharing/ByUnit/Encoders/ArraySpec.hs 
@@ -1,40 +0,0 @@-module Sharing.ByUnit.Encoders.ArraySpec (spec) where--import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Test.QuickCheck-import Test.QuickCheck.Instances ()-import Test.QuickCheck.Monadic (assert, monadicIO, pre, run)-import Prelude hiding (assert)--spec :: SpecWith (Text, Word16)-spec = do-  describe "Array Encoders" do-    describe "1D arrays" do-      it "roundtrips 1D arrays" \config -> property $ \(values :: [Int64]) -> monadicIO $ do-        let statement =-              Statement.preparable-                "select $1"-                (Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8))))))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.array (Decoders.dimension replicateM (Decoders.element (Decoders.nonNullable Decoders.int8)))))))-        result <- run $ Scripts.onPreparableConnection config \connection ->-          Connection.use connection (Session.statement values statement)-        assert $ result == Right values--    describe "2D arrays" do-      it "roundtrips 2D arrays" \config -> property $ \(values :: [Int64]) -> monadicIO $ do-        pre (not (null values))-        let input = replicate 3 values-        let statement =-              Statement.preparable-                "select $1"-                (Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8)))))))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.array (Decoders.dimension replicateM (Decoders.dimension replicateM (Decoders.element (Decoders.nonNullable Decoders.int8))))))))-        result <- run $ Scripts.onPreparableConnection config \connection ->-          Connection.use connection (Session.statement input statement)-        assert $ result == Right input
− src/library-tests/Sharing/ByUnit/Encoders/CitextSpec.hs 
@@ -1,67 +0,0 @@-module Sharing.ByUnit.Encoders.CitextSpec (spec) where--import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Citext Encoders" do-    it "encodes a citext value and compares with static value" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          catchError-            ( Session.statement ()-                $ Statement.unpreparable-                  "CREATE EXTENSION IF NOT EXISTS citext"-                  Encoders.noParams-                  Decoders.noResult-            )-            (const (pure ()))-          Session.statement "hello"-            $ Statement.preparable-              "select $1 = 'hello'"-              (Encoders.param (Encoders.nonNullable Encoders.citext))-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        result `shouldBe` Right True--    it "encodes a citext value with case-insensitive comparison" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          catchError-            ( Session.statement ()-                $ Statement.unpreparable-                  "CREATE EXTENSION IF NOT EXISTS citext"-                  Encoders.noParams-                  Decoders.noResult-            )-            (const (pure ()))-          Session.statement "Hello"-            $ Statement.preparable-              "select $1 = 'hello'"-              (Encoders.param (Encoders.nonNullable Encoders.citext))-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        result `shouldBe` Right True--    it "roundtrips a citext value" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          catchError-            ( Session.statement ()-                $ Statement.unpreparable-                  "CREATE EXTENSION IF NOT EXISTS citext"-                  Encoders.noParams-                  Decoders.noResult-            )-            (const (pure ()))-          Session.statement "Hello World"-            $ Statement.preparable-              "select $1"-              (Encoders.param (Encoders.nonNullable Encoders.citext))-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.citext)))-        result `shouldBe` Right "Hello World"
− src/library-tests/Sharing/ByUnit/Encoders/Composite/OidMismatchSpec.hs 
@@ -1,193 +0,0 @@-module Sharing.ByUnit.Encoders.Composite.OidMismatchSpec (spec) where--import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Errors qualified as Errors-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Composite field OID mismatch detection" do-    describe "Encoder field type mismatch" do-      it "detects when encoder uses int4 but actual field is int8" \config -> do-        typeName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create composite type with int8 field-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", typeName, " as (x int8)"])-                mempty-                Decoders.noResult-            -- Try to encode with int4 encoder to int8 field-            Session.statement (42 :: Int32)-              $ Statement.preparable-                (mconcat ["select $1 :: ", typeName])-                ( Encoders.param-                    ( Encoders.nonNullable-                        ( Encoders.composite-                            Nothing-                            typeName-                            -- Using int4 encoder for int8 field - should fail-                            (Encoders.field (Encoders.nonNullable Encoders.int4))-                        )-                    )-                )-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            (Decoders.composite Nothing typeName (Decoders.field (Decoders.nonNullable Decoders.int8)))-                        )-                    )-                )-          -- The error should indicate a type mismatch from the server-          case result of-            Left (Errors.StatementSessionError _ _ _ _ _ (Errors.ServerStatementError (Errors.ServerError code _msg _detail _hint _pos))) -> do-              -- PostgreSQL should reject the mismatched types-              -- Error code 42804 is "datatype_mismatch"-              code `shouldSatisfy` (\c -> c == "42804" || c == "42P01" || c == "22P02")-            Left err ->-              expectationFailure ("Unexpected type of error: " <> show err)-            Right _ ->-              expectationFailure "Expected an error but got success"--      it "detects when encoder uses int8 but actual field is int4" \config -> do-        typeName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create composite type with int4 field-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", typeName, " as (x int4)"])-                mempty-                Decoders.noResult-            -- Try to encode with int8 encoder to int4 field-            Session.statement (42 :: Int64)-              $ Statement.preparable-                (mconcat ["select $1 :: ", typeName])-                ( Encoders.param-                    ( Encoders.nonNullable-                        ( Encoders.composite-                            Nothing-                            typeName-                            -- Using int8 encoder for int4 field - should fail-                            (Encoders.field (Encoders.nonNullable Encoders.int8))-                        )-                    )-                )-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            (Decoders.composite Nothing typeName (Decoders.field (Decoders.nonNullable Decoders.int4)))-                        )-                    )-                )-          -- The error should indicate a type mismatch from the server-          case result of-            Left (Errors.StatementSessionError _ _ _ _ _ (Errors.ServerStatementError (Errors.ServerError code _msg _detail _hint _pos))) -> do-              -- PostgreSQL should reject the mismatched types-              -- Error code 42804 is "datatype_mismatch"-              code `shouldSatisfy` (\c -> c == "42804" || c == "42P01" || c == "22P02")-            Left err ->-              expectationFailure ("Unexpected type of error: " <> show err)-            Right _ ->-              expectationFailure "Expected an error but got success"--      it "detects when encoder uses text but actual field is int8" \config -> do-        typeName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create composite type with int8 field-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", typeName, " as (x int8)"])-                mempty-                Decoders.noResult-            -- Try to encode with text encoder to int8 field-            Session.statement ("hello" :: Text)-              $ Statement.preparable-                (mconcat ["select $1 :: ", typeName])-                ( Encoders.param-                    ( Encoders.nonNullable-                        ( Encoders.composite-                            Nothing-                            typeName-                            -- Using text encoder for int8 field - should fail-                            (Encoders.field (Encoders.nonNullable Encoders.text))-                        )-                    )-                )-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            (Decoders.composite Nothing typeName (Decoders.field (Decoders.nonNullable Decoders.int8)))-                        )-                    )-                )-          -- The error should indicate a type mismatch from the server-          case result of-            Left (Errors.StatementSessionError _ _ _ _ _ (Errors.ServerStatementError (Errors.ServerError code _msg _detail _hint _pos))) -> do-              -- PostgreSQL should reject the mismatched types-              code `shouldSatisfy` (\c -> c == "42804" || c == "42P01" || c == "22P02")-            Left err ->-              expectationFailure ("Unexpected type of error: " <> show err)-            Right _ ->-              expectationFailure "Expected an error but got success"--    describe "Multiple fields with mismatches" do-      it "detects mismatch in second field" \config -> do-        typeName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create composite type with int8, int4 fields-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create type ", typeName, " as (a int8, b int4)"])-                mempty-                Decoders.noResult-            -- Try to encode with correct first field but wrong second field-            Session.statement (1 :: Int64, 2 :: Int64)-              $ Statement.preparable-                (mconcat ["select $1 :: ", typeName])-                ( Encoders.param-                    ( Encoders.nonNullable-                        ( Encoders.composite-                            Nothing-                            typeName-                            ( divide-                                (\(a, b) -> (a, b))-                                (Encoders.field (Encoders.nonNullable Encoders.int8))-                                -- Using int8 encoder for int4 field - should fail-                                (Encoders.field (Encoders.nonNullable Encoders.int8))-                            )-                        )-                    )-                )-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            ( Decoders.composite-                                Nothing-                                typeName-                                ( (,)-                                    <$> Decoders.field (Decoders.nonNullable Decoders.int8)-                                    <*> Decoders.field (Decoders.nonNullable Decoders.int4)-                                )-                            )-                        )-                    )-                )-          -- The error should indicate a type mismatch from the server-          case result of-            Left (Errors.StatementSessionError _ _ _ _ _ (Errors.ServerStatementError (Errors.ServerError code _msg _detail _hint _pos))) -> do-              -- PostgreSQL should reject the mismatched types-              code `shouldSatisfy` (\c -> c == "42804" || c == "42P01" || c == "22P02")-            Left err ->-              expectationFailure ("Unexpected type of error: " <> show err)-            Right _ ->-              expectationFailure "Expected an error but got success"
− src/library-tests/Sharing/ByUnit/Encoders/CompositeSpec.hs 
@@ -1,807 +0,0 @@-module Sharing.ByUnit.Encoders.CompositeSpec (spec) where--import Data.HashSet qualified as HashSet-import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Errors qualified as Errors-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Simple composites" do-    it "encodes a simple named composite and compares with static value" \config -> do-      typeName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create composite type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", typeName, " as (x int8, y bool)"])-              mempty-              Decoders.noResult-          -- Test encoding by comparing with static value-          Session.statement (42 :: Int64, True)-            $ Statement.preparable-              (mconcat ["select ($1 :: ", typeName, ") = (42, true) :: ", typeName])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.composite-                          Nothing-                          typeName-                          ( divide-                              (\(a, b) -> (a, b))-                              (Encoders.field (Encoders.nonNullable Encoders.int8))-                              (Encoders.field (Encoders.nonNullable Encoders.bool))-                          )-                      )-                  )-              )-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        result `shouldBe` Right True--    it "encodes and roundtrips a simple named composite" \config -> do-      typeName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create composite type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", typeName, " as (x int8, y bool)"])-              mempty-              Decoders.noResult-          -- Test roundtrip-          Session.statement (42 :: Int64, True)-            $ Statement.preparable-              (mconcat ["select $1 :: ", typeName])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.composite-                          Nothing-                          typeName-                          ( divide-                              (\(a, b) -> (a, b))-                              (Encoders.field (Encoders.nonNullable Encoders.int8))-                              (Encoders.field (Encoders.nonNullable Encoders.bool))-                          )-                      )-                  )-              )-              ( Decoders.singleRow-                  ( Decoders.column-                      ( Decoders.nonNullable-                          ( Decoders.composite-                              Nothing-                              typeName-                              ( (,)-                                  <$> Decoders.field (Decoders.nonNullable Decoders.int8)-                                  <*> Decoders.field (Decoders.nonNullable Decoders.bool)-                              )-                          )-                      )-                  )-              )-        result `shouldBe` Right (42 :: Int64, True)--  describe "Nested composites" do-    it "encodes nested named composites" \config -> do-      innerType <- Scripts.generateSymname-      outerType <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create inner composite type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", innerType, " as (x int8, y bool)"])-              mempty-              Decoders.noResult-          -- Create outer composite type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", outerType, " as (\"inner\" ", innerType, ", z text)"])-              mempty-              Decoders.noResult-          -- Test nested encoding-          Session.statement ((42 :: Int64, True), "hello")-            $ Statement.preparable-              (mconcat ["select ($1 :: ", outerType, ") = ((42, true), 'hello') :: ", outerType])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.composite-                          Nothing-                          outerType-                          ( divide-                              (\(inner, z) -> (inner, z))-                              ( Encoders.field-                                  ( Encoders.nonNullable-                                      ( Encoders.composite-                                          Nothing-                                          innerType-                                          ( divide-                                              (\(a, b) -> (a, b))-                                              (Encoders.field (Encoders.nonNullable Encoders.int8))-                                              (Encoders.field (Encoders.nonNullable Encoders.bool))-                                          )-                                      )-                                  )-                              )-                              (Encoders.field (Encoders.nonNullable Encoders.text))-                          )-                      )-                  )-              )-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        result `shouldBe` Right True--    it "roundtrips nested named composites" \config -> do-      innerType <- Scripts.generateSymname-      outerType <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create inner composite type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", innerType, " as (x int8, y bool)"])-              mempty-              Decoders.noResult-          -- Create outer composite type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", outerType, " as (\"inner\" ", innerType, ", z text)"])-              mempty-              Decoders.noResult-          -- Test roundtrip-          Session.statement ((42 :: Int64, True), "hello")-            $ Statement.preparable-              (mconcat ["select $1 :: ", outerType])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.composite-                          Nothing-                          outerType-                          ( divide-                              (\(inner, z) -> (inner, z))-                              ( Encoders.field-                                  ( Encoders.nonNullable-                                      ( Encoders.composite-                                          Nothing-                                          innerType-                                          ( divide-                                              (\(a, b) -> (a, b))-                                              (Encoders.field (Encoders.nonNullable Encoders.int8))-                                              (Encoders.field (Encoders.nonNullable Encoders.bool))-                                          )-                                      )-                                  )-                              )-                              (Encoders.field (Encoders.nonNullable Encoders.text))-                          )-                      )-                  )-              )-              ( Decoders.singleRow-                  ( Decoders.column-                      ( Decoders.nonNullable-                          ( Decoders.composite-                              Nothing-                              outerType-                              ( (,)-                                  <$> Decoders.field-                                    ( Decoders.nonNullable-                                        ( Decoders.composite-                                            Nothing-                                            innerType-                                            ( (,)-                                                <$> Decoders.field (Decoders.nonNullable Decoders.int8)-                                                <*> Decoders.field (Decoders.nonNullable Decoders.bool)-                                            )-                                        )-                                    )-                                  <*> Decoders.field (Decoders.nonNullable Decoders.text)-                              )-                          )-                      )-                  )-              )-        result `shouldBe` Right ((42 :: Int64, True), "hello")--  describe "Arrays of composites" do-    it "encodes arrays of named composites" \config -> do-      typeName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create composite type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", typeName, " as (x int8, y bool)"])-              mempty-              Decoders.noResult-          -- Test array encoding-          Session.statement [(1 :: Int64, True), (2, False), (3, True)]-            $ Statement.preparable-              (mconcat ["select $1 = array[(1, true), (2, false), (3, true)] :: ", typeName, "[]"])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.array-                          ( Encoders.dimension-                              foldl'-                              ( Encoders.element-                                  ( Encoders.nonNullable-                                      ( Encoders.composite-                                          Nothing-                                          typeName-                                          ( divide-                                              (\(a, b) -> (a, b))-                                              (Encoders.field (Encoders.nonNullable Encoders.int8))-                                              (Encoders.field (Encoders.nonNullable Encoders.bool))-                                          )-                                      )-                                  )-                              )-                          )-                      )-                  )-              )-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        result `shouldBe` Right True--    it "roundtrips arrays of named composites" \config -> do-      typeName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create composite type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", typeName, " as (x int8, y bool)"])-              mempty-              Decoders.noResult-          -- Test roundtrip-          Session.statement [(1 :: Int64, True), (2, False), (3, True)]-            $ Statement.preparable-              (mconcat ["select $1 :: ", typeName, "[]"])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.array-                          ( Encoders.dimension-                              foldl'-                              ( Encoders.element-                                  ( Encoders.nonNullable-                                      ( Encoders.composite-                                          Nothing-                                          typeName-                                          ( divide-                                              (\(a, b) -> (a, b))-                                              (Encoders.field (Encoders.nonNullable Encoders.int8))-                                              (Encoders.field (Encoders.nonNullable Encoders.bool))-                                          )-                                      )-                                  )-                              )-                          )-                      )-                  )-              )-              ( Decoders.singleRow-                  ( Decoders.column-                      ( Decoders.nonNullable-                          ( Decoders.array-                              ( Decoders.dimension-                                  replicateM-                                  ( Decoders.element-                                      ( Decoders.nonNullable-                                          ( Decoders.composite-                                              Nothing-                                              typeName-                                              ( (,)-                                                  <$> Decoders.field (Decoders.nonNullable Decoders.int8)-                                                  <*> Decoders.field (Decoders.nonNullable Decoders.bool)-                                              )-                                          )-                                      )-                                  )-                              )-                          )-                      )-                  )-              )-        result `shouldBe` Right [(1 :: Int64, True), (2, False), (3, True)]--  describe "OID lookup verification" do-    it "requests OID for named composites (verified by successful execution)" \config -> do-      -- This test verifies that OID lookup happens by ensuring a named composite-      -- type works correctly - if OID lookup didn't happen, the statement would fail-      typeName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create composite type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", typeName, " as (value int8)"])-              mempty-              Decoders.noResult-          -- Use named composite - this requires OID lookup to succeed-          Session.statement (100 :: Int64)-            $ Statement.preparable-              (mconcat ["select $1 :: ", typeName])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.composite-                          Nothing-                          typeName-                          (Encoders.field (Encoders.nonNullable Encoders.int8))-                      )-                  )-              )-              ( Decoders.singleRow-                  ( Decoders.column-                      ( Decoders.nonNullable-                          (Decoders.composite Nothing typeName (Decoders.field (Decoders.nonNullable Decoders.int8)))-                      )-                  )-              )-        result `shouldBe` Right (100 :: Int64)--    it "correctly tracks unknown types for nested composites with built-in field types" \config -> do-      -- This test reproduces the bug where unknownTypes were incorrectly tracked.-      -- The bug: when a field had a known elementOid (like int8), it was incorrectly-      -- added to unknownTypes. When elementOid was Nothing (custom types), it wasn't added.-      -- This caused nested composites with built-in types to fail OID lookup.-      ---      -- Specifically: When using a named composite as a field in another composite,-      -- the inner composite type needs OID lookup (it's custom), but its int8 field doesn't.-      -- The bug would cause int8 to be requested for OID lookup (wasteful but harmless)-      -- and fail to request OID lookup for the inner composite type (causing failure).-      innerType <- Scripts.generateSymname-      outerType <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create inner composite with a built-in type field-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", innerType, " as (value int8)"])-              mempty-              Decoders.noResult-          -- Create outer composite containing the inner composite-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", outerType, " as (\"inner\" ", innerType, ")"])-              mempty-              Decoders.noResult-          -- With the bug: innerType wouldn't be in the OID cache because-          -- field (with Nothing elementOid) didn't add it to unknownTypes.-          -- Instead, int8 (with Just elementOid) was being added (incorrectly).-          -- This would cause the encoder to use OID 0 for innerType, causing an error.-          Session.statement (42 :: Int64)-            $ Statement.preparable-              (mconcat ["select ($1 :: ", outerType, ").inner.value"])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.composite-                          Nothing-                          outerType-                          ( Encoders.field-                              ( Encoders.nonNullable-                                  ( Encoders.composite-                                      Nothing-                                      innerType-                                      (Encoders.field (Encoders.nonNullable Encoders.int8))-                                  )-                              )-                          )-                      )-                  )-              )-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))-        result `shouldBe` Right (42 :: Int64)--  describe "OID compatibility checking" do-    it "validates that encoder uses correct composite type OID" \config -> do-      -- This test ensures that when encoding a composite type, the correct OID is used.-      -- If the OID lookup fails or returns wrong OID, the statement should fail.-      typeName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create composite type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", typeName, " as (x int8, y bool)"])-              mempty-              Decoders.noResult-          -- Encode and verify - the DB will validate the OID is correct-          Session.statement (42 :: Int64, True)-            $ Statement.preparable-              (mconcat ["select ($1 :: ", typeName, ") = row (42, true) :: ", typeName])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.composite-                          Nothing-                          typeName-                          ( divide-                              (\(a, b) -> (a, b))-                              (Encoders.field (Encoders.nonNullable Encoders.int8))-                              (Encoders.field (Encoders.nonNullable Encoders.bool))-                          )-                      )-                  )-              )-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        result `shouldBe` Right True--    it "validates OID lookup for nested composite types during encoding" \config -> do-      -- This test ensures OID lookup works correctly for nested composites-      innerType <- Scripts.generateSymname-      outerType <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create inner composite type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", innerType, " as (value int8)"])-              mempty-              Decoders.noResult-          -- Create outer composite type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", outerType, " as (\"nested\" ", innerType, ", flag bool)"])-              mempty-              Decoders.noResult-          -- Encode nested composite - both type OIDs must be looked up correctly-          Session.statement (99 :: Int64, True)-            $ Statement.preparable-              (mconcat ["select ($1 :: ", outerType, ") = row (row (99), true) :: ", outerType])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.composite-                          Nothing-                          outerType-                          ( divide-                              (\(val, flag) -> (val, flag))-                              ( Encoders.field-                                  ( Encoders.nonNullable-                                      ( Encoders.composite-                                          Nothing-                                          innerType-                                          (Encoders.field (Encoders.nonNullable Encoders.int8))-                                      )-                                  )-                              )-                              (Encoders.field (Encoders.nonNullable Encoders.bool))-                          )-                      )-                  )-              )-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        result `shouldBe` Right True--  describe "Composite with array fields" do-    it "encodes composite types containing array fields" \config -> do-      typeName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create composite type with an array field-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", typeName, " as (id int8, values int8[])"])-              mempty-              Decoders.noResult-          -- Test encoding composite with array field-          Session.statement (42 :: Int64, [1, 2, 3] :: [Int64])-            $ Statement.preparable-              (mconcat ["select ($1 :: ", typeName, ") = (42, '{1, 2, 3}') :: ", typeName])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.composite-                          Nothing-                          typeName-                          ( divide-                              (\(i, vs) -> (i, vs))-                              (Encoders.field (Encoders.nonNullable Encoders.int8))-                              ( Encoders.field-                                  ( Encoders.nonNullable-                                      (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8))))-                                  )-                              )-                          )-                      )-                  )-              )-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        result `shouldBe` Right True--    it "roundtrips composite types containing array fields" \config -> do-      typeName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create composite type with an array field-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", typeName, " as (id int8, values int8[])"])-              mempty-              Decoders.noResult-          -- Test roundtrip-          Session.statement (42 :: Int64, [1, 2, 3] :: [Int64])-            $ Statement.preparable-              (mconcat ["select $1 :: ", typeName])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.composite-                          Nothing-                          typeName-                          ( divide-                              (\(i, vs) -> (i, vs))-                              (Encoders.field (Encoders.nonNullable Encoders.int8))-                              ( Encoders.field-                                  ( Encoders.nonNullable-                                      (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8))))-                                  )-                              )-                          )-                      )-                  )-              )-              ( Decoders.singleRow-                  ( Decoders.column-                      ( Decoders.nonNullable-                          ( Decoders.composite-                              Nothing-                              typeName-                              ( (,)-                                  <$> Decoders.field (Decoders.nonNullable Decoders.int8)-                                  <*> Decoders.field-                                    ( Decoders.nonNullable-                                        (Decoders.array (Decoders.dimension replicateM (Decoders.element (Decoders.nonNullable Decoders.int8))))-                                    )-                              )-                          )-                      )-                  )-              )-        result `shouldBe` Right (42 :: Int64, [1, 2, 3] :: [Int64])--    it "encodes composite types containing arrays of named composite types" \config -> do-      innerType <- Scripts.generateSymname-      outerType <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create inner composite type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", innerType, " as (x int8, y bool)"])-              mempty-              Decoders.noResult-          -- Create outer composite type with array of inner composite-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", outerType, " as (id int8, items ", innerType, "[])"])-              mempty-              Decoders.noResult-          -- Test encoding composite with array of composite field by checking a field value-          Session.statement (99 :: Int64, [(1 :: Int64, True), (2, False), (3, True)])-            $ Statement.preparable-              (mconcat ["select ($1 :: ", outerType, ").id"])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.composite-                          Nothing-                          outerType-                          ( divide-                              (\(i, items) -> (i, items))-                              (Encoders.field (Encoders.nonNullable Encoders.int8))-                              ( Encoders.field-                                  ( Encoders.nonNullable-                                      ( Encoders.array-                                          ( Encoders.dimension-                                              foldl'-                                              ( Encoders.element-                                                  ( Encoders.nonNullable-                                                      ( Encoders.composite-                                                          Nothing-                                                          innerType-                                                          ( divide-                                                              (\(x, y) -> (x, y))-                                                              (Encoders.field (Encoders.nonNullable Encoders.int8))-                                                              (Encoders.field (Encoders.nonNullable Encoders.bool))-                                                          )-                                                      )-                                                  )-                                              )-                                          )-                                      )-                                  )-                              )-                          )-                      )-                  )-              )-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))-        result `shouldBe` Right (99 :: Int64)--    it "roundtrips composite types containing arrays of named composite types" \config -> do-      innerType <- Scripts.generateSymname-      outerType <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create inner composite type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", innerType, " as (x int8, y bool)"])-              mempty-              Decoders.noResult-          -- Create outer composite type with array of inner composite-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", outerType, " as (id int8, items ", innerType, "[])"])-              mempty-              Decoders.noResult-          -- Test roundtrip-          Session.statement (99 :: Int64, [(1 :: Int64, True), (2, False), (3, True)])-            $ Statement.preparable-              (mconcat ["select $1 :: ", outerType])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.composite-                          Nothing-                          outerType-                          ( divide-                              (\(i, items) -> (i, items))-                              (Encoders.field (Encoders.nonNullable Encoders.int8))-                              ( Encoders.field-                                  ( Encoders.nonNullable-                                      ( Encoders.array-                                          ( Encoders.dimension-                                              foldl'-                                              ( Encoders.element-                                                  ( Encoders.nonNullable-                                                      ( Encoders.composite-                                                          Nothing-                                                          innerType-                                                          ( divide-                                                              (\(x, y) -> (x, y))-                                                              (Encoders.field (Encoders.nonNullable Encoders.int8))-                                                              (Encoders.field (Encoders.nonNullable Encoders.bool))-                                                          )-                                                      )-                                                  )-                                              )-                                          )-                                      )-                                  )-                              )-                          )-                      )-                  )-              )-              ( Decoders.singleRow-                  ( Decoders.column-                      ( Decoders.nonNullable-                          ( Decoders.composite-                              Nothing-                              outerType-                              ( (,)-                                  <$> Decoders.field (Decoders.nonNullable Decoders.int8)-                                  <*> Decoders.field-                                    ( Decoders.nonNullable-                                        ( Decoders.array-                                            ( Decoders.dimension-                                                replicateM-                                                ( Decoders.element-                                                    ( Decoders.nonNullable-                                                        ( Decoders.composite-                                                            Nothing-                                                            innerType-                                                            ( (,)-                                                                <$> Decoders.field (Decoders.nonNullable Decoders.int8)-                                                                <*> Decoders.field (Decoders.nonNullable Decoders.bool)-                                                            )-                                                        )-                                                    )-                                                )-                                            )-                                        )-                                    )-                              )-                          )-                      )-                  )-              )-        result `shouldBe` Right (99 :: Int64, [(1 :: Int64, True), (2, False), (3, True)])--    it "encodes composite types with multiple levels of nesting: composite -> array -> composite" \config -> do-      deepType <- Scripts.generateSymname-      midType <- Scripts.generateSymname-      topType <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create deepest composite type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", deepType, " as (value int8)"])-              mempty-              Decoders.noResult-          -- Create middle composite type with array of deep composite-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", midType, " as (data ", deepType, "[])"])-              mempty-              Decoders.noResult-          -- Create top composite type containing middle composite-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", topType, " as (name text, \"nested\" ", midType, ")"])-              mempty-              Decoders.noResult-          -- Test encoding deeply nested structure by extracting a value-          Session.statement ("test", [1 :: Int64, 2, 3])-            $ Statement.preparable-              (mconcat ["select ($1 :: ", topType, ").name"])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.composite-                          Nothing-                          topType-                          ( divide-                              (\(name, nested) -> (name, nested))-                              (Encoders.field (Encoders.nonNullable Encoders.text))-                              ( Encoders.field-                                  ( Encoders.nonNullable-                                      ( Encoders.composite-                                          Nothing-                                          midType-                                          ( Encoders.field-                                              ( Encoders.nonNullable-                                                  ( Encoders.array-                                                      ( Encoders.dimension-                                                          foldl'-                                                          ( Encoders.element-                                                              ( Encoders.nonNullable-                                                                  ( Encoders.composite-                                                                      Nothing-                                                                      deepType-                                                                      (Encoders.field (Encoders.nonNullable Encoders.int8))-                                                                  )-                                                              )-                                                          )-                                                      )-                                                  )-                                              )-                                          )-                                      )-                                  )-                              )-                          )-                      )-                  )-              )-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)))-        result `shouldBe` Right "test"--  it "detects attempts to encode non-existent composite types" \config -> do-    Scripts.onPreparableConnection config \connection -> do-      result <- Connection.use connection do-        Session.statement (42 :: Int64, "test")-          $ Statement.preparable-            "select $1::nonexistent_composite_type"-            ( Encoders.param-                ( Encoders.nonNullable-                    ( Encoders.composite-                        Nothing-                        "nonexistent_composite_type"-                        ( divide-                            (\(a, b) -> (a, b))-                            (Encoders.field (Encoders.nonNullable Encoders.int8))-                            (Encoders.field (Encoders.nonNullable Encoders.text))-                        )-                    )-                )-            )-            (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)))--      case result of-        Left (Errors.MissingTypesSessionError missingTypes) ->-          missingTypes `shouldBe` HashSet.fromList [(Nothing, "nonexistent_composite_type")]-        _ ->-          expectationFailure ("Unexpected result: " <> show result)
− src/library-tests/Sharing/ByUnit/Encoders/CustomSpec.hs 
@@ -1,341 +0,0 @@-module Sharing.ByUnit.Encoders.CustomSpec (spec) where--import Data.HashSet qualified as HashSet-import Data.Text.Encoding (encodeUtf8)-import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Errors qualified as Errors-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import TextBuilder qualified-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Basic custom encoders" do-    it "encodes a custom type with runtime OID lookup" \config -> do-      enumName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create enum type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", enumName, " as enum ('alpha', 'beta', 'gamma')"])-              mempty-              Decoders.noResult-          -- Test custom encoder with runtime OID lookup-          Session.statement "beta"-            $ Statement.preparable-              (mconcat ["select ($1 :: ", enumName, ") = 'beta' :: ", enumName])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.custom-                          Nothing-                          enumName-                          Nothing-                          []-                          (\_ val -> encodeUtf8 val)-                          id-                      )-                  )-              )-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        result `shouldBe` Right True--    it "encodes a custom type with static OIDs" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Test custom encoder with static OIDs for text (type OID 25, array OID 1009)-          Session.statement "hello"-            $ Statement.preparable-              "select $1::text = 'hello'::text"-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.custom-                          Nothing-                          "text"-                          (Just (25, 1009))-                          []-                          (\_ val -> encodeUtf8 val)-                          id-                      )-                  )-              )-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        result `shouldBe` Right True--    it "encodes with dependent type OID requests" \config -> do-      enumName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create enum type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", enumName, " as enum ('small', 'large')"])-              mempty-              Decoders.noResult-          -- Test custom encoder that requests OID of the enum type itself-          Session.statement "large"-            $ Statement.preparable-              (mconcat ["select ($1 :: ", enumName, ") = 'large' :: ", enumName])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.custom-                          Nothing-                          enumName-                          Nothing-                          [(Nothing, enumName)]-                          ( \lookupOid val -> do-                              let (enumOidScalar, _enumOidArray) = lookupOid (Nothing, enumName)-                              -- Verify we got a valid OID (non-zero)-                              if enumOidScalar > 0-                                then encodeUtf8 val-                                else error "Failed to resolve enum OID"-                          )-                          id-                      )-                  )-              )-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        result `shouldBe` Right True--  describe "Error handling" do-    it "detects missing types in custom encoders" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          Session.statement "test_value"-            $ Statement.preparable-              "select $1"-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.custom-                          Nothing-                          "nonexistent_custom_type"-                          Nothing-                          []-                          (\_ val -> encodeUtf8 val)-                          id-                      )-                  )-              )-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)))--        case result of-          Left (Errors.MissingTypesSessionError missingTypes) ->-            missingTypes `shouldBe` HashSet.fromList [(Nothing, "nonexistent_custom_type")]-          _ ->-            expectationFailure ("Unexpected result: " <> show result)--    it "detects missing dependent types in custom encoders" \config -> do-      customTypeName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create a custom type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", customTypeName, " as (id int4)"])-              mempty-              Decoders.noResult-          -- Try to encode it but request a non-existent dependent type-          Session.statement (42 :: Int32)-            $ Statement.preparable-              (mconcat ["select $1 :: ", customTypeName])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.custom-                          Nothing-                          customTypeName-                          Nothing-                          [(Nothing, "nonexistent_dependency")]-                          (\_ val -> encodeUtf8 (TextBuilder.toText (TextBuilder.decimal val)))-                          (TextBuilder.toText . TextBuilder.decimal)-                      )-                  )-              )-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)))--        case result of-          Left (Errors.MissingTypesSessionError missingTypes) ->-            missingTypes `shouldBe` HashSet.fromList [(Nothing, "nonexistent_dependency")]-          _ ->-            expectationFailure ("Unexpected result: " <> show result)--  describe "Roundtrip tests" do-    it "roundtrips custom encoded and decoded values" \config -> do-      enumName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create enum type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", enumName, " as enum ('one', 'two', 'three')"])-              mempty-              Decoders.noResult-          -- Test roundtrip using custom encoder and decoder-          Session.statement "three"-            $ Statement.preparable-              (mconcat ["select $1 :: ", enumName])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.custom-                          Nothing-                          enumName-                          Nothing-                          []-                          (\_ val -> encodeUtf8 val)-                          id-                      )-                  )-              )-              ( Decoders.singleRow-                  ( Decoders.column-                      ( Decoders.nonNullable-                          ( Decoders.custom-                              Nothing-                              enumName-                              Nothing-                              []-                              (\_ bytes -> Right bytes)-                          )-                      )-                  )-              )-        result `shouldBe` Right "three"--    it "roundtrips multiple values" \config -> do-      enumName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create enum type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", enumName, " as enum ('first', 'second', 'third')"])-              mempty-              Decoders.noResult-          -- Test roundtrip for multiple values-          r1 <--            Session.statement "first"-              $ Statement.preparable-                (mconcat ["select $1 :: ", enumName])-                ( Encoders.param-                    ( Encoders.nonNullable-                        ( Encoders.custom-                            Nothing-                            enumName-                            Nothing-                            []-                            (\_ val -> encodeUtf8 val)-                            id-                        )-                    )-                )-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            ( Decoders.custom-                                Nothing-                                enumName-                                Nothing-                                []-                                (\_ bytes -> Right bytes)-                            )-                        )-                    )-                )-          r2 <--            Session.statement "third"-              $ Statement.preparable-                (mconcat ["select $1 :: ", enumName])-                ( Encoders.param-                    ( Encoders.nonNullable-                        ( Encoders.custom-                            Nothing-                            enumName-                            Nothing-                            []-                            (\_ val -> encodeUtf8 val)-                            id-                        )-                    )-                )-                ( Decoders.singleRow-                    ( Decoders.column-                        ( Decoders.nonNullable-                            ( Decoders.custom-                                Nothing-                                enumName-                                Nothing-                                []-                                (\_ bytes -> Right bytes)-                            )-                        )-                    )-                )-          return (r1, r2)-        result `shouldBe` Right ("first", "third")--  describe "Schema-qualified types" do-    it "encodes custom types from specific schemas" \config -> do-      schemaName <- Scripts.generateSymname-      typeName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create schema-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create schema ", schemaName])-              mempty-              Decoders.noResult-          -- Create enum type in that schema-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", schemaName, ".", typeName, " as enum ('x', 'y', 'z')"])-              mempty-              Decoders.noResult-          -- Test custom encoder with schema qualification-          Session.statement "z"-            $ Statement.preparable-              (mconcat ["select ($1 :: ", schemaName, ".", typeName, ") = 'z' :: ", schemaName, ".", typeName])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.custom-                          (Just schemaName)-                          typeName-                          Nothing-                          []-                          (\_ val -> encodeUtf8 val)-                          id-                      )-                  )-              )-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        result `shouldBe` Right True--    it "detects missing types in non-existent schemas" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          Session.statement "test"-            $ Statement.preparable-              "select $1"-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.custom-                          (Just "nonexistent_schema")-                          "nonexistent_type"-                          Nothing-                          []-                          (\_ val -> encodeUtf8 val)-                          id-                      )-                  )-              )-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)))--        case result of-          Left (Errors.MissingTypesSessionError missingTypes) ->-            missingTypes `shouldBe` HashSet.fromList [(Just "nonexistent_schema", "nonexistent_type")]-          _ ->-            expectationFailure ("Unexpected result: " <> show result)
− src/library-tests/Sharing/ByUnit/Encoders/DomainSpec.hs 
@@ -1,151 +0,0 @@-module Sharing.ByUnit.Encoders.DomainSpec (spec) where--import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Domain type encoding" do-    describe "Simple scalar domains" do-      it "encodes a domain based on int8 using int8 codec" \config -> do-        domainName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create domain type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create domain ", domainName, " as int8"])-                mempty-                Decoders.noResult-            -- Test encoding by comparing with static value-            Session.statement (42 :: Int64)-              $ Statement.preparable-                (mconcat ["select ($1 :: ", domainName, ") = 42"])-                (Encoders.param (Encoders.nonNullable Encoders.int8))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-          result `shouldBe` Right True--      it "encodes a domain based on text using text codec" \config -> do-        domainName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create domain type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create domain ", domainName, " as text"])-                mempty-                Decoders.noResult-            -- Test encoding by comparing with static value-            Session.statement ("hello" :: Text)-              $ Statement.preparable-                (mconcat ["select ($1 :: ", domainName, ") = 'hello'"])-                (Encoders.param (Encoders.nonNullable Encoders.text))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-          result `shouldBe` Right True--      it "encodes a domain based on bool using bool codec" \config -> do-        domainName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create domain type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create domain ", domainName, " as bool"])-                mempty-                Decoders.noResult-            -- Test encoding by comparing with static value-            Session.statement True-              $ Statement.preparable-                (mconcat ["select ($1 :: ", domainName, ") = true"])-                (Encoders.param (Encoders.nonNullable Encoders.bool))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-          result `shouldBe` Right True--    describe "Domains with constraints" do-      it "encodes values that satisfy domain constraints" \config -> do-        domainName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create domain type with constraint-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create domain ", domainName, " as int8 check (value > 0)"])-                mempty-                Decoders.noResult-            -- Test encoding a value that satisfies the constraint-            Session.statement (42 :: Int64)-              $ Statement.preparable-                (mconcat ["select ($1 :: ", domainName, ") = 42"])-                (Encoders.param (Encoders.nonNullable Encoders.int8))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-          result `shouldBe` Right True--    describe "Domain type cast compatibility for composite usage" do-      it "encodes base type value that can be used in composite with domain field via explicit cast" \config -> do-        domainName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create domain type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create domain ", domainName, " as int8"])-                mempty-                Decoders.noResult-            -- Encode int8, cast it to domain, and use in ROW constructor-            Session.statement (42 :: Int64)-              $ Statement.preparable-                (mconcat ["select ($1 :: ", domainName, ") = 42"])-                (Encoders.param (Encoders.nonNullable Encoders.int8))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-          result `shouldBe` Right True--    describe "Domain type cast compatibility for array usage" do-      it "encodes base type array that can be cast to domain array" \config -> do-        domainName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create domain type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create domain ", domainName, " as int8"])-                mempty-                Decoders.noResult-            -- Encode int8 array using base codec and verify it works-            Session.statement ([1, 2, 3] :: [Int64])-              $ Statement.preparable-                "select $1 = ARRAY[1,2,3] :: int8[]"-                ( Encoders.param-                    ( Encoders.nonNullable-                        (Encoders.foldableArray (Encoders.nonNullable Encoders.int8))-                    )-                )-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-          result `shouldBe` Right True--      it "encodes text array that can be used with text domain" \config -> do-        domainName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          result <- Connection.use connection do-            -- Create domain type-            Session.statement ()-              $ Statement.preparable-                (mconcat ["create domain ", domainName, " as text"])-                mempty-                Decoders.noResult-            -- Encode text array using base codec-            Session.statement (["a", "b", "c"] :: [Text])-              $ Statement.preparable-                "select $1 = ARRAY['a','b','c'] :: text[]"-                ( Encoders.param-                    ( Encoders.nonNullable-                        (Encoders.foldableArray (Encoders.nonNullable Encoders.text))-                    )-                )-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-          result `shouldBe` Right True
− src/library-tests/Sharing/ByUnit/Encoders/EnumSpec.hs 
@@ -1,315 +0,0 @@-module Sharing.ByUnit.Encoders.EnumSpec (spec) where--import Data.HashSet qualified as HashSet-import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Errors qualified as Errors-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Simple enums" do-    it "encodes a simple named enum and compares with static value" \config -> do-      enumName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create enum type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", enumName, " as enum ('sad', 'ok', 'happy')"])-              mempty-              Decoders.noResult-          -- Test encoding by comparing with static value-          Session.statement "ok"-            $ Statement.preparable-              (mconcat ["select ($1 :: ", enumName, ") = 'ok' :: ", enumName])-              (Encoders.param (Encoders.nonNullable (Encoders.enum Nothing enumName id)))-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        result `shouldBe` Right True--    it "encodes and roundtrips a simple named enum" \config -> do-      enumName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create enum type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", enumName, " as enum ('sad', 'ok', 'happy')"])-              mempty-              Decoders.noResult-          -- Test roundtrip-          Session.statement "happy"-            $ Statement.preparable-              (mconcat ["select $1 :: ", enumName])-              (Encoders.param (Encoders.nonNullable (Encoders.enum Nothing enumName id)))-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id)))))-        result `shouldBe` Right "happy"--  describe "Enums in composites" do-    it "encodes enums nested in named composites" \config -> do-      enumName <- Scripts.generateSymname-      compositeName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create enum type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", enumName, " as enum ('red', 'green', 'blue')"])-              mempty-              Decoders.noResult-          -- Create composite type with enum-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", compositeName, " as (id int8, color ", enumName, ")"])-              mempty-              Decoders.noResult-          -- Test encoding-          Session.statement (42 :: Int64, "green")-            $ Statement.preparable-              (mconcat ["select ($1 :: ", compositeName, ") = (42, 'green') :: ", compositeName])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.composite-                          Nothing-                          compositeName-                          ( divide-                              (\(a, b) -> (a, b))-                              (Encoders.field (Encoders.nonNullable Encoders.int8))-                              (Encoders.field (Encoders.nonNullable (Encoders.enum Nothing enumName id)))-                          )-                      )-                  )-              )-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        result `shouldBe` Right True--    it "roundtrips enums nested in named composites" \config -> do-      enumName <- Scripts.generateSymname-      compositeName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create enum type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", enumName, " as enum ('red', 'green', 'blue')"])-              mempty-              Decoders.noResult-          -- Create composite type with enum-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", compositeName, " as (id int8, color ", enumName, ")"])-              mempty-              Decoders.noResult-          -- Test roundtrip-          Session.statement (42 :: Int64, "blue")-            $ Statement.preparable-              (mconcat ["select $1 :: ", compositeName])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.composite-                          Nothing-                          compositeName-                          ( divide-                              (\(a, b) -> (a, b))-                              (Encoders.field (Encoders.nonNullable Encoders.int8))-                              (Encoders.field (Encoders.nonNullable (Encoders.enum Nothing enumName id)))-                          )-                      )-                  )-              )-              ( Decoders.singleRow-                  ( Decoders.column-                      ( Decoders.nonNullable-                          ( Decoders.composite-                              Nothing-                              compositeName-                              ( (,)-                                  <$> Decoders.field (Decoders.nonNullable Decoders.int8)-                                  <*> Decoders.field (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id)))-                              )-                          )-                      )-                  )-              )-        result `shouldBe` Right (42 :: Int64, "blue")--  describe "Arrays of enums" do-    it "encodes arrays of named enums" \config -> do-      enumName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create enum type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", enumName, " as enum ('small', 'medium', 'large')"])-              mempty-              Decoders.noResult-          -- Test array encoding-          Session.statement ["small", "large", "medium"]-            $ Statement.preparable-              (mconcat ["select ($1 :: ", enumName, "[]) = array['small', 'large', 'medium'] :: ", enumName, "[]"])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.array-                          ( Encoders.dimension-                              foldl'-                              (Encoders.element (Encoders.nonNullable (Encoders.enum Nothing enumName id)))-                          )-                      )-                  )-              )-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        result `shouldBe` Right True--    it "roundtrips arrays of named enums" \config -> do-      enumName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create enum type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", enumName, " as enum ('alpha', 'beta', 'gamma')"])-              mempty-              Decoders.noResult-          -- Test roundtrip-          Session.statement ["beta", "alpha", "gamma"]-            $ Statement.preparable-              (mconcat ["select $1 :: ", enumName, "[]"])-              ( Encoders.param-                  ( Encoders.nonNullable-                      ( Encoders.array-                          ( Encoders.dimension-                              foldl'-                              (Encoders.element (Encoders.nonNullable (Encoders.enum Nothing enumName id)))-                          )-                      )-                  )-              )-              ( Decoders.singleRow-                  ( Decoders.column-                      ( Decoders.nonNullable-                          ( Decoders.array-                              ( Decoders.dimension-                                  replicateM-                                  (Decoders.element (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id))))-                              )-                          )-                      )-                  )-              )-        result `shouldBe` Right ["beta", "alpha", "gamma"]--  describe "OID lookup verification" do-    it "requests OID for named enums (verified by successful execution)" \config -> do-      -- This test verifies that OID lookup happens by ensuring a named enum-      -- type works correctly - if OID lookup didn't happen, the statement would fail-      enumName <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Create enum type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", enumName, " as enum ('first', 'second')"])-              mempty-              Decoders.noResult-          -- Use named enum - this requires OID lookup to succeed-          Session.statement "second"-            $ Statement.preparable-              (mconcat ["select $1 :: ", enumName])-              (Encoders.param (Encoders.nonNullable (Encoders.enum Nothing enumName id)))-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.enum Nothing enumName (Just . id)))))-        result `shouldBe` Right "second"--  it "handles enum encoding and decoding" \config -> do-    name <- Scripts.generateSymname-    Scripts.onPreparableConnection config \connection -> do-      result <- Connection.use connection do-        -- First create the enum type-        Session.statement ()-          $ Statement.preparable-            (mconcat ["create type ", name, " as enum ('sad', 'ok', 'happy')"])-            mempty-            Decoders.noResult-        -- Then test encoding and decoding-        Session.statement "ok"-          $ Statement.preparable-            (mconcat ["select ($1 :: ", name, ")"])-            (Encoders.param (Encoders.nonNullable (Encoders.enum Nothing name id)))-            (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.enum Nothing name (Just . id)))))-      result `shouldBe` Right "ok"--  it "detects attempts to encode non-existent enum types" \config -> do-    Scripts.onPreparableConnection config \connection -> do-      result <- Connection.use connection do-        Session.statement "test_value"-          $ Statement.preparable-            "select $1"-            (Encoders.param (Encoders.nonNullable (Encoders.enum Nothing "this_enum_does_not_exist_in_db" id)))-            (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)))--      case result of-        Left (Errors.MissingTypesSessionError missingTypes) ->-          missingTypes `shouldBe` HashSet.fromList [(Nothing, "this_enum_does_not_exist_in_db")]-        _ ->-          expectationFailure ("Unexpected result: " <> show result)--  describe "Namespaced" do-    it "detects attempts to use non-existent type in non-existent schema" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          Session.statement "test"-            $ Statement.preparable-              "select $1::nonexistent_schema.nonexistent_type"-              (Encoders.param (Encoders.nonNullable (Encoders.enum (Just "nonexistent_schema") "nonexistent_type" id)))-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)))--        case result of-          Left (Errors.MissingTypesSessionError missingTypes) ->-            missingTypes `shouldBe` HashSet.fromList [(Just "nonexistent_schema", "nonexistent_type")]-          _ ->-            expectationFailure ("Unexpected result: " <> show result)--    it "detects attempts to use non-existent type in existing schema" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          Session.statement "test"-            $ Statement.preparable-              "select $1::public.this_type_does_not_exist"-              (Encoders.param (Encoders.nonNullable (Encoders.enum (Just "public") "this_type_does_not_exist" id)))-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)))--        -- The statement should fail when trying to use a non-existent type in existing schema-        case result of-          Left (Errors.MissingTypesSessionError missingTypes) -> do-            missingTypes `shouldBe` HashSet.fromList [(Just "public", "this_type_does_not_exist")]-          _ ->-            expectationFailure ("Unexpected result: " <> show result)--  it "detects attempts to encode arrays of non-existent enum types" \config -> do-    Scripts.onPreparableConnection config \connection -> do-      result <- Connection.use connection do-        Session.statement ["val1", "val2"]-          $ Statement.preparable-            "select $1::nonexistent_array_enum[]"-            ( Encoders.param-                ( Encoders.nonNullable-                    ( Encoders.array-                        ( Encoders.dimension-                            foldl'-                            (Encoders.element (Encoders.nonNullable (Encoders.enum Nothing "nonexistent_array_enum" id)))-                        )-                    )-                )-            )-            (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)))--      case result of-        Left (Errors.MissingTypesSessionError missingTypes) ->-          missingTypes `shouldBe` HashSet.fromList [(Nothing, "nonexistent_array_enum")]-        _ ->-          expectationFailure ("Unexpected result: " <> show result)
− src/library-tests/Sharing/ByUnit/Encoders/HstoreSpec.hs 
@@ -1,141 +0,0 @@-module Sharing.ByUnit.Encoders.HstoreSpec (spec) where--import Data.HashMap.Strict qualified as HashMap-import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Hstore Encoders" do-    it "encodes empty hstore" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Enable hstore extension (unprepared), ignore if already exists-          catchError-            ( Session.statement ()-                $ Statement.unpreparable-                  "CREATE EXTENSION IF NOT EXISTS hstore"-                  Encoders.noParams-                  Decoders.noResult-            )-            (const (pure ()))-          -- Test encoding empty hstore-          Session.statement-            ([] :: [(Text, Maybe Text)])-            $ Statement.preparable-              "select $1::hstore = ''::hstore"-              (Encoders.param (Encoders.nonNullable Encoders.hstore))-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        result `shouldBe` Right True--    it "encodes hstore with single key-value pair" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Enable hstore extension (unprepared), ignore if already exists-          catchError-            ( Session.statement ()-                $ Statement.unpreparable-                  "CREATE EXTENSION IF NOT EXISTS hstore"-                  Encoders.noParams-                  Decoders.noResult-            )-            (const (pure ()))-          -- Test encoding single key-value pair-          Session.statement-            [("key", Just "value")]-            $ Statement.preparable-              "select $1::hstore = 'key => value'::hstore"-              (Encoders.param (Encoders.nonNullable Encoders.hstore))-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        result `shouldBe` Right True--    it "encodes hstore with multiple key-value pairs" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Enable hstore extension (unprepared), ignore if already exists-          catchError-            ( Session.statement ()-                $ Statement.unpreparable-                  "CREATE EXTENSION IF NOT EXISTS hstore"-                  Encoders.noParams-                  Decoders.noResult-            )-            (const (pure ()))-          -- Test encoding multiple key-value pairs-          Session.statement-            [("a", Just "1"), ("b", Just "2"), ("c", Just "3")]-            $ Statement.preparable-              "select $1::hstore @> 'a => 1'::hstore AND $1::hstore @> 'b => 2'::hstore AND $1::hstore @> 'c => 3'::hstore"-              (Encoders.param (Encoders.nonNullable Encoders.hstore))-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        result `shouldBe` Right True--    it "encodes hstore with null values" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Enable hstore extension (unprepared), ignore if already exists-          catchError-            ( Session.statement ()-                $ Statement.unpreparable-                  "CREATE EXTENSION IF NOT EXISTS hstore"-                  Encoders.noParams-                  Decoders.noResult-            )-            (const (pure ()))-          -- Test encoding hstore with null values-          Session.statement-            [("key1", Just "value1"), ("key2", Nothing), ("key3", Just "value3")]-            $ Statement.preparable-              "select $1::hstore = 'key1 => value1, key2 => NULL, key3 => value3'::hstore"-              (Encoders.param (Encoders.nonNullable Encoders.hstore))-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        result `shouldBe` Right True--    it "roundtrips hstore correctly" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let testData = HashMap.fromList [("key1", Just "value1"), ("key2", Nothing), ("key3", Just "value3")]-        result <- Connection.use connection do-          -- Enable hstore extension (unprepared), ignore if already exists-          catchError-            ( Session.statement ()-                $ Statement.unpreparable-                  "CREATE EXTENSION IF NOT EXISTS hstore"-                  Encoders.noParams-                  Decoders.noResult-            )-            (const (pure ()))-          -- Test roundtrip-          Session.statement-            (HashMap.toList testData)-            $ Statement.preparable-              "select $1"-              (Encoders.param (Encoders.nonNullable Encoders.hstore))-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.hstore (\n f -> replicateM n f >>= pure . HashMap.fromList)))))-        result `shouldBe` Right testData--    it "encodes hstore with special characters" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- Enable hstore extension (unprepared), ignore if already exists-          catchError-            ( Session.statement ()-                $ Statement.unpreparable-                  "CREATE EXTENSION IF NOT EXISTS hstore"-                  Encoders.noParams-                  Decoders.noResult-            )-            (const (pure ()))-          -- Test encoding hstore with special characters-          Session.statement-            [("key with spaces", Just "value with quotes")]-            $ Statement.preparable-              "select $1::hstore = '\"key with spaces\" => \"value with quotes\"'::hstore"-              (Encoders.param (Encoders.nonNullable Encoders.hstore))-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        result `shouldBe` Right True
− src/library-tests/Sharing/ByUnit/Encoders/InetSpec.hs 
@@ -1,74 +0,0 @@-module Sharing.ByUnit.Encoders.InetSpec (spec) where--import Data.IP (IPv4, IPv6)-import Data.IP qualified as IP-import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "INET Encoders" do-    it "encodes IPv4 address correctly" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select $1 = '192.168.1.1/32'::inet"-                (Encoders.param (Encoders.nonNullable Encoders.inet))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-            testAddr = read "192.168.1.1" :: IPv4-            testRange = IP.makeAddrRange testAddr 32-        result <- Connection.use connection (Session.statement (IP.IPv4Range testRange) statement)-        result `shouldBe` Right True--    it "roundtrips IPv4 CIDR" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select $1"-                (Encoders.param (Encoders.nonNullable Encoders.inet))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.inet)))-            testAddr = read "10.0.0.0" :: IPv4-            testRange = IP.makeAddrRange testAddr 8-        result <- Connection.use connection (Session.statement (IP.IPv4Range testRange) statement)-        result `shouldBe` Right (IP.IPv4Range testRange)--    it "roundtrips IPv6 address" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select $1"-                (Encoders.param (Encoders.nonNullable Encoders.inet))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.inet)))-            testAddr = read "2001:db8::1" :: IPv6-            testRange = IP.makeAddrRange testAddr 128-        result <- Connection.use connection (Session.statement (IP.IPv6Range testRange) statement)-        result `shouldBe` Right (IP.IPv6Range testRange)--  describe "MACADDR Encoders" do-    it "encodes MAC address correctly" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select $1 = '08:00:2b:01:02:03'::macaddr"-                (Encoders.param (Encoders.nonNullable Encoders.macaddr))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-            testMac = (0x08, 0x00, 0x2b, 0x01, 0x02, 0x03)-        result <- Connection.use connection (Session.statement testMac statement)-        result `shouldBe` Right True--    it "roundtrips MAC address" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select $1"-                (Encoders.param (Encoders.nonNullable Encoders.macaddr))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.macaddr)))-            testMac = (0xaa, 0xbb, 0xcc, 0xdd, 0xee, 0xff)-        result <- Connection.use connection (Session.statement testMac statement)-        result `shouldBe` Right testMac
− src/library-tests/Sharing/ByUnit/Encoders/IntervalSpec.hs 
@@ -1,33 +0,0 @@-module Sharing.ByUnit.Encoders.IntervalSpec (spec) where--import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Interval Encoders" do-    it "encodes intervals correctly" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select $1 = interval '10 seconds'"-                (Encoders.param (Encoders.nonNullable Encoders.interval))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        result <- Connection.use connection (Session.statement (10 :: DiffTime) statement)-        result `shouldBe` Right True--    it "roundtrips intervals correctly" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select $1"-                (Encoders.param (Encoders.nonNullable Encoders.interval))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.interval)))-        result <- Connection.use connection (Session.statement (10 :: DiffTime) statement)-        result `shouldBe` Right (10 :: DiffTime)
− src/library-tests/Sharing/ByUnit/Encoders/JsonSpec.hs 
@@ -1,63 +0,0 @@-module Sharing.ByUnit.Encoders.JsonSpec (spec) where--import Data.Aeson qualified as Aeson-import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "JSON Encoders" do-    it "encodes JSON object correctly" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select $1::json"-                (Encoders.param (Encoders.nonNullable Encoders.json))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.json)))-            testValue = Aeson.object [("key", Aeson.String "value")]-        result <- Connection.use connection (Session.statement testValue statement)-        result `shouldBe` Right testValue--    it "roundtrips JSON array" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select $1"-                (Encoders.param (Encoders.nonNullable Encoders.json))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.json)))-            testValue = Aeson.Array (fromList [Aeson.Number 1, Aeson.Number 2])-        result <- Connection.use connection (Session.statement testValue statement)-        result `shouldBe` Right testValue--  describe "JSONB Encoders" do-    it "encodes JSONB object correctly" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select $1::jsonb"-                (Encoders.param (Encoders.nonNullable Encoders.jsonb))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.jsonb)))-            testValue = Aeson.object [("name", Aeson.String "test"), ("value", Aeson.Number 123)]-        result <- Connection.use connection (Session.statement testValue statement)-        result `shouldBe` Right testValue--    it "roundtrips JSONB with nested structure" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select $1"-                (Encoders.param (Encoders.nonNullable Encoders.jsonb))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.jsonb)))-            testValue =-              Aeson.object-                [ ("array", Aeson.Array (fromList [Aeson.Number 1, Aeson.Number 2])),-                  ("nested", Aeson.object [("inner", Aeson.String "value")])-                ]-        result <- Connection.use connection (Session.statement testValue statement)-        result `shouldBe` Right testValue
− src/library-tests/Sharing/ByUnit/Encoders/UnknownSpec.hs 
@@ -1,33 +0,0 @@-{-# OPTIONS_GHC -Wno-deprecations #-}--module Sharing.ByUnit.Encoders.UnknownSpec (spec) where--import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Unknown Type Encoders" do-    it "handles unknown type encoding" \config -> do-      name <- Scripts.generateSymname-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection do-          -- First create the enum type-          Session.statement ()-            $ Statement.preparable-              (mconcat ["create type ", name, " as enum ('sad', 'ok', 'happy')"])-              mempty-              Decoders.noResult-          -- Then test encoding-          Session.statement "ok"-            $ Statement.preparable-              (mconcat ["select $1 = ('ok' :: ", name, ")"])-              (Encoders.param (Encoders.nonNullable Encoders.unknown))-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        result `shouldBe` Right True
− src/library-tests/Sharing/ByUnit/Encoders/UuidSpec.hs 
@@ -1,50 +0,0 @@-module Sharing.ByUnit.Encoders.UuidSpec (spec) where--import Data.UUID qualified as UUID-import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "UUID Encoders" do-    it "encodes UUID correctly" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select $1 = '550e8400-e29b-41d4-a716-446655440000'::uuid"-                (Encoders.param (Encoders.nonNullable Encoders.uuid))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))-        case UUID.fromString "550e8400-e29b-41d4-a716-446655440000" of-          Just testUuid -> do-            result <- Connection.use connection (Session.statement testUuid statement)-            result `shouldBe` Right True-          Nothing -> expectationFailure "Failed to parse test UUID"--    it "roundtrips UUID correctly" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select $1"-                (Encoders.param (Encoders.nonNullable Encoders.uuid))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.uuid)))-        case UUID.fromString "a0eebc99-9c0b-4ef8-bb6d-6bb9bd380a11" of-          Just testUuid -> do-            result <- Connection.use connection (Session.statement testUuid statement)-            result `shouldBe` Right testUuid-          Nothing -> expectationFailure "Failed to parse test UUID"--    it "encodes nil UUID correctly" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select $1"-                (Encoders.param (Encoders.nonNullable Encoders.uuid))-                (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.uuid)))-        result <- Connection.use connection (Session.statement UUID.nil statement)-        result `shouldBe` Right UUID.nil
− src/library-tests/Sharing/ByUnit/PipelineSpec.hs 
@@ -1,176 +0,0 @@-module Sharing.ByUnit.PipelineSpec (spec) where--import Data.Either-import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Errors qualified as Errors-import Hasql.Pipeline qualified as Pipeline-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Dsls.Execution qualified as Execution-import Helpers.Scripts qualified as Scripts-import Helpers.Statements qualified as Statements-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Single-statement" do-    describe "Unprepared" do-      it "Collects results and sends params" \config -> do-        Scripts.onUnpreparableConnection config \connection -> do-          result <--            (Connection.use connection . Session.pipeline)-              $ Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}-          shouldBe result (Right [0 .. 2])--    describe "Prepared" do-      it "Collects results and sends params" \config -> do-        Scripts.onPreparableConnection config \connection -> do-          result <--            (Connection.use connection . Session.pipeline)-              $ Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}-          shouldBe result (Right [0 .. 2])--  describe "Multi-statement" do-    describe "On unprepared statements" do-      it "Collects results and sends params" \config -> do-        Scripts.onUnpreparableConnection config \connection -> do-          result <--            (Connection.use connection . Session.pipeline)-              $ replicateM 2-              $ Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}-          shouldBe result (Right [[0 .. 2], [0 .. 2]])--    describe "On prepared statements" do-      it "Collects results and sends params" \config -> do-        Scripts.onPreparableConnection config \connection -> do-          result <--            (Connection.use connection . Session.pipeline)-              $ replicateM 2-              $ Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}-          shouldBe result (Right [[0 .. 2], [0 .. 2]])--    describe "When a part in the middle fails" do-      describe "With query error" do-        it "Captures the error" \config -> do-          Scripts.onPreparableConnection config \connection -> do-            result <--              (Connection.use connection . Session.pipeline)-                $ (,,)-                <$> Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}-                <*> Execution.pipelineByParams Statements.BrokenSyntax {start = 0, end = 2}-                <*> Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}-            case result of-              Left (Errors.StatementSessionError _ _ _ _ _ (Errors.ServerStatementError _)) -> pure ()-              _ -> expectationFailure $ "Unexpected result: " <> show result--        it "Leaves the connection usable" \config -> do-          Scripts.onPreparableConnection config \connection -> do-            result <--              Connection.use connection do-                _ <--                  catchError-                    ( Just-                        <$> Session.pipeline-                          ( (,,)-                              <$> Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}-                              <*> Execution.pipelineByParams Statements.BrokenSyntax {start = 0, end = 2}-                              <*> Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}-                          )-                    )-                    (const (pure Nothing))-                Execution.sessionByParams Statements.GenerateSeries {start = 0, end = 0}-            shouldBe result (Right [0])--      describe "With decoding error" do-        it "Captures the error" \config -> do-          Scripts.onPreparableConnection config \connection -> do-            result <--              (Connection.use connection . Session.pipeline)-                $ (,,)-                <$> Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}-                <*> Execution.pipelineByParams Statements.WrongDecoder {start = 0, end = 2}-                <*> Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}-            case result of-              Left (Errors.StatementSessionError _ _ _ _ _ (Errors.UnexpectedColumnTypeStatementError {})) -> pure ()-              _ -> expectationFailure $ "Unexpected result: " <> show result--        it "Leaves the connection usable" \config -> do-          Scripts.onPreparableConnection config \connection -> do-            result <--              Connection.use connection do-                _ <--                  catchError-                    ( Just-                        <$> Session.pipeline-                          ( (,,)-                              <$> Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}-                              <*> Execution.pipelineByParams Statements.WrongDecoder {start = 0, end = 2}-                              <*> Execution.pipelineByParams Statements.GenerateSeries {start = 0, end = 2}-                          )-                    )-                    (const (pure Nothing))-                Execution.sessionByParams Statements.GenerateSeries {start = 0, end = 0}-            shouldBe result (Right [0])--  describe "Failing pipeline" do-    it "Does not cause errors in the next pipeline" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        -- Run an intentionally failing prepared statement in a pipeline to set the condition of the bug.-        result <- Connection.use connection do-          Session.pipeline do-            Pipeline.statement-              ()-              ( Statement.preparable-                  "select null :: int4"-                  mempty-                  (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))-              )-        case result of-          Right val ->-            expectationFailure ("First statement succeeded unexpectedly: " <> show val)-          Left _ ->-            pure ()--        -- Run a succeeding prepared statement in a pipeline to see if the cache is still in a good state.-        result <- Connection.use connection do-          Session.pipeline do-            Pipeline.statement-              ()-              ( Statement.preparable-                  "select 1"-                  mempty-                  (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))-              )-        -- If there is an error the cache got corrupted.-        case result of-          Right _ ->-            pure ()-          Left result ->-            expectationFailure ("Unexpected error: " <> show result)--    it "Handles failures within the same pipeline gracefully" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        -- Run an intentionally failing prepared statement in a pipeline to set the condition of the bug.-        result <- Connection.use connection do-          Session.pipeline do-            Pipeline.statement-              ()-              ( Statement.preparable-                  "select null :: int4"-                  mempty-                  (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))-              )-              <* Pipeline.statement-                ()-                ( Statement.preparable-                    "select 1"-                    mempty-                    (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))-                )-        case result of-          Right val ->-            expectationFailure ("First statement succeeded unexpectedly: " <> show val)-          Left _ ->-            pure ()
− src/library-tests/Sharing/ByUnit/Session/CatchErrorSpec.hs 
@@ -1,33 +0,0 @@-module Sharing.ByUnit.Session.CatchErrorSpec (spec) where--import Data.Either-import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  it "Leaves the session usable" \config -> do-    Scripts.onPreparableConnection config \connection -> do-      let tryStatement =-            Statement.preparable-              "select $1 :: int8"-              (Encoders.param (Encoders.nonNullable Encoders.int8))-              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))--      result <--        Connection.use connection do-          -- First successful query-          a <- Session.statement (1 :: Int64) tryStatement-          -- This should fail but connection should remain usable-          () <- catchError (Session.script "absurd") (const (pure ()))-          -- Second successful query-          b <- Session.statement (2 :: Int64) tryStatement-          pure (a, b)--      result `shouldBe` Right (1, 2)
− src/library-tests/Sharing/ByUnit/Session/ScriptSpec.hs 
@@ -1,59 +0,0 @@-module Sharing.ByUnit.Session.ScriptSpec (spec) where--import Data.Either-import Hasql.Connection qualified as Connection-import Hasql.Errors qualified as Errors-import Hasql.Session qualified as Session-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  it "returns ServerSessionError on syntax errors" \config -> do-    Scripts.onPreparableConnection config \connection -> do-      result <- Connection.use connection (Session.script "THIS IS INVALID SQL")-      case result of-        Left (Errors.ScriptSessionError _ _) -> pure ()-        _ -> expectationFailure $ "Expected ScriptSessionError with ExecutionScriptError, got: " <> show result--  it "handles multi-statement DDL scripts with comments" \config -> do-    Scripts.onPreparableConnection config \connection -> do-      tableName <- Scripts.generateSymname-      let sql =-            (mconcat . map (<> "\n"))-              [ "create table \"" <> tableName <> "_genre\" (",-                "  \"id\" int4 not null primary key,",-                "  \"name\" text not null unique",-                ");",-                "",-                "create table \"" <> tableName <> "_artist\" (",-                "  \"id\" int4 not null primary key,",-                "  \"name\" text not null",-                ");",-                "",-                "create table \"" <> tableName <> "_album\" (",-                "  \"id\" int4 not null primary key,",-                "  -- Album name.",-                "  \"name\" text not null,",-                "  -- The date the album was first released.",-                "  \"released\" date null",-                ");",-                "",-                "create table \"" <> tableName <> "_album_genre\" (",-                "  \"album\" int4 not null references \"" <> tableName <> "_album\",",-                "  \"genre\" int4 not null references \"" <> tableName <> "_genre\"",-                ");",-                "",-                "create table \"" <> tableName <> "_album_artist\" (",-                "  \"album\" int4 not null references \"" <> tableName <> "_album\",",-                "  \"artist\" int4 not null references \"" <> tableName <> "_artist\",",-                "  -- Whether it is the primary artist",-                "  \"primary\" bool not null,",-                "  primary key (\"album\", \"artist\")",-                ");"-              ]-      result <- Connection.use connection (Session.script sql)-      case result of-        Right () -> pure ()-        Left err -> expectationFailure $ "Expected success, got: " <> show err
− src/library-tests/Sharing/ByUnit/Session/StatementSpec.hs 
@@ -1,79 +0,0 @@-module Sharing.ByUnit.Session.StatementSpec (spec) where--import Data.Either-import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Errors qualified as Errors-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Roundtrips" do-    it "handles simple values correctly" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        result <- Connection.use connection (Session.statement (42 :: Int64) echoStatement)-        result `shouldBe` Right 42--    it "reuses a prepared statement across executions in one session" \config -> do-      -- The first execution is a cache miss (separate PARSE roundtrip),-      -- the second a cache hit (single roundtrip). Both must succeed.-      Scripts.onPreparableConnection config \connection -> do-        result <--          Connection.use connection do-            a <- Session.statement (1 :: Int64) echoStatement-            b <- Session.statement (2 :: Int64) echoStatement-            pure (a, b)-        result `shouldBe` Right (1, 2)--    it "keeps a prepared statement usable after an EXECUTE error" \config -> do-      -- Regression: PARSE succeeds, EXECUTE fails (division by zero). The-      -- statement is on the server under its cached name, so a later use on the-      -- same connection must hit the cache rather than re-issuing PARSE for an-      -- already-existing name ("prepared statement ... already exists").-      Scripts.onPreparableConnection config \connection -> do-        failure <- Connection.use connection (Session.statement 0 divStatement)-        failure `shouldSatisfy` isLeft-        success <- Connection.use connection (Session.statement 1 divStatement)-        success `shouldBe` Right 1--    it "works on an unpreparable connection" \config -> do-      Scripts.onUnpreparableConnection config \connection -> do-        result <- Connection.use connection (Session.statement (42 :: Int64) echoStatement)-        result `shouldBe` Right 42--  describe "Error Handling" do-    it "captures query errors correctly" \config -> do-      Scripts.onPreparableConnection config \connection -> do-        let statement =-              Statement.preparable-                "select true where 1 = any ($1) and $2"-                ( mconcat-                    [ fst >$< (Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8)))))),-                      snd >$< (Encoders.param (Encoders.nonNullable Encoders.text))-                    ]-                )-                (fmap (maybe False (const True)) (Decoders.rowMaybe (Decoders.column (Decoders.nonNullable Decoders.bool))))-        result <- Connection.use connection (Session.statement ([3, 7] :: [Int64], "a") statement)-        case result of-          Left (Errors.StatementSessionError _ _ _ _ _ (Errors.ServerStatementError _)) -> pure ()-          _ -> expectationFailure $ "Unexpected result: " <> show result--echoStatement :: Statement.Statement Int64 Int64-echoStatement =-  Statement.preparable-    "select $1"-    (Encoders.param (Encoders.nonNullable Encoders.int8))-    (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))---- | Parses fine, but fails at execution time when given 0 (division by zero).-divStatement :: Statement.Statement Int64 Int64-divStatement =-  Statement.preparable-    "select 1 / $1"-    (Encoders.param (Encoders.nonNullable Encoders.int8))-    (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))
− src/library-tests/Sharing/ByUnit/SessionSpec.hs 
@@ -1,38 +0,0 @@-module Sharing.ByUnit.SessionSpec (spec) where--import Data.Either-import Hasql.Connection qualified as Connection-import Helpers.Dsls.Execution qualified as Execution-import Helpers.Scripts qualified as Scripts-import Helpers.Statements qualified as Statements-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  it "Does not lose the server-side session state on timeout" \config -> do-    Scripts.onPreparableConnection config \connection -> do-      varname <- Execution.generateVarname-      result <- timeout 50_000 do-        Connection.use connection do-          Execution.sessionByParams (Statements.SetConfig varname "1" False)-          Execution.sessionByParams (Statements.Sleep 0.1)--      result `shouldBe` Nothing--      result <- Connection.use connection do-        Execution.sessionByParams (Statements.CurrentSetting varname True)--      result `shouldBe` Right (Just "1")--  it "Does not lose the server-side session state between uses" \config -> do-    Scripts.onPreparableConnection config \connection -> do-      varname <- Execution.generateVarname--      result <- Connection.use connection do-        Execution.sessionByParams (Statements.SetConfig varname "1" False)-      result `shouldSatisfy` isRight--      result <- Connection.use connection do-        Execution.sessionByParams (Statements.CurrentSetting varname True)-      result `shouldBe` Right (Just "1")
− src/library-tests/Sharing/ByUnit/StatementSpec.hs 
@@ -1,111 +0,0 @@-module Sharing.ByUnit.StatementSpec (spec) where--import Hasql.Connection qualified as Connection-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Helpers.Scripts qualified as Scripts-import Test.Hspec-import Prelude--spec :: SpecWith (Text, Word16)-spec = do-  describe "Statement Functionality" do-    describe "Prepared statements" do-      it "allows reuse of the same prepared statement on different types" \config -> do-        Scripts.onPreparableConnection config \connection -> do-          let statement1 =-                Statement.preparable-                  "select $1"-                  (Encoders.param (Encoders.nonNullable Encoders.text))-                  (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.text)))-          let statement2 =-                Statement.preparable-                  "select $1"-                  (Encoders.param (Encoders.nonNullable Encoders.int8))-                  (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))--          result <--            Connection.use connection do-              result1 <- Session.statement "ok" statement1-              result2 <- Session.statement (1 :: Int64) statement2-              return (result1, result2)-          result `shouldBe` Right ("ok", 1 :: Int64)--    describe "Row counting" do-      it "counts affected rows correctly" \config -> do-        tableName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          let dropTable = Statement.preparable ("drop table if exists " <> tableName) mempty Decoders.noResult-          let createTable = Statement.preparable ("create table " <> tableName <> " (id bigserial not null, name varchar not null, primary key (id))") mempty Decoders.noResult-          let insertRow = Statement.unpreparable ("insert into " <> tableName <> " (name) values ('a')") mempty Decoders.noResult-          let deleteRows = Statement.unpreparable ("delete from " <> tableName) mempty Decoders.rowsAffected--          result <--            Connection.use connection do-              Session.statement () dropTable-              Session.statement () createTable-              replicateM_ 100 (Session.statement () insertRow)-              affectedRows <- Session.statement () deleteRows-              Session.statement () dropTable-              return affectedRows-          result `shouldBe` Right 100--    describe "Auto-incremented columns" do-      it "returns auto-incremented column results" \config -> do-        tableName <- Scripts.generateSymname-        Scripts.onPreparableConnection config \connection -> do-          let dropTable = Statement.preparable ("drop table if exists " <> tableName) mempty Decoders.noResult-          let createTable = Statement.preparable ("create table " <> tableName <> " (id bigserial not null, name varchar not null, primary key (id))") mempty Decoders.noResult-          let insertRow = Statement.unpreparable ("insert into " <> tableName <> " (name) values ('a') returning id") mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))-          let insertRow2 = Statement.unpreparable ("insert into " <> tableName <> " (name) values ('b') returning id") mempty (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))--          result <--            Connection.use connection do-              Session.statement () dropTable-              Session.statement () createTable-              id1 <- Session.statement () insertRow-              id2 <- Session.statement () insertRow2-              Session.statement () dropTable-              return (id1, id2)-          result `shouldBe` Right (1 :: Int64, 2 :: Int64)--    describe "List decoding" do-      it "decodes lists correctly" \config -> do-        Scripts.onPreparableConnection config \connection -> do-          let statement =-                Statement.preparable-                  "values (1 :: int8, 2 :: int8), (3,4), (5,6)"-                  mempty-                  (Decoders.rowList ((,) <$> (Decoders.column (Decoders.nonNullable Decoders.int8)) <*> (Decoders.column (Decoders.nonNullable Decoders.int8))))-          result <- Connection.use connection (Session.statement () statement)-          result `shouldBe` Right [(1 :: Int64, 2 :: Int64), (3, 4), (5, 6)]--    describe "IN simulation" do-      it "works with arrays" \config -> do-        Scripts.onPreparableConnection config \connection -> do-          let statement =-                Statement.preparable-                  "select true where 1 = any ($1)"-                  (Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8))))))-                  (fmap (maybe False (const True)) (Decoders.rowMaybe (Decoders.column (Decoders.nonNullable Decoders.bool))))-          result <- Connection.use connection do-            result1 <- Session.statement ([1, 2] :: [Int64]) statement-            result2 <- Session.statement ([2, 3] :: [Int64]) statement-            return (result1, result2)-          result `shouldBe` Right (True, False)--    describe "NOT IN simulation" do-      it "works with arrays" \config -> do-        Scripts.onPreparableConnection config \connection -> do-          let statement =-                Statement.preparable-                  "select true where 3 <> all ($1)"-                  (Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8))))))-                  (fmap (maybe False (const True)) (Decoders.rowMaybe (Decoders.column (Decoders.nonNullable Decoders.bool))))-          result <- Connection.use connection do-            result1 <- Session.statement ([1, 2] :: [Int64]) statement-            result2 <- Session.statement ([2, 3] :: [Int64]) statement-            return (result1, result2)-          result `shouldBe` Right (True, False)
− src/library-tests/Sharing/SpecHook.hs 
@@ -1,25 +0,0 @@--- Docs: https://hspec.github.io/hspec-discover.html-module Sharing.SpecHook where--import Test.Hspec-import TestcontainersPostgresql qualified-import Prelude--type HookedSpec = SpecWith (Text, Word16)--hook :: HookedSpec -> Spec-hook hookedSpec = parallel do-  byDistro "postgres:9"-  byDistro "postgres:18"-  where-    byDistro tagName =-      describe (toList tagName) do-        aroundAll-          ( TestcontainersPostgresql.run-              TestcontainersPostgresql.Config-                { tagName,-                  auth = TestcontainersPostgresql.CredentialsAuth "postgres" "postgres",-                  forwardLogs = False-                }-          )-          (parallel hookedSpec)
− src/library/Hasql/Codecs/Decoders.hs 
@@ -1,147 +0,0 @@-module Hasql.Codecs.Decoders-  ( -- * Nullability-    NullableOrNot.NullableOrNot (..),-    NullableOrNot.nonNullable,-    NullableOrNot.nullable,--    -- * Value-    Value.Value (..),-    Value.bool,-    Value.int2,-    Value.int4,-    Value.int8,-    Value.float4,-    Value.float8,-    Value.numeric,-    Value.char,-    Value.text,-    Value.varchar,-    Value.bpchar,-    Value.bytea,-    Value.date,-    Value.timestamp,-    Value.timestamptz,-    Value.time,-    Value.timetz,-    Value.interval,-    Value.uuid,-    Value.inet,-    Value.macaddr,-    Value.json,-    Value.jsonBytes,-    Value.jsonb,-    Value.jsonbBytes,-    Value.int4range,-    Value.int8range,-    Value.numrange,-    Value.tsrange,-    Value.tstzrange,-    Value.daterange,-    Value.int4multirange,-    Value.int8multirange,-    Value.nummultirange,-    Value.tsmultirange,-    Value.tstzmultirange,-    Value.datemultirange,-    Value.citext,-    array,-    listArray,-    vectorArray,-    composite,-    record,-    Value.hstore,-    Value.enum,-    Value.custom,-    Value.refine,--    -- * Array-    Array.Array,-    Array.dimension,-    Array.element,--    -- * Composite-    Composite.Composite (..),-    Composite.field,-  )-where--import Data.Vector.Generic qualified as GenericVector-import Hasql.Codecs.Decoders.Array qualified as Array-import Hasql.Codecs.Decoders.Composite qualified as Composite-import Hasql.Codecs.Decoders.NullableOrNot qualified as NullableOrNot-import Hasql.Codecs.Decoders.Value qualified as Value-import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo-import Hasql.Platform.Prelude---- * Value---- |--- Lift an 'Array.Array' decoder to a 'Value.Value' decoder.-{-# INLINEABLE array #-}-array :: Array.Array a -> Value.Value a-array decoder = Value.Value (Array.toSchema decoder) (Array.toTypeName decoder) (Array.toBaseOid decoder) (Array.toArrayOid decoder) (Array.toDimensionality decoder) (Array.toValueDecoder decoder)---- |--- 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.NullableOrNot Value.Value element -> Value.Value [element]-listArray = array . Array.dimension replicateM . Array.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.NullableOrNot Value.Value element -> Value.Value (vector element)-vectorArray = array . Array.dimension GenericVector.replicateM . Array.element---- |--- Lift a 'Composite.Composite' decoder to a 'Value.Value' decoder for named composite types.------ This function is for named composite types where the type name is known.--- For anonymous composite types (like those created with ROW constructor),--- use 'record' instead.-{-# INLINEABLE composite #-}-composite :: Maybe Text -> Text -> Composite.Composite a -> Value.Value a-composite schema typeName composite =-  Value.Value-    schema-    typeName-    Nothing-    Nothing-    0-    (Composite.toValueDecoder composite)---- |--- Lift a 'Composite.Composite' decoder to a 'Value.Value' decoder for unnamed composite types.------ This is useful for decoding anonymous composites (like those created with ROW constructor)--- where no type name is required. Postgres will handle the type automatically.-{-# INLINEABLE record #-}-record :: Composite.Composite a -> Value.Value a-record composite =-  Value.Value-    Nothing-    "record"-    (Just (Vocab.TypeInfo.toBaseOid typeInfo))-    (Just (Vocab.TypeInfo.toArrayOid typeInfo))-    0-    (Composite.toValueDecoder composite)-  where-    typeInfo = Vocab.TypeInfo.record
− src/library/Hasql/Codecs/Decoders/Array.hs 
@@ -1,139 +0,0 @@-module Hasql.Codecs.Decoders.Array-  ( Array,-    toValueDecoder,-    toTypeSig,-    toSchema,-    toTypeName,-    toBaseOid,-    toArrayOid,-    toDimensionality,-    dimension,-    element,-  )-where--import Hasql.Codecs.Decoders.NullableOrNot qualified as NullableOrNot-import Hasql.Codecs.Decoders.Value qualified as Value-import Hasql.Codecs.RequestingOid qualified as RequestingOid-import Hasql.Platform.Prelude-import PostgreSQL.Binary.Decoding qualified as Binary-import TextBuilder qualified---- |--- Binary generic array decoder.------ Here's how you can use it to produce a specific array value decoder:------ @--- x :: 'Value.Value' [[Text]]--- x = 'array' ('dimension' 'replicateM' ('dimension' 'replicateM' ('element' ('nonNullable' 'text'))))--- @-data Array a-  = Array-      -- | Schema name.-      (Maybe Text)-      -- | Type name for the array element.-      Text-      -- | Statically known OID for the base (element) type.-      (Maybe Word32)-      -- | Statically known OID for the array type.-      (Maybe Word32)-      -- | Number of dimensions.-      Word-      -- | Decoding function-      (RequestingOid.RequestingOid (Binary.Array a))-  deriving (Functor)--{-# INLINE toValueDecoder #-}-toValueDecoder :: Array a -> RequestingOid.RequestingOid (Binary.Value a)-toValueDecoder (Array _ _ _ _ _ decoder) =-  fmap Binary.array decoder---- | Get the type signature for the array based on element type name-{-# INLINE toTypeSig #-}-toTypeSig :: Array a -> Text-toTypeSig (Array schemaName elementTypeName _ _ ndims _) =-  TextBuilder.toText-    ( mconcat-        ( mconcat-            [ foldMap-                (\s -> [TextBuilder.text s, TextBuilder.char '.'])-                schemaName,-              [ TextBuilder.text elementTypeName-              ],-              replicate-                (fromIntegral ndims)-                (TextBuilder.text "[]")-            ]-        )-    )--toSchema :: Array a -> Maybe Text-toSchema (Array schema _ _ _ _ _) = schema---- | Get the type name for the array based on element type name-{-# INLINE toTypeName #-}-toTypeName :: Array a -> Text-toTypeName (Array _ elementTypeName _ _ _ _) =-  elementTypeName---- | Get the base OID if statically known-{-# INLINE toBaseOid #-}-toBaseOid :: Array a -> Maybe Word32-toBaseOid (Array _ _ baseOid _ _ _) = baseOid---- | Get the array OID if statically known-{-# INLINE toArrayOid #-}-toArrayOid :: Array a -> Maybe Word32-toArrayOid (Array _ _ _ arrayOid _ _) = arrayOid---- | Get the dimensionality of the array-{-# INLINE toDimensionality #-}-toDimensionality :: Array a -> Word-toDimensionality (Array _ _ _ _ ndims _) = ndims---- * Public API---- |--- Binary 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.------ * Binary decoder of its components, which can be either another 'dimension' or 'element'.-{-# INLINEABLE dimension #-}-dimension :: (forall m. (Monad m) => Int -> m a -> m b) -> Array a -> Array b-dimension replicateM (Array schema typeName baseOid arrayOid ndims decoder) =-  Array-    schema-    typeName-    baseOid-    arrayOid-    (succ ndims)-    (fmap (Binary.dimensionArray replicateM) decoder)---- |--- Lift a 'Value.Value' decoder into an 'Array' decoder for parsing of leaf values.-{-# INLINEABLE element #-}-element :: NullableOrNot.NullableOrNot Value.Value a -> Array a-element = \case-  NullableOrNot.NonNullable imp ->-    Array-      (Value.toSchema imp)-      (Value.toTypeName imp)-      (Value.toBaseOid imp)-      (Value.toArrayOid imp)-      1-      (fmap Binary.valueArray (Value.toDecoder imp))-  NullableOrNot.Nullable imp ->-    Array-      (Value.toSchema imp)-      (Value.toTypeName imp)-      (Value.toBaseOid imp)-      (Value.toArrayOid imp)-      1-      (fmap Binary.nullableValueArray (Value.toDecoder imp))
− src/library/Hasql/Codecs/Decoders/Composite.hs 
@@ -1,52 +0,0 @@-module Hasql.Codecs.Decoders.Composite where--import Hasql.Codecs.Decoders.NullableOrNot qualified as NullableOrNot-import Hasql.Codecs.Decoders.Value qualified as Value-import Hasql.Codecs.RequestingOid qualified as RequestingOid-import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName-import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo-import Hasql.Platform.Prelude-import PostgreSQL.Binary.Decoding qualified as Binary---- |--- Composable decoder of composite values (rows, records).-newtype Composite a-  = Composite (RequestingOid.RequestingOid (Binary.Composite a))-  deriving-    (Functor, Applicative)-    via (Compose RequestingOid.RequestingOid Binary.Composite)--toValueDecoder :: Composite a -> RequestingOid.RequestingOid (Binary.Value a)-toValueDecoder (Composite imp) =-  fmap Binary.composite imp---- |--- Lift a 'Value.Value' decoder into a 'Composite' decoder for parsing of component values.-field :: NullableOrNot.NullableOrNot Value.Value a -> Composite a-field = \case-  NullableOrNot.NonNullable imp ->-    let dimensionality = Value.toDimensionality imp-        staticOid = if dimensionality == 0 then Value.toBaseOid imp else Value.toArrayOid imp-     in case staticOid of-          Just oid ->-            Composite (fmap (Binary.typedValueComposite oid) (Value.toDecoder imp))-          Nothing ->-            Composite-              ( RequestingOid.hoistLookingUp-                  (Vocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema imp) (Value.toTypeName imp))-                  (\typeInfo decoder -> Binary.typedValueComposite (if dimensionality == 0 then Vocab.TypeInfo.toBaseOid typeInfo else Vocab.TypeInfo.toArrayOid typeInfo) decoder)-                  (Value.toDecoder imp)-              )-  NullableOrNot.Nullable imp ->-    let dimensionality = Value.toDimensionality imp-        staticOid = if dimensionality == 0 then Value.toBaseOid imp else Value.toArrayOid imp-     in case staticOid of-          Just oid ->-            Composite (fmap (Binary.typedNullableValueComposite oid) (Value.toDecoder imp))-          Nothing ->-            Composite-              ( RequestingOid.hoistLookingUp-                  (Vocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema imp) (Value.toTypeName imp))-                  (\typeInfo decoder -> Binary.typedNullableValueComposite (if dimensionality == 0 then Vocab.TypeInfo.toBaseOid typeInfo else Vocab.TypeInfo.toArrayOid typeInfo) decoder)-                  (Value.toDecoder imp)-              )
− src/library/Hasql/Codecs/Decoders/NullableOrNot.hs 
@@ -1,27 +0,0 @@-module Hasql.Codecs.Decoders.NullableOrNot-  ( -- * Nullability-    NullableOrNot (..),-    nonNullable,-    nullable,-  )-where--import Hasql.Platform.Prelude---- * 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
− src/library/Hasql/Codecs/Decoders/Value.hs 
@@ -1,461 +0,0 @@-module Hasql.Codecs.Decoders.Value-  ( Value (..),-    bool,-    int2,-    int4,-    int8,-    float4,-    float8,-    numeric,-    char,-    text,-    varchar,-    bpchar,-    bytea,-    date,-    timestamp,-    timestamptz,-    time,-    timetz,-    interval,-    uuid,-    inet,-    macaddr,-    json,-    jsonBytes,-    jsonb,-    jsonbBytes,-    int4range,-    int8range,-    numrange,-    tsrange,-    tstzrange,-    daterange,-    int4multirange,-    int8multirange,-    nummultirange,-    tsmultirange,-    tstzmultirange,-    datemultirange,-    citext,-    custom,-    refine,-    hstore,-    enum,-    toDimensionality,-    toDecoder,-    toSchema,-    toTypeName,-    toOid,-    toBaseOid,-    toArrayOid,-    toHandler,-    toByteStringParser,-    isArray,-  )-where--import Data.Aeson qualified as Aeson-import Data.IP qualified as Iproute-import Hasql.Codecs.RequestingOid qualified as RequestingOid-import Hasql.Codecs.Vocab qualified as Vocab-import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName-import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo-import Hasql.Platform.Prelude hiding (bool)-import PostgreSQL.Binary.Decoding qualified as Binary-import PostgreSQL.Binary.Range qualified as R---- |--- Value decoder.-data Value a-  = Value-      -- | Schema name.-      (Maybe Text)-      -- | Type name.-      Text-      -- | Statically known OID for the type.-      (Maybe Word32)-      -- | Statically known OID for the array-type with this type as the element.-      (Maybe Word32)-      -- | Dimensionality. If 0 then it is a scalar value, otherwise it is an array with that many dimensions.-      Word-      -- | Decoding function on a registry of OIDs by type name.-      (RequestingOid.RequestingOid (Binary.Value a))-  deriving (Functor)--type role Value representational--instance Filterable Value where-  {-# INLINE mapMaybe #-}-  mapMaybe fn =-    refine (maybe (Left "Invalid value") Right . fn)---- |--- Create a decoder from TypeInfo metadata and a decoding function.-{-# INLINE primitive #-}-primitive :: Text -> Vocab.TypeInfo.TypeInfo -> Binary.Value a -> Value a-primitive typeName pti decoder =-  Value Nothing typeName (Just (Vocab.TypeInfo.toBaseOid pti)) (Just (Vocab.TypeInfo.toArrayOid pti)) 0 (RequestingOid.lift decoder)---- * Static types---- |--- Decoder of the @BOOL@ values.-{-# INLINEABLE bool #-}-bool :: Value Bool-bool = primitive "bool" Vocab.TypeInfo.bool Binary.bool---- |--- Decoder of the @INT2@ values.-{-# INLINEABLE int2 #-}-int2 :: Value Int16-int2 = primitive "int2" Vocab.TypeInfo.int2 Binary.int---- |--- Decoder of the @INT4@ values.-{-# INLINEABLE int4 #-}-int4 :: Value Int32-int4 = primitive "int4" Vocab.TypeInfo.int4 Binary.int---- |--- Decoder of the @INT8@ values.-{-# INLINEABLE int8 #-}-int8 :: Value Int64-int8 =-  {-# SCC "int8" #-}-  primitive "int8" Vocab.TypeInfo.int8 ({-# SCC "int8.int" #-} Binary.int)---- |--- Decoder of the @FLOAT4@ values.-{-# INLINEABLE float4 #-}-float4 :: Value Float-float4 = primitive "float4" Vocab.TypeInfo.float4 Binary.float4---- |--- Decoder of the @FLOAT8@ values.-{-# INLINEABLE float8 #-}-float8 :: Value Double-float8 = primitive "float8" Vocab.TypeInfo.float8 Binary.float8---- |--- Decoder of the @NUMERIC@ values.-{-# INLINEABLE numeric #-}-numeric :: Value Scientific-numeric = primitive "numeric" Vocab.TypeInfo.numeric Binary.numeric---- |--- Decoder of the @CHAR@ values.--- Note that it supports Unicode values.-{-# INLINEABLE char #-}-char :: Value Char-char = primitive "char" Vocab.TypeInfo.char Binary.char---- |--- Decoder of the @TEXT@ values.-{-# INLINEABLE text #-}-text :: Value Text-text = primitive "text" Vocab.TypeInfo.text Binary.text_strict---- |--- Decoder of the @VARCHAR@ values.-{-# INLINEABLE varchar #-}-varchar :: Value Text-varchar = primitive "varchar" Vocab.TypeInfo.varchar Binary.text_strict---- |--- Decoder of @BPCHAR@ or @CHAR(n)@, @CHARACTER(n)@ values.-{-# INLINEABLE bpchar #-}-bpchar :: Value Text-bpchar = primitive "bpchar" Vocab.TypeInfo.bpchar Binary.text_strict---- |--- Decoder of the @BYTEA@ values.-{-# INLINEABLE bytea #-}-bytea :: Value ByteString-bytea = primitive "bytea" Vocab.TypeInfo.bytea Binary.bytea_strict---- |--- Decoder of the @DATE@ values.-{-# INLINEABLE date #-}-date :: Value Day-date = primitive "date" Vocab.TypeInfo.date Binary.date---- |--- Decoder of the @TIMESTAMP@ values.-{-# INLINEABLE timestamp #-}-timestamp :: Value LocalTime-timestamp = primitive "timestamp" Vocab.TypeInfo.timestamp Binary.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.-{-# INLINEABLE timestamptz #-}-timestamptz :: Value UTCTime-timestamptz = primitive "timestamptz" Vocab.TypeInfo.timestamptz Binary.timestamptz_int---- |--- Decoder of the @TIME@ values.-{-# INLINEABLE time #-}-time :: Value TimeOfDay-time = primitive "time" Vocab.TypeInfo.time Binary.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.-{-# INLINEABLE timetz #-}-timetz :: Value (TimeOfDay, TimeZone)-timetz = primitive "timetz" Vocab.TypeInfo.timetz Binary.timetz_int---- |--- Decoder of the @INTERVAL@ values.-{-# INLINEABLE interval #-}-interval :: Value DiffTime-interval = primitive "interval" Vocab.TypeInfo.interval Binary.interval_int---- |--- Decoder of the @UUID@ values.-{-# INLINEABLE uuid #-}-uuid :: Value UUID-uuid = primitive "uuid" Vocab.TypeInfo.uuid Binary.uuid---- |--- Decoder of the @INET@ values.-{-# INLINEABLE inet #-}-inet :: Value Iproute.IPRange-inet = primitive "inet" Vocab.TypeInfo.inet Binary.inet---- |--- Decoder of the @MACADDR@ values.------ Represented as a 6-tuple of Word8 values in big endian order. If--- you use `ip` library consider using it with `fromOctets`.------ > (\(a,b,c,d,e,f) -> fromOctets a b c d e f) <$> macaddr-{-# INLINEABLE macaddr #-}-macaddr :: Value (Word8, Word8, Word8, Word8, Word8, Word8)-macaddr = primitive "macaddr" Vocab.TypeInfo.macaddr Binary.macaddr---- |--- Decoder of the @JSON@ values into a JSON AST.-{-# INLINEABLE json #-}-json :: Value Aeson.Value-json = primitive "json" Vocab.TypeInfo.json Binary.json_ast---- |--- Decoder of the @JSON@ values into a raw JSON 'ByteString'.-{-# INLINEABLE jsonBytes #-}-jsonBytes :: (ByteString -> Either Text a) -> Value a-jsonBytes fn = primitive "json" Vocab.TypeInfo.json (Binary.json_bytes fn)---- |--- Decoder of the @JSONB@ values into a JSON AST.-{-# INLINEABLE jsonb #-}-jsonb :: Value Aeson.Value-jsonb = primitive "jsonb" Vocab.TypeInfo.jsonb Binary.jsonb_ast---- |--- Decoder of the @JSONB@ values into a raw JSON 'ByteString'.-{-# INLINEABLE jsonbBytes #-}-jsonbBytes :: (ByteString -> Either Text a) -> Value a-jsonbBytes fn = primitive "jsonb" Vocab.TypeInfo.jsonb (Binary.jsonb_bytes fn)---- |--- Decoder of the @INT4RANGE@ values.-{-# INLINEABLE int4range #-}-int4range :: Value (R.Range Int32)-int4range = primitive "int4range" Vocab.TypeInfo.int4range Binary.int4range---- |--- Decoder of the @INT8RANGE@ values.-{-# INLINEABLE int8range #-}-int8range :: Value (R.Range Int64)-int8range = primitive "int8range" Vocab.TypeInfo.int8range Binary.int8range---- |--- Decoder of the @NUMRANGE@ values.-{-# INLINEABLE numrange #-}-numrange :: Value (R.Range Scientific)-numrange = primitive "numrange" Vocab.TypeInfo.numrange Binary.numrange---- |--- Decoder of the @TSRANGE@ values.-{-# INLINEABLE tsrange #-}-tsrange :: Value (R.Range LocalTime)-tsrange = primitive "tsrange" Vocab.TypeInfo.tsrange Binary.tsrange_int---- |--- Decoder of the @TSTZRANGE@ values.-{-# INLINEABLE tstzrange #-}-tstzrange :: Value (R.Range UTCTime)-tstzrange = primitive "tstzrange" Vocab.TypeInfo.tstzrange Binary.tstzrange_int---- |--- Decoder of the @DATERANGE@ values.-{-# INLINEABLE daterange #-}-daterange :: Value (R.Range Day)-daterange = primitive "daterange" Vocab.TypeInfo.daterange Binary.daterange---- |--- Decoder of the @INT4MULTIRANGE@ values.-{-# INLINEABLE int4multirange #-}-int4multirange :: Value (R.Multirange Int32)-int4multirange = primitive "int4multirange" Vocab.TypeInfo.int4multirange Binary.int4multirange---- |--- Decoder of the @INT8MULTIRANGE@ values.-{-# INLINEABLE int8multirange #-}-int8multirange :: Value (R.Multirange Int64)-int8multirange = primitive "int8multirange" Vocab.TypeInfo.int8multirange Binary.int8multirange---- |--- Decoder of the @NUMMULTIRANGE@ values.-{-# INLINEABLE nummultirange #-}-nummultirange :: Value (R.Multirange Scientific)-nummultirange = primitive "nummultirange" Vocab.TypeInfo.nummultirange Binary.nummultirange---- |--- Decoder of the @TSMULTIRANGE@ values.-{-# INLINEABLE tsmultirange #-}-tsmultirange :: Value (R.Multirange LocalTime)-tsmultirange = primitive "tsmultirange" Vocab.TypeInfo.tsmultirange Binary.tsmultirange_int---- |--- Decoder of the @TSTZMULTIRANGE@ values.-{-# INLINEABLE tstzmultirange #-}-tstzmultirange :: Value (R.Multirange UTCTime)-tstzmultirange = primitive "tstzmultirange" Vocab.TypeInfo.tstzmultirange Binary.tstzmultirange_int---- |--- Decoder of the @DATEMULTIRANGE@ values.-{-# INLINEABLE datemultirange #-}-datemultirange :: Value (R.Multirange Day)-datemultirange = primitive "datemultirange" Vocab.TypeInfo.datemultirange Binary.datemultirange---- |--- Decoder of the @CITEXT@ values.------ Requires the @citext@ extension to be installed in the database.-{-# INLINEABLE citext #-}-citext :: Value Text-citext = Value Nothing "citext" Nothing Nothing 0 (RequestingOid.lift Binary.text_strict)---- |--- Low level API for defining custom value decoders.-{-# INLINEABLE custom #-}-custom ::-  -- | Schema name.-  Maybe Text ->-  -- | Type name.-  Text ->-  -- | Possible static OIDs for the type. The first is for scalar values the second is for arrays.-  ---  -- When unspecified, the OIDs will be automatically determined at runtime by looking up by name.-  Maybe (Word32, Word32) ->-  -- | Other named types whose OIDs are needed for deserializing.-  ---  -- E.g., when decoding composite types you can check the OIDs of its fields against the ones specified by Postgres.-  ---  -- When any of the requested types is missing in the database an error will be raised upon the statement execution.-  [(Maybe Text, Text)] ->-  -- | Deserialization function in the context of resolved OIDs of the types requested in the previous parameter.-  ---  -- It's safe to assume that all of the requested types will be present.-  -- In case you run the provided lookup function with unmentioned type names it will produce OID of 0 for them, standing for unknown type in Postgres.-  ( ((Maybe Text, Text) -> (Word32, Word32)) ->-    ByteString ->-    Either Text a-  ) ->-  Value a-custom schema typeName staticOids requestedTypes fn =-  Value-    schema-    typeName-    (fmap fst staticOids)-    (fmap snd staticOids)-    0-    (RequestingOid.requestAndHandle (fmap Vocab.QualifiedTypeName.fromNameTuple requestedTypes) (\lookup -> Binary.fn (fn (toTuple . lookup . Vocab.QualifiedTypeName.fromNameTuple))))-  where-    toTuple typeInfo = (Vocab.TypeInfo.toBaseOid typeInfo, Vocab.TypeInfo.toArrayOid typeInfo)---- |--- Refine a value decoder, lifting the possible error to the session level.-{-# INLINE refine #-}-refine :: (a -> Either Text b) -> Value a -> Value b-refine fn (Value schema typeName typeOid arrayOid dimensionality decoder) =-  Value schema typeName typeOid arrayOid dimensionality (fmap (Binary.refine fn) decoder)---- |--- Binary 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'--- @-{-# INLINEABLE hstore #-}-hstore :: (forall m. (Monad m) => Int -> m (Text, Maybe Text) -> m a) -> Value a-hstore replicateM =-  Value Nothing "hstore" Nothing Nothing 0 (RequestingOid.lift (Binary.hstore replicateM Binary.text_strict Binary.text_strict))---- |--- Given a partial mapping from text to value, produces a decoder of that value for a named enum type.-enum ::-  -- | Schema name.-  Maybe Text ->-  -- | Type name.-  Text ->-  -- | Mapping from text to value.-  (Text -> Maybe a) ->-  Value a-enum schema typeName mapping =-  Value schema typeName Nothing Nothing 0 (RequestingOid.lift (Binary.enum mapping))---- * Relations--toDimensionality :: Value a -> Word-toDimensionality (Value _ _ _ _ dimensionality _) = dimensionality--toSchema :: Value a -> Maybe Text-toSchema (Value schema _ _ _ _ _) = schema--toTypeName :: Value a -> Text-toTypeName (Value _ typeName _ _ _ _) = typeName--toOid :: Value a -> Maybe Word32-toOid (Value _ _ baseOid arrayOid dimensionality _) =-  if dimensionality > 0-    then arrayOid-    else baseOid--toBaseOid :: Value a -> Maybe Word32-toBaseOid (Value _ _ baseOid _ _ _) = baseOid--toArrayOid :: Value a -> Maybe Word32-toArrayOid (Value _ _ _ oid _ _) = oid--toDecoder :: Value a -> RequestingOid.RequestingOid (Binary.Value a)-toDecoder (Value _ _ _ _ _ decoder) = decoder--{-# INLINE toHandler #-}-toHandler :: Value a -> Vocab.OidCache -> Binary.Value a-toHandler (Value _ _ _ _ _ decoder) = RequestingOid.toBase decoder--{-# INLINE toByteStringParser #-}-toByteStringParser :: Value a -> (Vocab.OidCache -> ByteString -> Either Text a)-toByteStringParser (Value _ _ _ _ _ decoder) oidCache = Binary.valueParser (RequestingOid.toBase decoder oidCache)--isArray :: Value a -> Bool-isArray (Value _ _ _ _ dimensionality _) = dimensionality > 0
− src/library/Hasql/Codecs/Encoders.hs 
@@ -1,152 +0,0 @@--- |--- 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.Codecs.Encoders-  ( -- * Parameters product-    Params.Params,-    Params.noParams,-    Params.param,--    -- * Nullability-    NullableOrNot.NullableOrNot,-    NullableOrNot.nonNullable,-    NullableOrNot.nullable,--    -- * Value-    Value.Value,-    Value.bool,-    Value.int2,-    Value.int4,-    Value.int8,-    Value.float4,-    Value.float8,-    Value.numeric,-    Value.char,-    Value.text,-    Value.varchar,-    Value.bpchar,-    Value.bytea,-    Value.date,-    Value.timestamp,-    Value.timestamptz,-    Value.time,-    Value.timetz,-    Value.interval,-    Value.uuid,-    Value.inet,-    Value.macaddr,-    Value.json,-    Value.jsonBytes,-    Value.jsonLazyBytes,-    Value.jsonb,-    Value.jsonbBytes,-    Value.jsonbLazyBytes,-    Value.int4range,-    Value.int8range,-    Value.numrange,-    Value.tsrange,-    Value.tstzrange,-    Value.daterange,-    Value.int4multirange,-    Value.int8multirange,-    Value.nummultirange,-    Value.tsmultirange,-    Value.tstzmultirange,-    Value.datemultirange,-    Value.citext,-    Value.name,-    Value.oid,-    foldableArray,-    array,-    Value.hstore,-    Value.enum,-    composite,-    Value.unknown,-    Value.custom,--    -- * Array-    Array.Array,-    Array.element,-    Array.dimension,--    -- * Composite-    Composite.Composite,-    Composite.field,-  )-where--import Data.HashMap.Strict qualified as HashMap-import Hasql.Codecs.Encoders.Array qualified as Array-import Hasql.Codecs.Encoders.Composite qualified as Composite-import Hasql.Codecs.Encoders.NullableOrNot qualified as NullableOrNot-import Hasql.Codecs.Encoders.Params qualified as Params-import Hasql.Codecs.Encoders.Value qualified as Value-import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName-import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo-import Hasql.Platform.Prelude hiding (bool)-import PostgreSQL.Binary.Encoding qualified as Binary-import TextBuilder qualified---- * Recursive definitions---- |--- Lift a value encoder of element into a unidimensional array encoder of a foldable value.------ This function is merely a shortcut to the following expression:------ @--- ('array' . 'Array.dimension' 'foldl'' . 'Array.element')--- @------ You can use it like this:------ @--- vectorOfInts :: Value (Vector Int64)--- vectorOfInts = 'foldableArray' ('nonNullable' 'int8')--- @------ 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.NullableOrNot Value.Value element -> Value.Value (foldable element)-foldableArray = array . Array.dimension foldl' . Array.element---- |--- Lift an array encoder into a value encoder.-array :: Array.Array a -> Value.Value a-array (Array.Array baseTypeSchema baseTypeName _isText dimensionality scalarOidIfKnown arrayOidIfKnown unknownTypes arrayEncoder renderer) =-  let encoder oidCache input =-        let resolvedOid =-              asum-                [ scalarOidIfKnown,-                  oidCache-                    & HashMap.lookup (Vocab.QualifiedTypeName.QualifiedTypeName baseTypeSchema baseTypeName)-                    & fmap Vocab.TypeInfo.toBaseOid-                ]-                -- Should only happen on a bug.-                & fromMaybe (Vocab.TypeInfo.toBaseOid Vocab.TypeInfo.unknown)-         in Binary.array resolvedOid (arrayEncoder oidCache input)-   in Value.Value baseTypeSchema baseTypeName scalarOidIfKnown arrayOidIfKnown dimensionality False unknownTypes encoder renderer---- |--- Lift a composite encoder into a value encoder for named composite types.------ This function is for named composite types where the type name is known.--- If you need to encode an anonymous composite type (like those created with the ROW constructor),--- PostgreSQL itself does not support that.-composite ::-  -- | Schema name where the composite type is defined.-  Maybe Text ->-  -- | Composite type name.-  Text ->-  Composite.Composite a ->-  Value.Value a-composite schema name (Composite.Composite unknownTypes encode print) =-  Value.Value schema name Nothing Nothing 0 False unknownTypes encodeValue printValue-  where-    encodeValue oidCache val =-      Binary.composite (encode oidCache val)-    printValue val =-      "ROW (" <> TextBuilder.intercalate ", " (print val) <> ")"
− src/library/Hasql/Codecs/Encoders/Array.hs 
@@ -1,104 +0,0 @@-module Hasql.Codecs.Encoders.Array where--import Hasql.Codecs.Encoders.NullableOrNot qualified as NullableOrNot-import Hasql.Codecs.Encoders.Value qualified as Value-import Hasql.Codecs.Vocab qualified as Vocab-import Hasql.Platform.Prelude-import PostgreSQL.Binary.Encoding qualified as Binary-import TextBuilder qualified as TextBuilder---- |--- 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.-data Array a-  = Array-      -- | Schema name, if any.-      (Maybe Text)-      -- | Type name.-      Text-      -- | Text format?-      Bool-      -- | Dimensionality. If 0 then it is not an array, but a scalar value.-      Word-      -- | OID of the element type.-      (Maybe Word32)-      -- | OID of the array type.-      (Maybe Word32)-      -- | Names of types that are not known statically and must be looked up at runtime collected from the nested composite and array encoders.-      (HashSet Vocab.QualifiedTypeName)-      -- | Serialization function given the dictionary of resolved OIDs.-      (HashMap Vocab.QualifiedTypeName Vocab.TypeInfo -> a -> Binary.Array)-      -- | Render function for error messages.-      (a -> TextBuilder.TextBuilder)--instance Contravariant Array where-  contramap fn (Array schemaName typeName textFormat dimensionality valueOid arrayOid unknownTypes elEncoder elRenderer) =-    Array schemaName typeName textFormat dimensionality valueOid arrayOid unknownTypes (\oidCache -> elEncoder oidCache . fn) (elRenderer . fn)---- |--- Lifts a 'Value.Value' encoder into an 'Array' encoder.-element :: NullableOrNot.NullableOrNot Value.Value a -> Array a-element = \case-  NullableOrNot.NonNullable (Value.Value schemaName typeName scalarOid arrayOid dimensionality textFormat unknownTypes serialize print) ->-    Array-      schemaName-      typeName-      textFormat-      dimensionality-      scalarOid-      arrayOid-      unknownTypes-      (\oidCache -> Binary.encodingArray . serialize oidCache)-      print-  NullableOrNot.Nullable (Value.Value schemaName typeName scalarOid arrayOid dimensionality textFormat unknownTypes serialize print) ->-    let maybeSerialize oidCache =-          maybe Binary.nullArray (Binary.encodingArray . serialize oidCache)-        maybePrint =-          maybe (TextBuilder.string "null") print-     in Array-          schemaName-          typeName-          textFormat-          dimensionality-          scalarOid-          arrayOid-          unknownTypes-          maybeSerialize-          maybePrint---- |--- 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'.-{-# INLINE dimension #-}-dimension :: (forall a. (a -> b -> a) -> a -> c -> a) -> Array b -> Array c-dimension fold (Array schemaName typeName textFormat dimensionality valueOid arrayOid unknownTypes elEncoder elRenderer) =-  let encoder oidCache =-        Binary.dimensionArray fold (elEncoder oidCache)-      renderer els =-        let folded =-              let step builder el =-                    if TextBuilder.isEmpty builder-                      then TextBuilder.char '[' <> elRenderer el-                      else builder <> TextBuilder.string ", " <> elRenderer el-               in fold step mempty els-         in if TextBuilder.isEmpty folded-              then TextBuilder.string "[]"-              else folded <> TextBuilder.char ']'-   in Array schemaName typeName textFormat (succ dimensionality) valueOid arrayOid unknownTypes encoder renderer
− src/library/Hasql/Codecs/Encoders/Composite.hs 
@@ -1,97 +0,0 @@-module Hasql.Codecs.Encoders.Composite where--import Data.HashMap.Strict qualified as HashMap-import Data.HashSet qualified as HashSet-import Hasql.Codecs.Encoders.NullableOrNot qualified as NullableOrNot-import Hasql.Codecs.Encoders.Value qualified as Value-import Hasql.Codecs.Vocab qualified as Vocab-import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName-import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo-import Hasql.Platform.Prelude hiding (bool)-import PostgreSQL.Binary.Encoding qualified as Binary-import TextBuilder qualified---- |--- Composite or row-types encoder.-data Composite a-  = Composite-      -- | Names of types that are not known statically and must be looked up at runtime collected from the nested composite and array encoders.-      (HashSet Vocab.QualifiedTypeName)-      -- | Serialization function given the dictionary of resolved OIDs.-      (HashMap Vocab.QualifiedTypeName Vocab.TypeInfo -> a -> Binary.Composite)-      -- | Render function for error messages.-      (a -> [TextBuilder.TextBuilder])--instance Contravariant Composite where-  contramap f (Composite unknownTypes encode print) =-    Composite unknownTypes (\oidCache -> encode oidCache . f) (print . f)--instance Divisible Composite where-  divide f (Composite unknownTypesL encodeL printL) (Composite unknownTypesR encodeR printR) =-    Composite-      (unknownTypesL <> unknownTypesR)-      (\oidCache val -> case f val of (lVal, rVal) -> encodeL oidCache lVal <> encodeR oidCache rVal)-      (\val -> case f val of (lVal, rVal) -> printL lVal <> printR rVal)-  conquer = mempty--instance Semigroup (Composite a) where-  Composite unknownTypesL encodeL printL <> Composite unknownTypesR encodeR printR =-    Composite-      (unknownTypesL <> unknownTypesR)-      (\oidCache val -> encodeL oidCache val <> encodeR oidCache val)-      (\val -> printL val <> printR val)--instance Monoid (Composite a) where-  mempty = Composite mempty mempty mempty---- | Single field of a row-type.-field :: NullableOrNot.NullableOrNot Value.Value a -> Composite a-field = \case-  NullableOrNot.NonNullable (Value.Value schemaName typeName scalarOid arrayOid dimensionality _ unknownTypes encode print) ->-    let staticOid = if dimensionality == 0 then scalarOid else arrayOid-     in case staticOid of-          Just oid ->-            Composite-              unknownTypes-              (\oidCache val -> Binary.field oid (encode oidCache val))-              (\val -> [print val])-          Nothing ->-            Composite-              (HashSet.insert (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes)-              ( \oidCache val ->-                  let typeInfo = HashMap.lookup (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) oidCache-                      oid = if dimensionality == 0 then maybe 0 Vocab.TypeInfo.toBaseOid typeInfo else maybe 0 Vocab.TypeInfo.toArrayOid typeInfo-                   in Binary.field oid (encode oidCache val)-              )-              (\val -> [print val])-  NullableOrNot.Nullable (Value.Value schemaName typeName scalarOid arrayOid dimensionality _ unknownTypes encode print) ->-    let staticOid = if dimensionality == 0 then scalarOid else arrayOid-     in case staticOid of-          Just oid ->-            Composite-              unknownTypes-              ( \oidCache -> \case-                  Nothing -> Binary.nullField oid-                  Just val -> Binary.field oid (encode oidCache val)-              )-              ( \case-                  Nothing -> ["NULL"]-                  Just val -> [print val]-              )-          Nothing ->-            Composite-              (HashSet.insert (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes)-              ( \oidCache -> \case-                  Nothing ->-                    let typeInfo = HashMap.lookup (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) oidCache-                        oid = if dimensionality == 0 then maybe 0 Vocab.TypeInfo.toBaseOid typeInfo else maybe 0 Vocab.TypeInfo.toArrayOid typeInfo-                     in Binary.nullField oid-                  Just val ->-                    let typeInfo = HashMap.lookup (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) oidCache-                        oid = if dimensionality == 0 then maybe 0 Vocab.TypeInfo.toBaseOid typeInfo else maybe 0 Vocab.TypeInfo.toArrayOid typeInfo-                     in Binary.field oid (encode oidCache val)-              )-              ( \case-                  Nothing -> ["NULL"]-                  Just val -> [print val]-              )
− src/library/Hasql/Codecs/Encoders/NullableOrNot.hs 
@@ -1,19 +0,0 @@-module Hasql.Codecs.Encoders.NullableOrNot where--import Hasql.Platform.Prelude---- |--- 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
− src/library/Hasql/Codecs/Encoders/Params.hs 
@@ -1,198 +0,0 @@-module Hasql.Codecs.Encoders.Params-  ( Params,-    noParams,-    param,-    toColumnsMetadata,-    toUnknownTypes,-    toSerializer,-    toPrinter,-  )-where--import Data.HashSet qualified as HashSet-import Data.Vector qualified as Vector-import Hasql.Codecs.Encoders.NullableOrNot qualified as NullableOrNot-import Hasql.Codecs.Encoders.Value qualified as Value-import Hasql.Codecs.Vocab qualified as Vocab-import Hasql.Codecs.Vocab.OidCache qualified as Vocab.OidCache-import Hasql.Codecs.Vocab.ParamMeta (ParamMeta (..))-import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName-import Hasql.Codecs.Vocab.TypeRef qualified as Vocab.TypeRef-import Hasql.Platform.Prelude-import PostgreSQL.Binary.Encoding qualified as Binary-import TextBuilder qualified---- | Frozen per-parameter metadata: type reference, dimensionality, text-format flag.-toColumnsMetadata :: Params a -> Vector ParamMeta-toColumnsMetadata (Params _ _ columnsMetadata _ _) = freezeColumnsMetadata columnsMetadata-  where-    freezeColumnsMetadata =-      Vector.fromList . toList--toUnknownTypes :: Params a -> HashSet Vocab.QualifiedTypeName-toUnknownTypes (Params _ unknownTypes _ _ _) =-  unknownTypes---- | Serialise params to encoded wire values given a resolved OID cache.-toSerializer :: Params a -> Vocab.OidCache -> a -> [Maybe ByteString]-toSerializer (Params _ _ _ serializer _) = serializer---- | Render params in human-readable form (for error reporting).-toPrinter :: Params a -> a -> [Text]-toPrinter (Params _ _ _ _ printer) = toList . printer---- |--- 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.Value' Gender--- genderValue = 'enum' Nothing (Just "gender") genderText where---   genderText gender = case gender of---     Male -> "male"---     Female -> "female"--- @-data Params a = Params-  { size :: Int,-    unknownTypes :: HashSet Vocab.QualifiedTypeName,-    -- | (Type reference, dimensionality, Text Format) for each parameter.-    columnsMetadata :: DList ParamMeta,-    serializer :: Vocab.OidCache -> a -> [Maybe ByteString],-    printer :: a -> DList Text-  }--instance Contravariant Params where-  contramap fn (Params size unknownTypes columnsMetadata oldSerializer oldPrinter) = Params {..}-    where-      serializer oidCache = oldSerializer oidCache . fn-      printer = oldPrinter . fn--instance Divisible Params where-  divide-    divisor-    (Params leftSize leftUnknownTypes leftColumnsMetadata leftSerializer leftPrinter)-    (Params rightSize rightUnknownTypes rightColumnsMetadata rightSerializer rightPrinter) =-      Params-        { size = leftSize + rightSize,-          unknownTypes = leftUnknownTypes <> rightUnknownTypes,-          columnsMetadata = leftColumnsMetadata <> rightColumnsMetadata,-          serializer = \oidCache input -> case divisor input of-            (leftInput, rightInput) -> leftSerializer oidCache leftInput <> rightSerializer oidCache rightInput,-          printer = \input -> case divisor input of-            (leftInput, rightInput) -> leftPrinter leftInput <> rightPrinter rightInput-        }-  conquer =-    Params-      { size = 0,-        unknownTypes = mempty,-        columnsMetadata = mempty,-        serializer = mempty,-        printer = mempty-      }--instance Semigroup (Params a) where-  Params leftSize leftUnknownTypes leftColumnsMetadata leftSerializer leftPrinter <> Params rightSize rightUnknownTypes rightColumnsMetadata rightSerializer rightPrinter =-    Params-      { size = leftSize + rightSize,-        unknownTypes = leftUnknownTypes <> rightUnknownTypes,-        columnsMetadata = leftColumnsMetadata <> rightColumnsMetadata,-        serializer = \oidCache input -> leftSerializer oidCache input <> rightSerializer oidCache input,-        printer = \input -> leftPrinter input <> rightPrinter input-      }--instance Monoid (Params a) where-  mempty = conquer--value :: Value.Value a -> Params a-value (Value.Value schemaName typeName scalarOid arrayOid dimensionality textFormat unknownTypes serialize print) =-  let staticOid = if dimensionality == 0 then scalarOid else arrayOid-      serializer oidCache = pure . Just . Binary.encodingBytes . serialize (Vocab.OidCache.toHashMap oidCache)-      printer = pure . TextBuilder.toText . print-      size = 1-   in case staticOid of-        Just oid ->-          Params-            { size,-              unknownTypes,-              columnsMetadata = pure (ParamMeta (Vocab.TypeRef.KnownOid oid) dimensionality textFormat),-              serializer,-              printer-            }-        Nothing ->-          Params-            { size,-              unknownTypes = HashSet.insert (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes,-              columnsMetadata = pure (ParamMeta (Vocab.TypeRef.NamedType (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName)) dimensionality textFormat),-              serializer,-              printer-            }--nullableValue :: Value.Value a -> Params (Maybe a)-nullableValue (Value.Value schemaName typeName scalarOid arrayOid dimensionality textFormat unknownTypes serialize print) =-  let staticOid = if dimensionality == 0 then scalarOid else arrayOid-      serializer oidCache = pure . fmap (Binary.encodingBytes . serialize (Vocab.OidCache.toHashMap oidCache))-      printer = pure . maybe "null" (TextBuilder.toText . print)-      size = 1-   in case staticOid of-        Just oid ->-          Params-            { size,-              unknownTypes,-              columnsMetadata = pure (ParamMeta (Vocab.TypeRef.KnownOid oid) dimensionality textFormat),-              serializer,-              printer-            }-        Nothing ->-          Params-            { size,-              unknownTypes = HashSet.insert (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes,-              columnsMetadata = pure (ParamMeta (Vocab.TypeRef.NamedType (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName)) dimensionality textFormat),-              serializer,-              printer-            }---- |--- 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.NullableOrNot Value.Value a -> Params a-param = \case-  NullableOrNot.NonNullable valueEnc -> value valueEnc-  NullableOrNot.Nullable valueEnc -> nullableValue valueEnc
− src/library/Hasql/Codecs/Encoders/Value.hs 
@@ -1,456 +0,0 @@-module Hasql.Codecs.Encoders.Value where--import ByteString.StrictBuilder qualified-import Data.Aeson qualified as Aeson-import Data.ByteString.Lazy qualified as LazyByteString-import Data.HashMap.Strict qualified as HashMap-import Data.HashSet qualified as HashSet-import Data.IP qualified as Iproute-import Hasql.Codecs.Vocab qualified as Vocab-import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName-import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo-import Hasql.Platform.Prelude-import PostgreSQL.Binary.Encoding qualified as Binary-import PostgreSQL.Binary.Range qualified as Range-import TextBuilder qualified as TextBuilder---- |--- Value encoder.-data Value a-  = Value-      -- | Schema name, if any.-      (Maybe Text)-      -- | Type name.-      Text-      -- | Statically known OID for the type.-      -- When unspecified, the OID may be determined at runtime by looking up by name.-      (Maybe Word32)-      -- | Statically known OID for the array-type with this type as the element.-      -- When unspecified, the OID may be determined at runtime by looking up by name.-      -- It may also mean that there may be no array type containing this type, which is the case in attempts to double-nest arrays.-      (Maybe Word32)-      -- | Dimensionality. If 0 then it is not an array, but a scalar value.-      Word-      -- | Text format?-      Bool-      -- | Names of types that are not known statically and must be looked up at runtime collected from the nested composite and array encoders.-      (HashSet Vocab.QualifiedTypeName)-      -- | Serialization function on the resolved OIDs.-      (HashMap Vocab.QualifiedTypeName Vocab.TypeInfo.TypeInfo -> a -> Binary.Encoding)-      -- | Render function for error messages.-      (a -> TextBuilder.TextBuilder)--instance Contravariant Value where-  {-# INLINE contramap #-}-  contramap f (Value schemaName typeName valueOid arrayOid dimensionality textFormat unknownTypes encode render) =-    Value schemaName typeName valueOid arrayOid dimensionality textFormat unknownTypes (\hashMap -> encode hashMap . f) (render . f)--{-# INLINE primitive #-}-primitive :: Text -> Bool -> Vocab.TypeInfo.TypeInfo -> (a -> Binary.Encoding) -> (a -> TextBuilder.TextBuilder) -> Value a-primitive typeName isText typeInfo encode render =-  Value-    Nothing-    typeName-    (Just (Vocab.TypeInfo.toBaseOid typeInfo))-    (Just (Vocab.TypeInfo.toArrayOid typeInfo))-    0-    isText-    HashSet.empty-    (const encode)-    render---- |--- Encoder of @BOOL@ values.-{-# INLINEABLE bool #-}-bool :: Value Bool-bool = primitive "bool" False Vocab.TypeInfo.bool Binary.bool (TextBuilder.string . show)---- |--- Encoder of @INT2@ values.-{-# INLINEABLE int2 #-}-int2 :: Value Int16-int2 = primitive "int2" False Vocab.TypeInfo.int2 Binary.int2_int16 (TextBuilder.string . show)---- |--- Encoder of @INT4@ values.-{-# INLINEABLE int4 #-}-int4 :: Value Int32-int4 = primitive "int4" False Vocab.TypeInfo.int4 Binary.int4_int32 (TextBuilder.string . show)---- |--- Encoder of @INT8@ values.-{-# INLINEABLE int8 #-}-int8 :: Value Int64-int8 = primitive "int8" False Vocab.TypeInfo.int8 Binary.int8_int64 (TextBuilder.string . show)---- |--- Encoder of @FLOAT4@ values.-{-# INLINEABLE float4 #-}-float4 :: Value Float-float4 = primitive "float4" False Vocab.TypeInfo.float4 Binary.float4 (TextBuilder.string . show)---- |--- Encoder of @FLOAT8@ values.-{-# INLINEABLE float8 #-}-float8 :: Value Double-float8 = primitive "float8" False Vocab.TypeInfo.float8 Binary.float8 (TextBuilder.string . show)---- |--- Encoder of @NUMERIC@ values.-{-# INLINEABLE numeric #-}-numeric :: Value Scientific-numeric = primitive "numeric" False Vocab.TypeInfo.numeric Binary.numeric (TextBuilder.string . show)---- |--- Encoder of @CHAR@ values.------ Note that it supports Unicode values and--- identifies itself under the @TEXT@ OID because of that.-{-# INLINEABLE char #-}-char :: Value Char-char = primitive "char" False Vocab.TypeInfo.text Binary.char_utf8 (TextBuilder.string . show)---- |--- Encoder of @TEXT@ values.-{-# INLINEABLE text #-}-text :: Value Text-text = primitive "text" False Vocab.TypeInfo.text Binary.text_strict (TextBuilder.string . show)---- |--- Encoder of @VARCHAR@ values.-{-# INLINEABLE varchar #-}-varchar :: Value Text-varchar = primitive "varchar" False Vocab.TypeInfo.varchar Binary.text_strict (TextBuilder.string . show)---- |--- Encoder of @BPCHAR@ or @CHAR(n)@, @CHARACTER(n)@ values.-{-# INLINEABLE bpchar #-}-bpchar :: Value Text-bpchar = primitive "bpchar" False Vocab.TypeInfo.bpchar Binary.text_strict (TextBuilder.string . show)---- |--- Encoder of @BYTEA@ values.-{-# INLINEABLE bytea #-}-bytea :: Value ByteString-bytea = primitive "bytea" False Vocab.TypeInfo.bytea Binary.bytea_strict (TextBuilder.string . show)---- |--- Encoder of @DATE@ values.-{-# INLINEABLE date #-}-date :: Value Day-date = primitive "date" False Vocab.TypeInfo.date Binary.date (TextBuilder.string . show)---- |--- Encoder of @TIMESTAMP@ values.-{-# INLINEABLE timestamp #-}-timestamp :: Value LocalTime-timestamp = primitive "timestamp" False Vocab.TypeInfo.timestamp Binary.timestamp_int (TextBuilder.string . show)---- |--- Encoder of @TIMESTAMPTZ@ values.-{-# INLINEABLE timestamptz #-}-timestamptz :: Value UTCTime-timestamptz = primitive "timestamptz" False Vocab.TypeInfo.timestamptz Binary.timestamptz_int (TextBuilder.string . show)---- |--- Encoder of @TIME@ values.-{-# INLINEABLE time #-}-time :: Value TimeOfDay-time = primitive "time" False Vocab.TypeInfo.time Binary.time_int (TextBuilder.string . show)---- |--- Encoder of @TIMETZ@ values.-{-# INLINEABLE timetz #-}-timetz :: Value (TimeOfDay, TimeZone)-timetz = primitive "timetz" False Vocab.TypeInfo.timetz Binary.timetz_int (TextBuilder.string . show)---- |--- Encoder of @INTERVAL@ values.-{-# INLINEABLE interval #-}-interval :: Value DiffTime-interval = primitive "interval" False Vocab.TypeInfo.interval Binary.interval_int (TextBuilder.string . show)---- |--- Encoder of @UUID@ values.-{-# INLINEABLE uuid #-}-uuid :: Value UUID-uuid = primitive "uuid" False Vocab.TypeInfo.uuid Binary.uuid (TextBuilder.string . show)---- |--- Encoder of @INET@ values.-{-# INLINEABLE inet #-}-inet :: Value Iproute.IPRange-inet = primitive "inet" False Vocab.TypeInfo.inet Binary.inet (TextBuilder.string . show)---- |--- Encoder of @MACADDR@ values.------ Represented as a 6-tuple of Word8 values in big endian order. If--- you use `ip` library you can convert using its `toOctets`.------ > toOctets >$< macaddr-{-# INLINEABLE macaddr #-}-macaddr :: Value (Word8, Word8, Word8, Word8, Word8, Word8)-macaddr = primitive "macaddr" False Vocab.TypeInfo.macaddr Binary.macaddr (TextBuilder.string . show)---- |--- Encoder of @JSON@ values from JSON AST.-{-# INLINEABLE json #-}-json :: Value Aeson.Value-json = primitive "json" False Vocab.TypeInfo.json Binary.json_ast (TextBuilder.string . show)---- |--- Encoder of @JSON@ values from raw JSON.-{-# INLINEABLE jsonBytes #-}-jsonBytes :: Value ByteString-jsonBytes = primitive "json" False Vocab.TypeInfo.json Binary.json_bytes (TextBuilder.string . show)---- |--- Encoder of @JSON@ values from raw JSON as lazy ByteString.-{-# INLINEABLE jsonLazyBytes #-}-jsonLazyBytes :: Value LazyByteString.ByteString-jsonLazyBytes = primitive "json" False Vocab.TypeInfo.json Binary.json_bytes_lazy (TextBuilder.string . show)---- |--- Encoder of @JSONB@ values from JSON AST.-{-# INLINEABLE jsonb #-}-jsonb :: Value Aeson.Value-jsonb = primitive "jsonb" False Vocab.TypeInfo.jsonb Binary.jsonb_ast (TextBuilder.string . show)---- |--- Encoder of @JSONB@ values from raw JSON.-{-# INLINEABLE jsonbBytes #-}-jsonbBytes :: Value ByteString-jsonbBytes = primitive "jsonb" False Vocab.TypeInfo.jsonb Binary.jsonb_bytes (TextBuilder.string . show)---- |--- Encoder of @JSONB@ values from raw JSON as lazy ByteString.-{-# INLINEABLE jsonbLazyBytes #-}-jsonbLazyBytes :: Value LazyByteString.ByteString-jsonbLazyBytes = primitive "jsonb" False Vocab.TypeInfo.jsonb Binary.jsonb_bytes_lazy (TextBuilder.string . show)---- |--- Encoder of @OID@ values.-{-# INLINEABLE oid #-}-oid :: Value Int32-oid = primitive "oid" False Vocab.TypeInfo.oid Binary.int4_int32 (TextBuilder.string . show)---- |--- Encoder of @NAME@ values.-{-# INLINEABLE name #-}-name :: Value Text-name = primitive "name" False Vocab.TypeInfo.name Binary.text_strict (TextBuilder.string . show)---- |--- Encoder of @INT4RANGE@ values.-{-# INLINEABLE int4range #-}-int4range :: Value (Range.Range Int32)-int4range = primitive "int4range" False Vocab.TypeInfo.int4range Binary.int4range (TextBuilder.string . show)---- |--- Encoder of @INT8RANGE@ values.-{-# INLINEABLE int8range #-}-int8range :: Value (Range.Range Int64)-int8range = primitive "int8range" False Vocab.TypeInfo.int8range Binary.int8range (TextBuilder.string . show)---- |--- Encoder of @NUMRANGE@ values.-{-# INLINEABLE numrange #-}-numrange :: Value (Range.Range Scientific)-numrange = primitive "numrange" False Vocab.TypeInfo.numrange Binary.numrange (TextBuilder.string . show)---- |--- Encoder of @TSRANGE@ values.-{-# INLINEABLE tsrange #-}-tsrange :: Value (Range.Range LocalTime)-tsrange = primitive "tsrange" False Vocab.TypeInfo.tsrange Binary.tsrange_int (TextBuilder.string . show)---- |--- Encoder of @TSTZRANGE@ values.-{-# INLINEABLE tstzrange #-}-tstzrange :: Value (Range.Range UTCTime)-tstzrange = primitive "tstzrange" False Vocab.TypeInfo.tstzrange Binary.tstzrange_int (TextBuilder.string . show)---- |--- Encoder of @DATERANGE@ values.-{-# INLINEABLE daterange #-}-daterange :: Value (Range.Range Day)-daterange = primitive "daterange" False Vocab.TypeInfo.daterange Binary.daterange (TextBuilder.string . show)---- |--- Encoder of @INT4MULTIRANGE@ values.-{-# INLINEABLE int4multirange #-}-int4multirange :: Value (Range.Multirange Int32)-int4multirange = primitive "int4multirange" False Vocab.TypeInfo.int4multirange Binary.int4multirange (TextBuilder.string . show)---- |--- Encoder of @INT8MULTIRANGE@ values.-{-# INLINEABLE int8multirange #-}-int8multirange :: Value (Range.Multirange Int64)-int8multirange = primitive "int8multirange" False Vocab.TypeInfo.int8multirange Binary.int8multirange (TextBuilder.string . show)---- |--- Encoder of @NUMMULTIRANGE@ values.-{-# INLINEABLE nummultirange #-}-nummultirange :: Value (Range.Multirange Scientific)-nummultirange = primitive "nummultirange" False Vocab.TypeInfo.nummultirange Binary.nummultirange (TextBuilder.string . show)---- |--- Encoder of @TSMULTIRANGE@ values.-{-# INLINEABLE tsmultirange #-}-tsmultirange :: Value (Range.Multirange LocalTime)-tsmultirange = primitive "tsmultirange" False Vocab.TypeInfo.tsmultirange Binary.tsmultirange_int (TextBuilder.string . show)---- |--- Encoder of @TSTZMULTIRANGE@ values.-{-# INLINEABLE tstzmultirange #-}-tstzmultirange :: Value (Range.Multirange UTCTime)-tstzmultirange = primitive "tstzmultirange" False Vocab.TypeInfo.tstzmultirange Binary.tstzmultirange_int (TextBuilder.string . show)---- |--- Encoder of @DATEMULTIRANGE@ values.-{-# INLINEABLE datemultirange #-}-datemultirange :: Value (Range.Multirange Day)-datemultirange = primitive "datemultirange" False Vocab.TypeInfo.datemultirange Binary.datemultirange (TextBuilder.string . show)---- |--- Encoder of @CITEXT@ values.------ Requires the @citext@ extension to be installed in the database.-{-# INLINEABLE citext #-}-citext :: Value Text-citext =-  Value-    Nothing-    "citext"-    Nothing-    Nothing-    0-    False-    HashSet.empty-    (const Binary.text_strict)-    (TextBuilder.string . show)---- |--- Given a function which maps a value into a textual enum label used on the DB side,--- produces an encoder of that value for a named enum type.-{-# INLINEABLE enum #-}-enum ::-  -- | Schema name where the enum type is defined.-  Maybe Text ->-  -- | Enum type name.-  Text ->-  -- | Mapping function from value to enum label.-  (a -> Text) ->-  Value a-enum schemaName typeName mapping =-  Value-    schemaName-    typeName-    Nothing-    Nothing-    0-    False-    (HashSet.singleton (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName))-    (const (Binary.text_strict . mapping))-    (TextBuilder.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 transmitted 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.------ __Warning:__ Do not use this as part of composite encoders like 'array' since--- it is the only encoder that doesn't use the binary format.-{-# DEPRECATED unknown "Use 'custom' instead." #-}-{-# INLINEABLE unknown #-}-unknown :: Value ByteString-unknown = primitive "unknown" True Vocab.TypeInfo.unknown Binary.bytea_strict (TextBuilder.string . show)---- |--- Low level API for defining custom value encoders.-{-# INLINEABLE custom #-}-custom ::-  -- | Schema name where the type is defined.-  Maybe Text ->-  -- | Type name.-  Text ->-  -- | Possible static OIDs for the type. The first is for scalar values the second is for arrays.-  ---  -- When unspecified, the OIDs will be automatically determined at runtime by looking up by name.-  Maybe (Word32, Word32) ->-  -- | Other named types whose OIDs are needed for serializing.-  ---  -- E.g., when encoding composite types Postgres requires specifying OIDs of all of its fields.-  ---  -- When any of the requested types is missing in the database an error will be raised upon the statement execution.-  [(Maybe Text, Text)] ->-  -- | Serialization function in the context of resolved OIDs of the types requested in the previous parameter.-  ---  -- It's safe to assume that all of the requested types will be present.-  -- In case you run the provided lookup function with unmentioned type names it will produce OID of 0 for them, standing for unknown type in Postgres.-  ( ((Maybe Text, Text) -> (Word32, Word32)) ->-    a ->-    ByteString-  ) ->-  -- | Render function for error messages.-  (a -> Text) ->-  Value a-custom schemaName typeName staticOids requiredTypes encode render =-  Value-    schemaName-    typeName-    (fmap fst staticOids)-    (fmap snd staticOids)-    0-    False-    (HashSet.fromList (fmap Vocab.QualifiedTypeName.fromNameTuple requiredTypes))-    ( \hashMap ->-        ByteString.StrictBuilder.bytes-          . encode-            ( \name ->-                fromMaybe (0, 0)-                  $ HashMap.lookup (Vocab.QualifiedTypeName.fromNameTuple name) hashMap-                  <&> \typeInfo -> (Vocab.TypeInfo.toBaseOid typeInfo, Vocab.TypeInfo.toArrayOid typeInfo)-            )-    )-    (TextBuilder.text . render)---- |--- Encoder of @HSTORE@ values from a foldable container of key-value pairs.------ The value part can be @Nothing@ to represent a NULL value in the hstore.-{-# INLINEABLE hstore #-}-hstore :: (Foldable foldable) => Value (foldable (Text, Maybe Text))-hstore =-  Value-    Nothing-    "hstore"-    Nothing-    Nothing-    0-    False-    HashSet.empty-    (const Binary.hStore_foldable)-    renderHstore-  where-    renderHstore items =-      mconcat-        [ TextBuilder.text "hstore(",-          TextBuilder.intercalate ", " (foldMap (\pair -> [renderPair pair]) items),-          TextBuilder.text ")"-        ]-    renderPair (key, maybeValue) =-      mconcat-        [ TextBuilder.text "(",-          TextBuilder.string (show key),-          TextBuilder.text ", ",-          case maybeValue of-            Nothing -> TextBuilder.text "NULL"-            Just value -> TextBuilder.string (show value),-          TextBuilder.text ")"-        ]
− src/library/Hasql/Codecs/RequestingOid.hs 
@@ -1,67 +0,0 @@-module Hasql.Codecs.RequestingOid-  ( RequestingOid,-    toUnknownTypes,-    toBase,-    requestAndHandle,-    lift,-    hoist,-    lookup,-    lookingUp,-    hoistLookingUp,-  )-where--import Hasql.Codecs.RequestingOid.LookingUp qualified as LookingUp-import Hasql.Codecs.Vocab qualified as Vocab-import Hasql.Codecs.Vocab.OidCache qualified as Vocab.OidCache-import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo-import Hasql.Platform.Prelude hiding (lift, lookup)--type RequestingOid =-  LookingUp.LookingUp-    Vocab.QualifiedTypeName-    Vocab.TypeInfo.TypeInfo--{-# INLINE toUnknownTypes #-}-toUnknownTypes ::-  RequestingOid a ->-  HashSet Vocab.QualifiedTypeName-toUnknownTypes (LookingUp.LookingUp unknownTypes _) =-  fromList unknownTypes--{-# INLINE toBase #-}-toBase ::-  RequestingOid a ->-  Vocab.OidCache ->-  a-toBase (LookingUp.LookingUp _unknownTypes decoder) oidCache =-  decoder \key ->-    Vocab.OidCache.lookupTypeInfo key oidCache-      & fromMaybe (Vocab.TypeInfo.TypeInfo 0 0)--{-# INLINE requestAndHandle #-}-requestAndHandle ::-  [Vocab.QualifiedTypeName] ->-  ((Vocab.QualifiedTypeName -> Vocab.TypeInfo.TypeInfo) -> a) ->-  RequestingOid a-requestAndHandle keys fn = LookingUp.LookingUp keys fn--{-# INLINE lift #-}-lift :: a -> RequestingOid a-lift = LookingUp.lift--{-# INLINE hoist #-}-hoist :: (a -> b) -> RequestingOid a -> RequestingOid b-hoist fn (LookingUp.LookingUp keys use) = LookingUp.LookingUp keys (fn . use)--{-# INLINE lookup #-}-lookup :: Vocab.QualifiedTypeName -> RequestingOid Vocab.TypeInfo.TypeInfo-lookup = LookingUp.lookup--{-# INLINE lookingUp #-}-lookingUp :: Vocab.QualifiedTypeName -> (Vocab.TypeInfo.TypeInfo -> a) -> RequestingOid a-lookingUp = LookingUp.lookingUp--{-# INLINE hoistLookingUp #-}-hoistLookingUp :: Vocab.QualifiedTypeName -> (Vocab.TypeInfo.TypeInfo -> a -> b) -> RequestingOid a -> RequestingOid b-hoistLookingUp = LookingUp.hoistLookingUp
− src/library/Hasql/Codecs/RequestingOid/LookingUp.hs 
@@ -1,45 +0,0 @@-module Hasql.Codecs.RequestingOid.LookingUp where--import Control.Applicative-import Prelude--data LookingUp k v a-  = LookingUp-      -- | Keys requested to be available for lookup.-      [k]-      -- | Continuation that looks up values by keys.-      ((k -> v) -> a)--type role LookingUp _ _ representational--deriving stock instance Functor (LookingUp k v)--instance Applicative (LookingUp k v) where-  {-# INLINE pure #-}-  pure a =-    LookingUp [] (\_ -> a)-  {-# INLINE (<*>) #-}-  LookingUp lKeys lUse <*> LookingUp rKeys rUse =-    LookingUp-      (lKeys <> rKeys)-      (\lookup -> lUse lookup (rUse lookup))--{-# INLINE lookup #-}-lookup :: k -> LookingUp k v v-lookup key =-  LookingUp [key] (\lookupFn -> lookupFn key)--{-# INLINE lift #-}-lift :: a -> LookingUp k v a-lift fa =-  LookingUp [] (const fa)--{-# INLINE lookingUp #-}-lookingUp :: k -> (v -> a) -> LookingUp k v a-lookingUp key cont =-  LookingUp [key] (\lookupFn -> cont (lookupFn key))--{-# INLINE hoistLookingUp #-}-hoistLookingUp :: k -> (v -> a -> b) -> LookingUp k v a -> LookingUp k v b-hoistLookingUp k tx (LookingUp keys use) =-  LookingUp (k : keys) (\lookupFn -> tx (lookupFn k) (use lookupFn))
− src/library/Hasql/Codecs/Vocab.hs 
@@ -1,14 +0,0 @@-module Hasql.Codecs.Vocab-  ( QualifiedTypeName,-    TypeInfo,-    TypeRef,-    ParamMeta,-    OidCache,-  )-where--import Hasql.Codecs.Vocab.OidCache (OidCache)-import Hasql.Codecs.Vocab.ParamMeta (ParamMeta)-import Hasql.Codecs.Vocab.QualifiedTypeName (QualifiedTypeName)-import Hasql.Codecs.Vocab.TypeInfo (TypeInfo)-import Hasql.Codecs.Vocab.TypeRef (TypeRef)
− src/library/Hasql/Codecs/Vocab/OidCache.hs 
@@ -1,91 +0,0 @@-module Hasql.Codecs.Vocab.OidCache-  ( OidCache,--    -- * Accessors-    toHashMap,-    lookupScalar,-    lookupArray,-    lookupTypeNameScalar,-    lookupTypeNameArray,-    lookupTypeInfo,--    -- * Constructors-    fromHashMap,-    empty,-    selectUnknownNames,-    insertScalar,-  )-where--import Data.HashMap.Strict qualified as HashMap-import Data.HashSet qualified as HashSet-import Hasql.Codecs.Vocab.QualifiedTypeName (QualifiedTypeName)-import Hasql.Codecs.Vocab.QualifiedTypeName qualified as QualifiedTypeName-import Hasql.Codecs.Vocab.TypeInfo qualified as TypeInfo-import Hasql.Platform.Prelude hiding (empty, insert, lookup, reset)---- | Pure registry state containing the hash map and counter-newtype OidCache-  = OidCache-      -- | By name of the type.-      ---      -- > scalar name -> TypeInfo (scalar OID, array OID)-      (HashMap QualifiedTypeName TypeInfo.TypeInfo)-  deriving stock (Show, Eq)--instance Semigroup OidCache where-  OidCache byNameL <> OidCache byNameR =-    OidCache (HashMap.union byNameR byNameL)--instance Monoid OidCache where-  mempty = OidCache mempty--{-# INLINEABLE empty #-}-empty :: OidCache-empty =-  OidCache HashMap.empty---- | Having a set of required type names, select those that are not present in the cache.-{-# INLINE selectUnknownNames #-}-selectUnknownNames :: HashSet QualifiedTypeName -> OidCache -> HashSet QualifiedTypeName-selectUnknownNames keys (OidCache byName) =-  HashSet.filter (\key -> not (HashMap.member key byName)) keys--insertScalar :: Maybe Text -> Text -> Word32 -> Word32 -> OidCache -> OidCache-insertScalar schema name scalar array (OidCache byName) =-  OidCache (HashMap.insert (QualifiedTypeName.QualifiedTypeName schema name) (TypeInfo.TypeInfo scalar array) byName)--{-# INLINE fromHashMap #-}-fromHashMap :: HashMap QualifiedTypeName TypeInfo.TypeInfo -> OidCache-fromHashMap byName = OidCache byName---- * Accessors--{-# INLINE lookupScalar #-}-lookupScalar :: Maybe Text -> Text -> OidCache -> Maybe Word32-lookupScalar schema name (OidCache byName) =-  HashMap.lookup (QualifiedTypeName.QualifiedTypeName schema name) byName <&> \info -> TypeInfo.toBaseOid info--{-# INLINE lookupArray #-}-lookupArray :: Maybe Text -> Text -> OidCache -> Maybe Word32-lookupArray schema name (OidCache byName) =-  HashMap.lookup (QualifiedTypeName.QualifiedTypeName schema name) byName <&> \info -> TypeInfo.toArrayOid info--{-# INLINE lookupTypeNameScalar #-}-lookupTypeNameScalar :: QualifiedTypeName -> OidCache -> Maybe Word32-lookupTypeNameScalar name (OidCache byName) =-  HashMap.lookup name byName <&> TypeInfo.toBaseOid--{-# INLINE lookupTypeNameArray #-}-lookupTypeNameArray :: QualifiedTypeName -> OidCache -> Maybe Word32-lookupTypeNameArray name (OidCache byName) =-  HashMap.lookup name byName <&> TypeInfo.toArrayOid--{-# INLINE lookupTypeInfo #-}-lookupTypeInfo :: QualifiedTypeName -> OidCache -> Maybe TypeInfo.TypeInfo-lookupTypeInfo name (OidCache byName) =-  HashMap.lookup name byName--{-# INLINE toHashMap #-}-toHashMap :: OidCache -> HashMap QualifiedTypeName TypeInfo.TypeInfo-toHashMap (OidCache byName) = byName
− src/library/Hasql/Codecs/Vocab/ParamMeta.hs 
@@ -1,13 +0,0 @@-module Hasql.Codecs.Vocab.ParamMeta-  ( ParamMeta (..),-  )-where--import Hasql.Codecs.Vocab.TypeRef (TypeRef)-import Hasql.Platform.Prelude---- | Per-parameter metadata: type reference, array dimensionality, text-format flag.-data ParamMeta = ParamMeta TypeRef Word Bool-  deriving stock (Eq, Ord, Show, Generic)--instance Hashable ParamMeta
− src/library/Hasql/Codecs/Vocab/QualifiedTypeName.hs 
@@ -1,43 +0,0 @@-module Hasql.Codecs.Vocab.QualifiedTypeName-  ( QualifiedTypeName (..),-    fromNameTuple,-    toNameTuple,-  )-where--import Hasql.Platform.Prelude---- |--- A Postgres type identified by name: an optional schema together with a--- required type name.------ A 'Nothing' schema means the name is unqualified and is resolved via the--- server's search path.------ Used as the key under which a type's OIDs are resolved and cached.-data QualifiedTypeName = QualifiedTypeName-  { schema :: Maybe Text,-    name :: Text-  }-  deriving stock (Eq, Ord, Show, Generic)--instance Hashable QualifiedTypeName---- | An unqualified name constructor for convenience.-instance IsString QualifiedTypeName where-  fromString = QualifiedTypeName Nothing . fromString---- |--- Convert from the legacy @(schema, name)@ tuple representation.------ Used at public-API boundaries (e.g. the @custom@ codecs and error types)--- where the tuple is still exposed but internals operate on 'QualifiedTypeName'.-fromNameTuple :: (Maybe Text, Text) -> QualifiedTypeName-fromNameTuple (schema, name) = QualifiedTypeName schema name---- |--- Convert to the legacy @(schema, name)@ tuple representation.------ See 'fromNameTuple'.-toNameTuple :: QualifiedTypeName -> (Maybe Text, Text)-toNameTuple (QualifiedTypeName schema name) = (schema, name)
− src/library/Hasql/Codecs/Vocab/TypeInfo.hs 
@@ -1,230 +0,0 @@-module Hasql.Codecs.Vocab.TypeInfo where--import Hasql.Platform.Prelude hiding (bool)---- | A Postgresql type info-data TypeInfo-  = TypeInfo {toBaseOid :: Word32, toArrayOid :: Word32}-  deriving (Eq, Ord, Show)--abstime :: TypeInfo-abstime = TypeInfo 702 1023--aclitem :: TypeInfo-aclitem = TypeInfo 1033 1034--bit :: TypeInfo-bit = TypeInfo 1560 1561--bool :: TypeInfo-bool = TypeInfo 16 1000--box :: TypeInfo-box = TypeInfo 603 1020--bpchar :: TypeInfo-bpchar = TypeInfo 1042 1014--bytea :: TypeInfo-bytea = TypeInfo 17 1001--char :: TypeInfo-char = TypeInfo 18 1002--cid :: TypeInfo-cid = TypeInfo 29 1012--cidr :: TypeInfo-cidr = TypeInfo 650 651--circle :: TypeInfo-circle = TypeInfo 718 719--cstring :: TypeInfo-cstring = TypeInfo 2275 1263--date :: TypeInfo-date = TypeInfo 1082 1182--daterange :: TypeInfo-daterange = TypeInfo 3912 3913--datemultirange :: TypeInfo-datemultirange = TypeInfo 4535 6155--float4 :: TypeInfo-float4 = TypeInfo 700 1021--float8 :: TypeInfo-float8 = TypeInfo 701 1022--gtsvector :: TypeInfo-gtsvector = TypeInfo 3642 3644--inet :: TypeInfo-inet = TypeInfo 869 1041--int2 :: TypeInfo-int2 = TypeInfo 21 1005--int2vector :: TypeInfo-int2vector = TypeInfo 22 1006--int4 :: TypeInfo-int4 = TypeInfo 23 1007--int4range :: TypeInfo-int4range = TypeInfo 3904 3905--int4multirange :: TypeInfo-int4multirange = TypeInfo 4451 6150--int8 :: TypeInfo-int8 = TypeInfo 20 1016--int8range :: TypeInfo-int8range = TypeInfo 3926 3927--int8multirange :: TypeInfo-int8multirange = TypeInfo 4536 6157--interval :: TypeInfo-interval = TypeInfo 1186 1187--json :: TypeInfo-json = TypeInfo 114 199--jsonb :: TypeInfo-jsonb = TypeInfo 3802 3807--line :: TypeInfo-line = TypeInfo 628 629--lseg :: TypeInfo-lseg = TypeInfo 601 1018--macaddr :: TypeInfo-macaddr = TypeInfo 829 1040--money :: TypeInfo-money = TypeInfo 790 791--name :: TypeInfo-name = TypeInfo 19 1003--numeric :: TypeInfo-numeric = TypeInfo 1700 1231--numrange :: TypeInfo-numrange = TypeInfo 3906 3907--nummultirange :: TypeInfo-nummultirange = TypeInfo 4532 6151--oid :: TypeInfo-oid = TypeInfo 26 1028--oidvector :: TypeInfo-oidvector = TypeInfo 30 1013--path :: TypeInfo-path = TypeInfo 602 1019--point :: TypeInfo-point = TypeInfo 600 1017--polygon :: TypeInfo-polygon = TypeInfo 604 1027--record :: TypeInfo-record = TypeInfo 2249 2287--refcursor :: TypeInfo-refcursor = TypeInfo 1790 2201--regclass :: TypeInfo-regclass = TypeInfo 2205 2210--regconfig :: TypeInfo-regconfig = TypeInfo 3734 3735--regdictionary :: TypeInfo-regdictionary = TypeInfo 3769 3770--regoper :: TypeInfo-regoper = TypeInfo 2203 2208--regoperator :: TypeInfo-regoperator = TypeInfo 2204 2209--regproc :: TypeInfo-regproc = TypeInfo 24 1008--regprocedure :: TypeInfo-regprocedure = TypeInfo 2202 2207--regtype :: TypeInfo-regtype = TypeInfo 2206 2211--reltime :: TypeInfo-reltime = TypeInfo 703 1024--text :: TypeInfo-text = TypeInfo 25 1009--tid :: TypeInfo-tid = TypeInfo 27 1010--time :: TypeInfo-time = TypeInfo 1083 1183--timestamp :: TypeInfo-timestamp = TypeInfo 1114 1115--timestamptz :: TypeInfo-timestamptz = TypeInfo 1184 1185--timetz :: TypeInfo-timetz = TypeInfo 1266 1270--tinterval :: TypeInfo-tinterval = TypeInfo 704 1025--tsquery :: TypeInfo-tsquery = TypeInfo 3615 3645--tsrange :: TypeInfo-tsrange = TypeInfo 3908 3909--tsmultirange :: TypeInfo-tsmultirange = TypeInfo 4533 6152--tstzrange :: TypeInfo-tstzrange = TypeInfo 3910 3911--tstzmultirange :: TypeInfo-tstzmultirange = TypeInfo 4534 6153--tsvector :: TypeInfo-tsvector = TypeInfo 3614 3643--txid_snapshot :: TypeInfo-txid_snapshot = TypeInfo 2970 2949--unknown :: TypeInfo-unknown = TypeInfo 705 705--uuid :: TypeInfo-uuid = TypeInfo 2950 2951--varbit :: TypeInfo-varbit = TypeInfo 1562 1563--varchar :: TypeInfo-varchar = TypeInfo 1043 1015--xid :: TypeInfo-xid = TypeInfo 28 1011--xml :: TypeInfo-xml = TypeInfo 142 143
− src/library/Hasql/Codecs/Vocab/TypeRef.hs 
@@ -1,20 +0,0 @@-module Hasql.Codecs.Vocab.TypeRef-  ( TypeRef (..),-  )-where--import Hasql.Codecs.Vocab.QualifiedTypeName (QualifiedTypeName)-import Hasql.Platform.Prelude---- |--- How a parameter's Postgres type is identified within parameter metadata:--- either an already-known OID, or a 'QualifiedTypeName' still pending OID--- resolution against the server.-data TypeRef-  = -- | The type's OID is statically known.-    KnownOid Word32-  | -- | The type is named and its OID must be resolved before execution.-    NamedType QualifiedTypeName-  deriving stock (Eq, Ord, Show, Generic)--instance Hashable TypeRef
− src/library/Hasql/Comms/Recv.hs 
@@ -1,108 +0,0 @@-module Hasql.Comms.Recv-  ( Recv,-    singleResult,-    allResults,-    toHandler,-    Error (..),-  )-where--import Hasql.Comms.ResultDecoder qualified as ResultDecoder-import Hasql.Platform.Prelude-import Hasql.Pq qualified as Pq--newtype Recv context a-  = Recv (Pq.Connection -> IO (Either (Error context) a))-  deriving stock (Functor)--instance Applicative (Recv context) where-  {-# INLINE pure #-}-  pure x = Recv \_ -> pure (Right x)-  {-# INLINE (<*>) #-}-  Recv recv1 <*> Recv recv2 =-    Recv \cs -> do-      ef <- recv1 cs-      eg <- recv2 cs-      pure (ef <*> eg)--instance Bifunctor Recv where-  {-# INLINE bimap #-}-  bimap f g (Recv recv) = Recv (fmap (bimap (fmap f) g) . recv)--toHandler :: Recv context a -> Pq.Connection -> IO (Either (Error context) a)-toHandler (Recv recv) = recv---- | Exactly one result.-singleResult :: context -> ResultDecoder.ResultDecoder a -> Recv context a-singleResult context handler = Recv \connection -> runExceptT do-  result <- ExceptT do-    result <- Pq.getResult connection-    case result of-      Nothing -> do-        errorMessage <- Pq.errorMessage connection-        pure (Left (NoResultsError context errorMessage))-      Just result -> pure (Right result)-  ExceptT do-    result <- Pq.getResult connection-    case result of-      Nothing -> pure (Right result)-      Just _ -> pure (Left (TooManyResultsError context 1))-  result <- ExceptT do-    result <- ResultDecoder.toHandler handler result-    pure (first (ResultError context 0) result)-  pure result---- | Consume all results from a multi-statement query (e.g., scripts).--- Each result is decoded using the provided handler.--- This is useful for scripts that may contain multiple statements,--- where each statement produces a result that needs to be validated.--- All results are consumed even if an error occurs, to leave the connection--- in a clean state.-allResults :: context -> ResultDecoder.ResultDecoder a -> Recv context ()-allResults context handler = Recv \connection -> do-  let loop resultIndex maybeError = do-        result <- Pq.getResult connection-        case result of-          Nothing -> pure maybeError-          Just result -> do-            decodedResult <- ResultDecoder.toHandler handler result-            case decodedResult of-              Left err ->-                -- Continue consuming results even after error to clean up connection-                loop (resultIndex + 1) (Just (ResultError context resultIndex err))-              Right _ ->-                loop (resultIndex + 1) maybeError-  errorOrUnit <- loop 0 Nothing-  pure (maybe (Right ()) Left errorOrUnit)---- * Errors--data Error context-  = ResultError-      context-      -- | Offset of the result in the series.-      Int-      -- | Underlying error.-      ResultDecoder.Error-  | NoResultsError-      context-      -- | Details about the error. Possibly empty.-      (Maybe ByteString)-  | TooManyResultsError-      context-      -- | Expected count.-      Int-  deriving stock (Show, Eq, Functor)--instance Comonad Error where-  {-# INLINE extract #-}-  extract = \case-    ResultError context _ _ -> context-    NoResultsError context _ -> context-    TooManyResultsError context _ -> context--  {-# INLINE duplicate #-}-  duplicate e = case e of-    ResultError _ resultIndex resultError -> ResultError e resultIndex resultError-    NoResultsError _ details -> NoResultsError e details-    TooManyResultsError _ expectedCount -> TooManyResultsError e expectedCount
− src/library/Hasql/Comms/ResultDecoder.hs 
@@ -1,365 +0,0 @@-module Hasql.Comms.ResultDecoder-  ( ResultDecoder,--    -- * Relations-    Handler,-    toHandler,-    fromHandler,--    -- * Extractors-    columnOids,--    -- * Constructors--    -- ** Basic-    ok,-    pipelineSync,-    rowsAffected,-    checkExecStatus,--    -- ** Higher-level decoders-    maybe,-    single,-    vector,-    foldl,-    foldr,--    -- ** Refinement-    refine,--    -- * Errors-    Error (..),-  )-where--import Data.Attoparsec.ByteString.Char8 qualified as Attoparsec-import Data.ByteString qualified as ByteString-import Data.Vector qualified as Vector-import Data.Vector.Mutable qualified as MutableVector-import Hasql.Comms.RowDecoder qualified as RowDecoder-import Hasql.Platform.Prelude hiding (foldl, foldr, maybe)-import Hasql.Platform.Prelude qualified as Prelude-import Hasql.Pq qualified as Pq---- | Result consumption context, for consuming a single result from a sequence of results returned by the server.-newtype ResultDecoder a-  = ResultDecoder (Pq.Result -> IO (Either Error a))-  deriving-    (Functor, Applicative, Monad, MonadError Error, MonadReader Pq.Result)-    via (ReaderT Pq.Result (ExceptT Error IO))--instance Filterable ResultDecoder where-  {-# INLINE mapMaybe #-}-  mapMaybe fn =-    refine (Prelude.maybe (Left "Invalid result") Right . fn)---- * Relations---- ** Handler--type Handler a = Pq.Result -> IO (Either Error a)--toHandler :: ResultDecoder a -> Handler a-toHandler (ResultDecoder handler) =-  handler--fromHandler :: Handler a -> ResultDecoder a-fromHandler handler =-  ResultDecoder handler---- * Construction--{-# INLINE ok #-}-ok :: ResultDecoder ()-ok = checkExecStatus [Pq.CommandOk, Pq.TuplesOk]--{-# INLINE pipelineSync #-}-pipelineSync :: ResultDecoder ()-pipelineSync = checkExecStatus [Pq.PipelineSync]--{-# INLINE rowsAffected #-}-rowsAffected :: ResultDecoder Int64-rowsAffected = do-  checkExecStatus [Pq.CommandOk]-  ResultDecoder \result -> do-    cmdTuplesReader <$> Pq.cmdTuples result-  where-    cmdTuplesReader =-      notNothing >=> notEmpty >=> decimal-      where-        notNothing =-          Prelude.maybe (Left (UnexpectedResult "No bytes")) Right-        notEmpty bytes =-          if ByteString.null bytes-            then Left (UnexpectedResult "Empty bytes")-            else Right bytes-        decimal bytes =-          first-            ( \m ->-                UnexpectedResult-                  ("Decimal parsing failure: " <> fromString m)-            )-            ( Attoparsec.parseOnly-                (Attoparsec.decimal <* Attoparsec.endOfInput)-                bytes-            )--{-# INLINE checkExecStatus #-}-checkExecStatus :: [Pq.ExecStatus] -> ResultDecoder ()-checkExecStatus expectedList = do-  status <- ResultDecoder \result -> Right <$> Pq.resultStatus result-  unless (elem status expectedList) $ do-    case status of-      Pq.BadResponse -> serverError-      Pq.NonfatalError -> serverError-      Pq.FatalError -> serverError-      Pq.EmptyQuery -> return ()-      _ ->-        throwError-          ( UnexpectedResult-              ("Unexpected result status: " <> fromString (show status) <> ". Expecting one of the following: " <> fromString (show expectedList))-          )--{-# INLINE serverError #-}-serverError :: ResultDecoder ()-serverError =-  ResultDecoder \result -> do-    code <--      fold <$> Pq.resultErrorField result Pq.DiagSqlstate-    message <--      fold <$> Pq.resultErrorField result Pq.DiagMessagePrimary-    detail <--      Pq.resultErrorField result Pq.DiagMessageDetail-    hint <--      Pq.resultErrorField result Pq.DiagMessageHint-    position <--      parsePosition <$> Pq.resultErrorField result Pq.DiagStatementPosition-    pure $ Left $ ServerError code message detail hint position-  where-    parsePosition = \case-      Nothing -> Nothing-      Just pos ->-        case Attoparsec.parseOnly (Attoparsec.decimal <* Attoparsec.endOfInput) pos of-          Right pos -> Just pos-          _ -> Nothing---- | Get the OIDs of all columns in the current result.-{-# INLINE columnOids #-}-columnOids :: ResultDecoder [Pq.Oid]-columnOids = ResultDecoder \result -> do-  columnsAmount <- Pq.nfields result-  let Pq.Col count = columnsAmount-  oids <- forM [0 .. count - 1] $ \colIndex ->-    Pq.ftype result (Pq.Col colIndex)-  pure (Right oids)---- * Higher-level decoders--{-# INLINE checkCompatibility #-}-checkCompatibility :: RowDecoder.RowDecoder a -> ResultDecoder ()-checkCompatibility rowDec =-  let oids = RowDecoder.toExpectedOids rowDec-   in ResultDecoder \result -> do-        maxCols <- Pq.nfields result-        if length oids == Pq.colToInt maxCols-          then-            let go [] _ = pure (Right ())-                go (Nothing : rest) colIndex = go rest (succ colIndex)-                go (Just expectedOid : rest) colIndex = do-                  actualOid <- Pq.ftype result (Pq.toColumn colIndex)-                  if actualOid == expectedOid-                    then go rest (succ colIndex)-                    else-                      pure-                        ( Left-                            ( DecoderTypeMismatch-                                colIndex-                                (Pq.oidToWord32 expectedOid)-                                (Pq.oidToWord32 actualOid)-                            )-                        )-             in go oids 0-          else pure (Left (UnexpectedColumnCount (length oids) (Pq.colToInt maxCols)))--{-# INLINE maybe #-}-maybe :: RowDecoder.RowDecoder a -> ResultDecoder (Maybe a)-maybe rowDec =-  do-    checkExecStatus [Pq.TuplesOk]-    checkCompatibility rowDec-    ResultDecoder-      $ \result -> do-        maxRows <- Pq.ntuples result-        case maxRows of-          0 -> return (Right Nothing)-          1 -> do-            result <--              RowDecoder.toDecoder rowDec result 0-                <&> first (RowError 0)-            pure (fmap Just result)-          _ -> return (Left (UnexpectedRowCount (rowToInt maxRows)))-  where-    rowToInt (Pq.Row n) =-      fromIntegral n--{-# INLINE single #-}-single :: RowDecoder.RowDecoder a -> ResultDecoder a-single rowDec =-  do-    checkExecStatus [Pq.TuplesOk]-    checkCompatibility rowDec-    ResultDecoder-      $ \result -> do-        maxRows <- Pq.ntuples result-        case maxRows of-          1 -> do-            RowDecoder.toDecoder rowDec result 0-              <&> first (RowError 0)-          _ -> return (Left (UnexpectedRowCount (rowToInt maxRows)))-  where-    rowToInt (Pq.Row n) =-      fromIntegral n--{-# INLINE vector #-}-vector :: RowDecoder.RowDecoder a -> ResultDecoder (Vector a)-vector rowDec =-  do-    checkExecStatus [Pq.TuplesOk]-    checkCompatibility rowDec-    ResultDecoder-      $ \result -> do-        maxRows <- Pq.ntuples result-        mvector <- MutableVector.unsafeNew (rowToInt maxRows)-        failureRef <- newIORef Nothing-        forMFromZero_ (rowToInt maxRows) $ \rowIndex -> do-          rowResult <- RowDecoder.toDecoder rowDec result (intToRow rowIndex)-          case rowResult of-            Left !err -> writeIORef failureRef (Just (RowError rowIndex err))-            Right !x -> MutableVector.unsafeWrite mvector rowIndex x-        readIORef failureRef >>= \case-          Nothing -> Right <$> Vector.unsafeFreeze mvector-          Just x -> pure (Left x)-  where-    rowToInt (Pq.Row n) =-      fromIntegral n-    intToRow =-      Pq.Row . fromIntegral--{-# INLINE foldl #-}-foldl :: (a -> b -> a) -> a -> RowDecoder.RowDecoder b -> ResultDecoder a-foldl step init rowDec =-  {-# SCC "foldl" #-}-  do-    checkExecStatus [Pq.TuplesOk]-    checkCompatibility rowDec-    ResultDecoder-      $ \result ->-        {-# SCC "traversal" #-}-        do-          maxRows <- Pq.ntuples result-          accRef <- newIORef init-          failureRef <- newIORef Nothing-          forMFromZero_ (rowToInt maxRows) $ \rowIndex -> do-            rowResult <- RowDecoder.toDecoder rowDec result (intToRow rowIndex)-            case rowResult of-              Left !err -> writeIORef failureRef (Just (RowError rowIndex err))-              Right !x -> modifyIORef' accRef (\acc -> step acc x)-          readIORef failureRef >>= \case-            Nothing -> Right <$> readIORef accRef-            Just x -> pure (Left x)-  where-    rowToInt (Pq.Row n) =-      fromIntegral n-    intToRow =-      Pq.Row . fromIntegral--{-# INLINE foldr #-}-foldr :: (b -> a -> a) -> a -> RowDecoder.RowDecoder b -> ResultDecoder a-foldr step init rowDec =-  {-# SCC "foldr" #-}-  do-    checkExecStatus [Pq.TuplesOk]-    checkCompatibility rowDec-    ResultDecoder-      $ \result -> do-        maxRows <- Pq.ntuples result-        accRef <- newIORef init-        failureRef <- newIORef Nothing-        forMToZero_ (rowToInt maxRows) $ \rowIndex -> do-          rowResult <- RowDecoder.toDecoder rowDec result (intToRow rowIndex)-          case rowResult of-            Left !err -> writeIORef failureRef (Just (RowError rowIndex err))-            Right !x -> modifyIORef accRef (\acc -> step x acc)-        readIORef failureRef >>= \case-          Nothing -> Right <$> readIORef accRef-          Just x -> pure (Left x)-  where-    rowToInt (Pq.Row n) =-      fromIntegral n-    intToRow =-      Pq.Row . fromIntegral---- * Refinement--refine :: (a -> Either Text b) -> ResultDecoder a -> ResultDecoder b-refine refiner (ResultDecoder reader) = ResultDecoder-  $ \result -> do-    resultEither <- reader result-    return $ resultEither >>= first UnexpectedResult . refiner---- * Errors---- |--- An error with a command result.-data Error-  = -- | An error reported by the DB.-    ServerError-      -- | __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.-      ByteString-      -- | __Message__. The primary human-readable error message(typically one-      -- line). Always present.-      ByteString-      -- | __Details__. An optional secondary error message carrying more-      -- detail about the problem. Might run to multiple lines.-      (Maybe ByteString)-      -- | __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.-      (Maybe ByteString)-      -- | __Position__. Error cursor position as an index into the original-      -- statement string. Positions are measured in characters not bytes.-      (Maybe Int)-  | -- |-    -- The database returned an unexpected result.-    -- Indicates an improper statement or a schema mismatch.-    UnexpectedResult Text-  | -- |-    -- An unexpected amount of rows.-    UnexpectedRowCount Int-  | -- |-    -- An unexpected amount of columns in the result.-    UnexpectedColumnCount-      -- | Expected amount of columns.-      Int-      -- | Actual amount of columns.-      Int-  | -- |-    -- Appears when the decoder's expected type doesn't match the actual column type.-    -- Reports the expected OID and the actual OID from the result.-    DecoderTypeMismatch-      -- | Column index.-      Int-      -- | Expected OID.-      Word32-      -- | Actual OID.-      Word32-  | -- | An error in a specific row, reported by a row decoder.-    RowError-      -- | Row index.-      Int-      -- | Underlying error.-      RowDecoder.Error-  deriving (Show, Eq)
− src/library/Hasql/Comms/Roundtrip.hs 
@@ -1,140 +0,0 @@-module Hasql.Comms.Roundtrip-  ( Roundtrip,-    toPipelineIO,-    toSerialIO,--    -- * Constructors-    prepare,-    queryPrepared,-    queryParams,-    query,-    script,--    -- * Errors-    Error (..),-  )-where--import Hasql.Comms.Recv qualified as Recv-import Hasql.Comms.ResultDecoder qualified as ResultDecoder-import Hasql.Comms.Send qualified as Send-import Hasql.Platform.Prelude-import Hasql.Pq qualified as Pq--data Roundtrip context a-  = Roundtrip (Send.Send context) (Recv.Recv context a)-  deriving stock (Functor)--instance Applicative (Roundtrip context) where-  {-# INLINE pure #-}-  pure x = Roundtrip mempty (pure x)-  {-# INLINE (<*>) #-}-  Roundtrip send1 recv1 <*> Roundtrip send2 recv2 =-    Roundtrip (send1 <> send2) (recv1 <*> recv2)--instance Bifunctor Roundtrip where-  {-# INLINE bimap #-}-  bimap f g (Roundtrip send recv) =-    Roundtrip-      (fmap f send)-      (bimap f g recv)--toPipelineIO :: Roundtrip context a -> context -> Pq.Connection -> IO (Either (Error context) a)-toPipelineIO sendAndRecv context connection = mask \restore -> do-  sendResult <- Send.toHandler (Send.enterPipelineMode context <> send) connection-  case sendResult of-    Send.Error context details -> pure (Left (ClientError context details))-    Send.Ok -> do-      recvResult <- first ServerError <$> restore (Recv.toHandler recv connection)-      exitResult <- do-        result <- Send.toHandler (Send.exitPipelineMode context) connection-        case result of-          Send.Error context details -> pure (Left (ClientError context details))-          Send.Ok -> pure (Right ())-      pure (recvResult <* exitResult)-  where-    Roundtrip send recv = sendAndRecv <* pipelineSync context--toSerialIO :: Roundtrip context a -> Pq.Connection -> IO (Either (Error context) a)-toSerialIO (Roundtrip send recv) connection = do-  sendResult <- Send.toHandler send connection-  case sendResult of-    Send.Error context details -> pure (Left (ClientError context details))-    Send.Ok -> do-      recvResult <- Recv.toHandler recv connection-      pure (first ServerError recvResult)--pipelineSync :: context -> Roundtrip context ()-pipelineSync context =-  Roundtrip-    (Send.pipelineSync context)-    (Recv.singleResult context ResultDecoder.pipelineSync)--prepare :: context -> ByteString -> ByteString -> [Pq.Oid] -> Roundtrip context ()-prepare context statementName sql oidList =-  Roundtrip-    (Send.prepare context statementName sql (Just oidList))-    (Recv.singleResult context ResultDecoder.ok)--queryPrepared ::-  context ->-  -- | Prepared statement name.-  ByteString ->-  -- | Parameters.-  [Maybe (ByteString, Pq.Format)] ->-  -- | Result format.-  Pq.Format ->-  -- | Result decoder.-  ResultDecoder.ResultDecoder a ->-  Roundtrip context a-queryPrepared context statementName params resultFormat resultDecoder =-  Roundtrip-    (Send.queryPrepared context statementName params resultFormat)-    (Recv.singleResult context resultDecoder)--queryParams ::-  context ->-  -- | SQL.-  ByteString ->-  -- | Parameters.-  [Maybe (Pq.Oid, ByteString, Pq.Format)] ->-  -- | Result format.-  Pq.Format ->-  -- | Result decoder.-  ResultDecoder.ResultDecoder a ->-  Roundtrip context a-queryParams context sql params resultFormat resultDecoder =-  Roundtrip-    (Send.queryParams context sql params resultFormat)-    (Recv.singleResult context resultDecoder)--query :: context -> ByteString -> Roundtrip context ()-query context sql =-  Roundtrip-    (Send.query context sql)-    (Recv.singleResult context ResultDecoder.ok)---- | Execute a script (multi-statement SQL).--- Unlike 'query', this consumes all results from the execution,--- which is necessary for scripts containing multiple statements.-script :: context -> ByteString -> Roundtrip context ()-script context sql =-  Roundtrip-    (Send.query context sql)-    (Recv.allResults context ResultDecoder.ok)--data Error context-  = ClientError context (Maybe ByteString)-  | ServerError (Recv.Error context)-  deriving stock (Show, Eq, Functor)--instance Comonad Error where-  {-# INLINE extract #-}-  extract = \case-    ClientError context _ -> context-    ServerError recvError -> extract recvError--  {-# INLINE duplicate #-}-  duplicate = \case-    clientError@(ClientError _ details) -> ClientError clientError details-    ServerError recvError -> ServerError (fmap ServerError (duplicate recvError))
− src/library/Hasql/Comms/RowDecoder.hs 
@@ -1,79 +0,0 @@-module Hasql.Comms.RowDecoder-  ( RowDecoder,-    nullableColumn,-    nonNullableColumn,--    -- * Relations--    -- ** Expected OIDs-    toExpectedOids,--    -- ** Decoder-    Decoder,-    toDecoder,--    -- * Errors-    Error,-  )-where--import Hasql.Comms.RowReader qualified as RowReader-import Hasql.Platform.Prelude-import Hasql.Pq qualified as Pq---- * RowDecoder--data RowDecoder a-  = RowDecoder-      [Maybe Pq.Oid]-      (RowReader.RowReader a)-  deriving stock (Functor)--instance Applicative RowDecoder where-  pure a = RowDecoder [] (pure a)-  RowDecoder lOids lDec <*> RowDecoder rOids rDec =-    RowDecoder (lOids <> rOids) (lDec <*> rDec)--instance Filterable RowDecoder where-  mapMaybe fn (RowDecoder oids dec) =-    RowDecoder oids (mapMaybe fn dec)---- * Functions---- |--- Next value, decoded using the provided value decoder.-{-# INLINE nullableColumn #-}-nullableColumn :: Maybe Word32 -> (ByteString -> Either Text a) -> RowDecoder (Maybe a)-nullableColumn oid decoder =-  RowDecoder-    [Pq.Oid . fromIntegral <$> oid]-    (RowReader.nullableColumn decoder)---- |--- Next value, decoded using the provided value decoder.-{-# INLINE nonNullableColumn #-}-nonNullableColumn :: Maybe Word32 -> (ByteString -> Either Text a) -> RowDecoder a-nonNullableColumn oid decoder =-  RowDecoder-    [Pq.Oid . fromIntegral <$> oid]-    (RowReader.nonNullableColumn decoder)---- * Relations---- ** Expected OIDs--toExpectedOids :: RowDecoder a -> [Maybe Pq.Oid]-toExpectedOids (RowDecoder oids _) = oids---- ** Decoder--type Decoder a = Pq.Result -> Pq.Row -> IO (Either Error a)--{-# INLINE toDecoder #-}-toDecoder :: RowDecoder a -> Decoder a-toDecoder (RowDecoder _ dec) result row =-  RowReader.toHandler dec result row---- * Errors--type Error = RowReader.Error
− src/library/Hasql/Comms/RowReader.hs 
@@ -1,102 +0,0 @@--- | Lower level context focused on just the actual decoding of values. No metadata involved.-module Hasql.Comms.RowReader-  ( RowReader,-    nullableColumn,-    nonNullableColumn,--    -- * Errors-    Error (..),-    CellError (..),--    -- * Relations-    toHandler,-  )-where--import Hasql.Platform.Prelude-import Hasql.Pq qualified as Pq--data Error-  = CellError-      -- | Column index, 0-based.-      Int-      -- | OID of the column type as reported by Postgres.-      Word32-      -- | Underlying error.-      CellError-  | RefinementError Text-  deriving stock (Eq, Show)--data CellError-  = DecodingCellError Text-  | UnexpectedNullCellError-  deriving stock (Eq, Show)--newtype RowReader a-  = RowReader (StateT Pq.Column (ReaderT Env (ExceptT Error IO)) a)-  deriving-    (Functor, Applicative)-    via (StateT Pq.Column (ReaderT Env (ExceptT Error IO)))--data Env-  = Env-      Pq.Result-      Pq.Row---- * Instances--instance Filterable RowReader where-  {-# INLINE mapMaybe #-}-  mapMaybe fn (RowReader run) =-    RowReader do-      result <- run-      case fn result of-        Just refined -> pure refined-        Nothing -> throwError (RefinementError "Filtration failed")---- * Functions--{-# INLINE toHandler #-}-toHandler :: RowReader a -> Pq.Result -> Pq.Row -> IO (Either Error a)-toHandler (RowReader f) result row =-  let env = Env result row-   in runExceptT (runReaderT (evalStateT f 0) env)---- |--- Next value, decoded using the provided value decoder.-{-# INLINE column #-}-column :: (Maybe a -> Maybe b) -> (ByteString -> Either Text a) -> RowReader b-column processNullable valueDec = RowReader do-  col <- get-  Env result row <- ask-  let colInt = Pq.colToInt col-  put (succ col)--  valueMaybe <- liftIO ({-# SCC "getvalue'" #-} Pq.getvalue' result row col)--  valueMaybe <- case valueMaybe of-    Nothing -> pure Nothing-    Just v ->-      case {-# SCC "decode" #-} valueDec v of-        Left err -> do-          oid <- Pq.oidToWord32 <$> liftIO (Pq.ftype result col)-          throwError (CellError colInt oid (DecodingCellError err))-        Right decoded -> pure (Just decoded)--  case processNullable valueMaybe of-    Nothing -> do-      oid <- Pq.oidToWord32 <$> liftIO (Pq.ftype result col)-      throwError (CellError colInt oid UnexpectedNullCellError)-    Just decoded -> pure decoded---- |--- Next value, decoded using the provided value decoder.-{-# INLINE nullableColumn #-}-nullableColumn :: (ByteString -> Either Text a) -> RowReader (Maybe a)-nullableColumn = column Just---- |--- Next value, decoded using the provided value decoder.-{-# INLINE nonNullableColumn #-}-nonNullableColumn :: (ByteString -> Either Text a) -> RowReader a-nonNullableColumn = column id
− src/library/Hasql/Comms/Send.hs 
@@ -1,67 +0,0 @@-module Hasql.Comms.Send where--import Hasql.Platform.Prelude-import Hasql.Pq qualified as Pq--data Result context-  = Ok-  | Error context (Maybe ByteString)-  deriving stock (Eq, Show, Functor)--newtype Send context-  = Send (Pq.Connection -> IO (Result context))-  deriving stock (Functor)--instance Semigroup (Send context) where-  {-# INLINE (<>) #-}-  Send send1 <> Send send2 = Send \cs -> do-    result <- send1 cs-    case result of-      Error context details -> pure (Error context details)-      Ok -> do-        result2 <- send2 cs-        pure result2--instance Monoid (Send context) where-  {-# INLINE mempty #-}-  mempty = Send \_ -> pure Ok--toHandler :: Send context -> Pq.Connection -> IO (Result context)-toHandler (Send send) = send--liftPqSend :: context -> (Pq.Connection -> IO Bool) -> Send context-liftPqSend context pqSend = Send \connection -> do-  success <- pqSend connection-  if success-    then pure Ok-    else do-      errorMessage <- Pq.errorMessage connection-      pure (Error context errorMessage)--prepare :: context -> ByteString -> ByteString -> Maybe [Pq.Oid] -> Send context-prepare context statementName sql oidList =-  liftPqSend context \connection -> Pq.sendPrepare connection statementName sql oidList--query :: context -> ByteString -> Send context-query context sql =-  liftPqSend context \connection -> Pq.sendQuery connection sql--queryPrepared :: context -> ByteString -> [Maybe (ByteString, Pq.Format)] -> Pq.Format -> Send context-queryPrepared context statementName params resultFormat =-  liftPqSend context \connection -> Pq.sendQueryPrepared connection statementName params resultFormat--queryParams :: context -> ByteString -> [Maybe (Pq.Oid, ByteString, Pq.Format)] -> Pq.Format -> Send context-queryParams context sql params resultFormat =-  liftPqSend context \connection -> Pq.sendQueryParams connection sql params resultFormat--pipelineSync :: context -> Send context-pipelineSync context =-  liftPqSend context \connection -> Pq.pipelineSync connection--enterPipelineMode :: context -> Send context-enterPipelineMode context =-  liftPqSend context \connection -> Pq.enterPipelineMode connection--exitPipelineMode :: context -> Send context-exitPipelineMode context =-  liftPqSend context \connection -> Pq.exitPipelineMode connection
− src/library/Hasql/Comms/Session.hs 
@@ -1,176 +0,0 @@-module Hasql.Comms.Session-  ( Session,--    -- * Constructors-    cleanUpAfterInterruption,--    -- * Executors-    toHandler,-  )-where--import Hasql.Comms.Roundtrip qualified as Roundtrip-import Hasql.Platform.Prelude-import Hasql.Pq qualified as Pq---- | Serial execution of commands in the scope of a connection.-newtype Session a = Session (Pq.Connection -> IO (Either Error a))-  deriving-    (Functor, Applicative, Monad, MonadError Error)-    via (ExceptT Error (ReaderT Pq.Connection IO))--type Error = Text---- * Constructors---- | Bring the connection to a clean state after an interruption.------ This includes:--- - Leaving pipeline mode if we are in it.--- - Bringing the transaction status to idle if we are in a transaction.--- - Deallocating all prepared statements.-cleanUpAfterInterruption :: Session ()-cleanUpAfterInterruption = do-  drainResults-  cancel-  drainResults-  -- Ensure we are out of pipeline mode.-  leavePipeline-  -- Ensure we are in idle transaction state.-  bringTransactionStatusToIdle-  deallocateAllPreparedStatements--bringTransactionStatusToIdle :: Session ()-bringTransactionStatusToIdle = do-  transactionStatus <- getTransactionStatus-  case transactionStatus of-    Pq.TransIdle -> pure ()-    Pq.TransInTrans -> do-      runScript "ABORT"-    Pq.TransActive -> do-      -- A command is still in progress.-      drainResults-      -- Check status again after draining.-      transactionStatus <- getTransactionStatus-      case transactionStatus of-        Pq.TransIdle -> pure ()-        Pq.TransInTrans -> do-          runScript "ABORT"-        Pq.TransActive -> do-          -- If we're still active, there's not much we can do.-          -- The connection is probably in a bad state.-          throwError "Failed to bring transaction status to idle after draining results"-        Pq.TransInError -> do-          runScript "ABORT"-        Pq.TransUnknown -> do-          -- Unknown state (connection issue), there's not much we can do.-          throwError "Transaction status is unknown, connection is corrupted"-    Pq.TransInError -> do-      -- Transaction is in error state, we need to abort it.-      runScript "ABORT"-    Pq.TransUnknown -> do-      -- Unknown state (connection issue), there's not much we can do.-      throwError "Transaction status is unknown, connection is corrupted"--leavePipeline :: Session ()-leavePipeline = do-  pipelineStatus <- getPipelineStatus-  -- PipelineAborted is still pipeline mode. It must reach a sync point before-  -- libpq permits serial queries such as ABORT or DEALLOCATE ALL again.-  when (pipelineStatus /= Pq.PipelineOff) do-    -- In pipeline mode, we need to ensure the pipeline is synchronized before exiting.-    -- Send a pipeline sync marker to flush any pending operations.-    syncSuccess <- sendPipelineSync-    when syncSuccess drainResults-    -- After sync, send a flush to ensure all queued commands are sent to the server.-    flushSuccess <- sendFlushRequest-    when flushSuccess drainResults-    -- Try to exit pipeline mode.-    -- This might fail if there are pending results that need to be consumed.-    success <- exitPipelineMode-    unless success do-      -- If exit failed, drain results and try again.-      drainResults-      success <- exitPipelineMode-      unless success do-        -- If it still fails, there's not much we can do.-        -- The connection is probably in a bad state.-        errorMessage <- getErrorMessage-        let message = case errorMessage of-              Nothing -> "Failed to exit pipeline mode after draining results"-              Just details -> "Failed to exit pipeline mode after draining results: " <> decodeUtf8Lenient details-        throwError message--deallocateAllPreparedStatements :: Session ()-deallocateAllPreparedStatements =-  runScript "DEALLOCATE ALL"--cancel :: Session ()-cancel = Session \connection -> do-  mCancel <- Pq.getCancel connection-  case mCancel of-    Just cancel -> do-      result <- Pq.cancel cancel-      case result of-        Left errorMessage ->-          pure (Left ("Failed to cancel: " <> decodeUtf8Lenient errorMessage))-        Right () ->-          pure (Right ())-    Nothing -> pure (Right ())--getErrorMessage :: Session (Maybe ByteString)-getErrorMessage = Session \connection -> do-  Right <$> Pq.errorMessage connection--getTransactionStatus :: Session Pq.TransactionStatus-getTransactionStatus = Session \connection -> do-  Right <$> Pq.transactionStatus connection--getPipelineStatus :: Session Pq.PipelineStatus-getPipelineStatus = Session \connection -> do-  Right <$> Pq.pipelineStatus connection--exitPipelineMode :: Session Bool-exitPipelineMode = Session \connection -> do-  Right <$> Pq.exitPipelineMode connection--sendPipelineSync :: Session Bool-sendPipelineSync = Session \connection -> do-  Right <$> Pq.pipelineSync connection--sendFlushRequest :: Session Bool-sendFlushRequest = Session \connection -> do-  Right <$> Pq.sendFlushRequest connection---- Drain all pending results from the connection.-drainResults :: Session ()-drainResults = Session \connection ->-  let go = do-        mResult <- Pq.getResult connection-        case mResult of-          Nothing -> pure ()-          Just _ -> go-   in go $> Right ()--runScript :: ByteString -> Session ()-runScript script = runRoundtrip (Roundtrip.query () script)--runRoundtrip :: Roundtrip.Roundtrip () a -> Session a-runRoundtrip roundtrip = Session \connection -> do-  result <- Roundtrip.toSerialIO roundtrip connection-  case result of-    Left err ->-      let message = case err of-            Roundtrip.ClientError () Nothing ->-              "Unknown client error occurred"-            Roundtrip.ClientError () (Just details) ->-              "Client error occurred: " <> decodeUtf8Lenient details-            Roundtrip.ServerError recvError ->-              "Server error occurred: " <> fromString (show recvError)-       in pure (Left message)-    Right value -> pure (Right value)---- * Executors--toHandler :: Session a -> Pq.Connection -> IO (Either Text a)-toHandler (Session run) = run
src/library/Hasql/Connection.hs view
@@ -18,7 +18,8 @@ import Hasql.Engine.Structures.ConnectionState qualified as ConnectionState import Hasql.Engine.Structures.StatementCache qualified as StatementCache import Hasql.Platform.Prelude-import Hasql.Pq qualified as Pq+import Pqi (Adapter)+import Pqi qualified as Pq  -- | -- A single connection to the database.@@ -28,15 +29,16 @@ -- | -- Establish a connection according to the provided settings. acquire ::+  Adapter ->   Settings.Settings ->   IO (Either ConnectionError Connection)-acquire settings =+acquire adapter settings =   {-# SCC "acquire" #-}   runExceptT do     let config = Config.construct settings      -- Connect:-    pqConnection <- lift (Pq.connectdb (Config.connectionString config))+    pqConnection <- lift (Pq.connectdb adapter (Config.connectionString config))      -- Check status:     status <- lift (Pq.status pqConnection)
src/library/Hasql/Connection/ServerVersion.hs view
@@ -10,7 +10,7 @@ where  import Hasql.Platform.Prelude hiding (minimum)-import Hasql.Pq qualified as Pq+import Pqi qualified as Pq import TextBuilder qualified  data ServerVersion = ServerVersion Int Int Int
− src/library/Hasql/Engine/Contexts/Pipeline.hs 
@@ -1,268 +0,0 @@-module Hasql.Engine.Contexts.Pipeline-  ( Pipeline,-    run,-    statement,-  )-where--import Data.HashMap.Strict qualified as HashMap-import Data.HashSet qualified as HashSet-import Hasql.Codecs.RequestingOid qualified as RequestingOid-import Hasql.Codecs.Vocab qualified as Vocab-import Hasql.Codecs.Vocab.OidCache qualified as OidCache-import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName-import Hasql.Comms.Roundtrip qualified as Comms.Roundtrip-import Hasql.Engine.Errors qualified as Errors-import Hasql.Engine.PqProcedures.SelectTypeInfo qualified as PqProcedures.SelectTypeInfo-import Hasql.Engine.Statement qualified as Statement-import Hasql.Engine.Structures.StatementCache qualified as StatementCache-import Hasql.Platform.Prelude-import Hasql.Pq qualified as Pq--run ::-  Pipeline a ->-  Bool ->-  Pq.Connection ->-  OidCache.OidCache ->-  StatementCache.StatementCache ->-  IO-    ( Either Errors.SessionError a,-      OidCache.OidCache,-      StatementCache.StatementCache-    )-run (Pipeline totalStatements unknownTypes runPipeline) usePreparedStatements connection oidCache statementCache = do-  let missingTypes = OidCache.selectUnknownNames unknownTypes oidCache-  resolvedOidCache <--    if HashSet.null missingTypes-      then pure (Right oidCache)-      else do-        oidCacheUpdates <--          PqProcedures.SelectTypeInfo.run connection (PqProcedures.SelectTypeInfo.SelectTypeInfo missingTypes)-        pure $ case oidCacheUpdates of-          Left err -> Left err-          Right oidCacheUpdates ->-            let foundTypes = HashMap.keysSet oidCacheUpdates-                notFoundTypes = HashSet.difference missingTypes foundTypes-             in if not (HashSet.null notFoundTypes)-                  then Left (Errors.MissingTypesSessionError (HashSet.map Vocab.QualifiedTypeName.toNameTuple notFoundTypes))-                  else Right (oidCache <> OidCache.fromHashMap oidCacheUpdates)-  case resolvedOidCache of-    Left err -> pure (Left err, oidCache, statementCache)-    Right newOidCache -> do-      let (roundtrip, newStatementCache) =-            runPipeline 0 usePreparedStatements newOidCache statementCache-          contextualRoundtrip = first Just roundtrip--      executionResult <- Comms.Roundtrip.toPipelineIO contextualRoundtrip Nothing connection--      let result =-            first-              ( \case-                  Comms.Roundtrip.ClientError _context details ->-                    Errors.ConnectionSessionError (maybe "" decodeUtf8Lenient details)-                  Comms.Roundtrip.ServerError recvError ->-                    Errors.fromRecvError (fmap (fmap (\(Context index sql params prepared _) -> (totalStatements, index, sql, params, prepared))) recvError)-              )-              executionResult-          finalStatementCache =-            case executionResult of-              Right _ -> newStatementCache-              Left executionError ->-                maybe-                  statementCache-                  (\(Context _ _ _ _ statementCache) -> statementCache)-                  (extract executionError)--      pure (result, newOidCache, finalStatementCache)---- |--- Composable abstraction over the execution of queries in [the pipeline mode](https://www.postgresql.org/docs/current/libpq-pipeline-mode.html).------ It allows you to issue multiple queries to the server in much fewer network transactions.--- If the amounts of sent and received data do not surpass the buffer sizes in the driver and on the server it will be just a single roundtrip.--- Typically the buffer size is 8KB.------ This execution mode is much more efficient than running queries directly from 'Hasql.Session.Session', because in session every statement execution involves a dedicated network roundtrip.------ An obvious question rises then: why not execute all queries like that?--- In situations where the parameters depend on the result of another query it is impossible to execute them in parallel, because the client needs to receive the results of one query before sending the request to execute the next.--- This reasoning is essentially the same as the one for the difference between 'Applicative' and 'Monad'.--- That's why 'Pipeline' does not have the 'Monad' instance.------ To execute 'Pipeline' lift it into 'Hasql.Session.Session' via 'Hasql.Session.pipeline'.------ == Examples------ === Insert-Many or Batch-Insert------ You can use pipeline to turn a single-row insert query into an efficient multi-row insertion session.--- In effect this should be comparable in performance to issuing a single multi-row insert statement.------ Given the following definition in a Statements module:------ @--- insertOrder :: 'Hasql.Statement.Statement' OrderDetails OrderId--- @------ You can lift it into the following session------ @--- insertOrders :: [OrderDetails] -> 'Hasql.Session.Session' [OrderId]--- insertOrders orders =---   'Hasql.Session.pipeline' $---     for orders $ \order ->---       'Hasql.Pipeline.statement' order Statements.insertOrder--- @------ === Combining Queries------ Given the following definitions in a Statements module:------ @--- selectOrderDetails :: 'Hasql.Statement.Statement' OrderId (Maybe OrderDetails)--- selectOrderProducts :: 'Hasql.Statement.Statement' OrderId [OrderProduct]--- selectOrderFinancialTransactions :: 'Hasql.Statement.Statement' OrderId [FinancialTransaction]--- @------ You can combine them into a session using the `ApplicativeDo` extension as follows:------ @--- selectEverythingAboutOrder :: OrderId -> 'Hasql.Session.Session' (Maybe OrderDetails, [OrderProduct], [FinancialTransaction])--- selectEverythingAboutOrder orderId =---   'Hasql.Session.pipeline' $ do---     details <- 'Hasql.Pipeline.statement' orderId Statements.selectOrderDetails---     products <- 'Hasql.Pipeline.statement' orderId Statements.selectOrderProducts---     transactions <- 'Hasql.Pipeline.statement' orderId Statements.selectOrderFinancialTransactions---     pure (details, products, transactions)--- @-data Pipeline a-  = Pipeline-      -- | Amount of statements in this pipeline.-      Int-      -- | Names of types that are used in this pipeline.-      ---      -- They will be used to pre-resolve type OIDs before running the pipeline providing them in OidCache.-      -- It can be assumed in the execution function that these types are always present in the cache.-      -- To achieve that property we will be validating the presence of all requested types in the database or failing before running the pipeline.-      -- In the execution function we will be defaulting to 'Pq.Oid 0' for unknown types as a fallback in case of bugs.-      (HashSet Vocab.QualifiedTypeName)-      -- | Function that runs the pipeline.-      ---      -- The integer parameter indicates the current offset of the statement in the pipeline (0-based).-      ---      -- The boolean parameter indicates whether preparable statements should be prepared.-      ---      -- OidCache is provided in which the names of types used in this pipeline are already resolved.-      ---      -- The function takes the current statement cache and returns a tuple of:-      -- 1. The actual roundtrip action to be executed in the pipeline.-      -- 2. The updated statement cache after composing this part of the pipeline.-      ---      -- The resulting cache is optimistic: on failure we recover the last known-      -- committed cache from statement contexts carried by roundtrip errors.-      ( Int ->-        Bool ->-        OidCache.OidCache ->-        StatementCache.StatementCache ->-        (Comms.Roundtrip.Roundtrip Context a, StatementCache.StatementCache)-      )--data Context-  = Context-      -- | Offset of the statement in the pipeline (0-based).-      Int-      -- | SQL.-      ByteString-      -- | Parameters in a human-readable form.-      [Text]-      -- | Whether the statement is prepared.-      Bool-      -- | The so far successfully updated statement cache.-      StatementCache.StatementCache-  deriving stock (Show, Eq)---- * Instances--instance Functor Pipeline where-  fmap f (Pipeline count unknownTypes run) = Pipeline count unknownTypes \offset usePreparedStatements oidCache cache ->-    let (roundtrip, newStatementCache) = run offset usePreparedStatements oidCache cache-     in (fmap f roundtrip, newStatementCache)--instance Applicative Pipeline where-  pure a =-    Pipeline 0 mempty (\_ _ _ cache -> (pure a, cache))--  Pipeline lCount leftUnknownTypes lRun <*> Pipeline rCount rightUnknownTypes rRun =-    let unknownTypes = leftUnknownTypes <> rightUnknownTypes-     in Pipeline (lCount + rCount) unknownTypes \offset usePreparedStatements oidCache statementCache ->-          let (lRoundtrip, statementCache1) = lRun offset usePreparedStatements oidCache statementCache-              offset1 = offset + lCount-              (rRoundtrip, statementCache2) = rRun offset1 usePreparedStatements oidCache statementCache1-           in (lRoundtrip <*> rRoundtrip, statementCache2)---- * Construction---- |--- Execute a statement in pipelining mode.-statement ::-  Statement.Statement params result ->-  params ->-  Pipeline result-statement stmt params =-  Pipeline 1 (Statement.unknownTypes stmt) run-  where-    sql = Statement.sql stmt-    run offset usePreparedStatements oidCache =-      if prepare-        then runPrepared-        else runUnprepared-      where-        (oidList, valueAndFormatList) =-          Statement.compilePreparedStatementData stmt oidCache params--        pqOidList =-          fmap (Pq.Oid . fromIntegral) oidList--        prepare =-          usePreparedStatements && Statement.isPrepared stmt--        context soFarStatementCache =-          Context-            offset-            sql-            (Statement.printer stmt params)-            prepare-            soFarStatementCache--        runPrepared statementCache =-          (roundtrip, newStatementCache)-          where-            (isNew, remoteKey, newStatementCache) =-              case StatementCache.lookup sql pqOidList statementCache of-                Just remoteKey -> (False, remoteKey, statementCache)-                Nothing ->-                  let (remoteKey, newStatementCache) = StatementCache.insert sql pqOidList statementCache-                   in (True, remoteKey, newStatementCache)--            roundtrip =-              when-                isNew-                (Comms.Roundtrip.prepare (context statementCache) remoteKey sql pqOidList)-                *> Comms.Roundtrip.queryPrepared (context newStatementCache) remoteKey encodedParams Pq.Binary decoder'-              where-                encodedParams =-                  valueAndFormatList-                    & fmap (fmap (\(bytes, format) -> (bytes, bool Pq.Binary Pq.Text format)))--        runUnprepared statementCache =-          (roundtrip, statementCache)-          where-            roundtrip =-              Comms.Roundtrip.queryParams (context statementCache) sql encodedParams Pq.Binary decoder'-              where-                encodedParams =-                  Statement.compileUnpreparedStatementData stmt oidCache params-                    & fmap (fmap (\(oid, bytes, format) -> (Pq.Oid (fromIntegral oid), bytes, bool Pq.Binary Pq.Text format)))--        decoder' =-          RequestingOid.toBase (Statement.decoder stmt) oidCache
− src/library/Hasql/Engine/Contexts/Session.hs 
@@ -1,208 +0,0 @@-module Hasql.Engine.Contexts.Session where--import Data.HashMap.Strict qualified as HashMap-import Data.HashSet qualified as HashSet-import Hasql.Codecs.RequestingOid qualified as RequestingOid-import Hasql.Codecs.Vocab.OidCache qualified as OidCache-import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName-import Hasql.Comms.Roundtrip qualified as Comms.Roundtrip-import Hasql.Engine.Contexts.Pipeline qualified as Pipeline-import Hasql.Engine.Errors qualified as Errors-import Hasql.Engine.PqProcedures.SelectTypeInfo qualified as PqProcedures.SelectTypeInfo-import Hasql.Engine.Statement qualified as Statement-import Hasql.Engine.Structures.ConnectionState qualified as ConnectionState-import Hasql.Engine.Structures.StatementCache qualified as StatementCache-import Hasql.Platform.Prelude-import Hasql.Pq qualified as Pq---- |--- A sequence of operations to be executed in the context of a single database connection with exclusive access to it.------ Construct sessions using helpers in this module such as--- 'statement', 'pipeline' and 'script', or use 'onLibpqConnection' for a low-level--- escape hatch.------ To actually execute a 'Session' use 'Hasql.Connection.use', which manages--- concurrent access to the shared connection state and returns either a--- 'Errors.SessionError' or the result:------ > result <- Hasql.Connection.use connection mySession------ Note: while most session errors are returned as values, user code executed--- inside a session may still throw exceptions; in that case the driver will--- reset the connection to a clean state.-newtype Session a-  = Session (ConnectionState.ConnectionState -> IO (Either Errors.SessionError a, ConnectionState.ConnectionState))-  deriving-    (Functor, Applicative, Monad, MonadError Errors.SessionError, MonadIO)-    via (ExceptT Errors.SessionError (StateT ConnectionState.ConnectionState IO))--run :: Session a -> ConnectionState.ConnectionState -> IO (Either Errors.SessionError a, ConnectionState.ConnectionState)-run (Session session) connectionState = session connectionState---- |--- Possibly a multi-statement query,--- which however cannot be parameterized or prepared,--- nor can any results of it be collected.-script :: ByteString -> Session ()-script sql =-  Session \connectionState -> do-    let connection = ConnectionState.connection connectionState-    result <- Comms.Roundtrip.toSerialIO (Comms.Roundtrip.script (Just sql) sql) connection-    case result of-      Left err -> case err of-        Comms.Roundtrip.ClientError _ details -> do-          pure-            ( Left (Errors.ConnectionSessionError (maybe "" decodeUtf8Lenient details)),-              connectionState-            )-        Comms.Roundtrip.ServerError recvError ->-          pure-            ( Left (Errors.fromRecvErrorInScript sql recvError),-              connectionState-            )-      Right () ->-        pure-          ( Right (),-            connectionState-          )---- |--- Execute a single statement by providing parameters to it,--- running it directly in serial mode.------ Each execution is a dedicated network roundtrip. The first execution of a--- preparable statement costs an extra roundtrip (a separate @PARSE@), after--- which steady-state execution is a single roundtrip.------ To batch multiple statements into fewer roundtrips, use 'pipeline' instead.-statement ::-  Statement.Statement params result ->-  params ->-  Session result-statement stmt params =-  Session \connectionState -> do-    let usePreparedStatements = ConnectionState.preparedStatements connectionState-        statementCache = ConnectionState.statementCache connectionState-        oidCache = ConnectionState.oidCache connectionState-        connection = ConnectionState.connection connectionState-        sql = Statement.sql stmt-        missingTypes = OidCache.selectUnknownNames (Statement.unknownTypes stmt) oidCache-    resolvedOidCache <--      if HashSet.null missingTypes-        then pure (Right oidCache)-        else do-          oidCacheUpdates <--            PqProcedures.SelectTypeInfo.run connection (PqProcedures.SelectTypeInfo.SelectTypeInfo missingTypes)-          pure $ case oidCacheUpdates of-            Left err -> Left err-            Right oidCacheUpdates ->-              let foundTypes = HashMap.keysSet oidCacheUpdates-                  notFoundTypes = HashSet.difference missingTypes foundTypes-               in if not (HashSet.null notFoundTypes)-                    then Left (Errors.MissingTypesSessionError (HashSet.map Vocab.QualifiedTypeName.toNameTuple notFoundTypes))-                    else Right (oidCache <> OidCache.fromHashMap oidCacheUpdates)-    case resolvedOidCache of-      Left err -> pure (Left err, connectionState)-      Right newOidCache -> do-        let decoder' = RequestingOid.toBase (Statement.decoder stmt) newOidCache-            prepared = usePreparedStatements && Statement.isPrepared stmt-            -- Single-statement context for error reporting:-            -- total statements 1, index 0.-            context = Just (1, 0, sql, Statement.printer stmt params, prepared)-            mapError = \case-              Comms.Roundtrip.ClientError _ details ->-                Errors.ConnectionSessionError (maybe "" decodeUtf8Lenient details)-              Comms.Roundtrip.ServerError recvError ->-                Errors.fromRecvError recvError-            withState (result, newStatementCache) =-              ( first mapError result,-                connectionState-                  { ConnectionState.oidCache = newOidCache,-                    ConnectionState.statementCache = newStatementCache-                  }-              )-        fmap withState-          $ if prepared-            then do-              let (oidList, valueAndFormatList) =-                    Statement.compilePreparedStatementData stmt newOidCache params-                  pqOidList = fmap (Pq.Oid . fromIntegral) oidList-                  encodedParams =-                    valueAndFormatList-                      & fmap (fmap (\(bytes, format) -> (bytes, bool Pq.Binary Pq.Text format)))-                  execute remoteKey =-                    Comms.Roundtrip.toSerialIO-                      (Comms.Roundtrip.queryPrepared context remoteKey encodedParams Pq.Binary decoder')-                      connection-              case StatementCache.lookup sql pqOidList statementCache of-                Just remoteKey -> do-                  result <- execute remoteKey-                  pure (result, statementCache)-                Nothing -> do-                  let (remoteKey, newStatementCache) = StatementCache.insert sql pqOidList statementCache-                  -- In non-pipeline mode PARSE and EXECUTE cannot be sent-                  -- back-to-back, so prepare in a dedicated roundtrip first.-                  prepareResult <--                    Comms.Roundtrip.toSerialIO-                      (Comms.Roundtrip.prepare context remoteKey sql pqOidList)-                      connection-                  case prepareResult of-                    -- PARSE failed: the statement is not on the server, so-                    -- keep the old cache (no entry committed).-                    Left err -> pure (Left err, statementCache)-                    Right () -> do-                      -- PARSE succeeded, so the statement is on the server-                      -- under remoteKey regardless of whether EXECUTE then-                      -- fails. Commit the cache so a later use hits it instead-                      -- of re-issuing PARSE for an already-existing name.-                      result <- execute remoteKey-                      pure (result, newStatementCache)-            else do-              let encodedParams =-                    Statement.compileUnpreparedStatementData stmt newOidCache params-                      & fmap (fmap (\(oid, bytes, format) -> (Pq.Oid (fromIntegral oid), bytes, bool Pq.Binary Pq.Text format)))-              result <--                Comms.Roundtrip.toSerialIO-                  (Comms.Roundtrip.queryParams context sql encodedParams Pq.Binary decoder')-                  connection-              pure (result, statementCache)---- |--- Execute a pipeline.-pipeline :: Pipeline.Pipeline result -> Session result-pipeline pipeline = Session \connectionState -> do-  let usePreparedStatements = ConnectionState.preparedStatements connectionState-      statementCache = ConnectionState.statementCache connectionState-      oidCache = ConnectionState.oidCache connectionState-      pqConnection = ConnectionState.connection connectionState-   in do-        (result, newOidCache, newStatementCache) <- Pipeline.run pipeline usePreparedStatements pqConnection oidCache statementCache-        let newConnectionState =-              connectionState-                { ConnectionState.oidCache = newOidCache,-                  ConnectionState.statementCache = newStatementCache-                }--        pure (result, newConnectionState)---- |--- Execute an operation on the raw libpq connection possibly producing an error and updating the connection.--- This is a low-level escape hatch for custom integrations.------ You can supply a new connection in the result to replace it in the running Hasql connection.--- The responsibility to close the old libpq connection is on you.--- Otherwise, just return the same connection you've received.------ Producing a 'Left' value will cause the session to fail with the given error.--- Regardless of success or failure, the connection will be replaced with the one you return.------ Throwing exceptions is okay. It will lead to the connection getting reset.-onLibpqConnection ::-  (Pq.Connection -> IO (Either Errors.SessionError a, Pq.Connection)) ->-  Session a-onLibpqConnection f = Session \connectionState -> do-  let pqConnection = ConnectionState.connection connectionState-  (result, newConnection) <- f pqConnection-  let newState = ConnectionState.setConnection newConnection connectionState-  pure (result, newState)
− src/library/Hasql/Engine/Decoders/Result.hs 
@@ -1,95 +0,0 @@-module Hasql.Engine.Decoders.Result where--import Hasql.Codecs.RequestingOid qualified as RequestingOid-import Hasql.Comms.ResultDecoder qualified as ResultDecoder-import Hasql.Engine.Decoders.Row (Row (..))-import Hasql.Engine.Decoders.Row qualified as Row-import Hasql.Platform.Prelude---- |--- Decoder of a query result.-newtype Result a-  = Result (RequestingOid.RequestingOid (ResultDecoder.ResultDecoder a))-  deriving-    (Functor, Applicative, Filterable)-    via (Compose RequestingOid.RequestingOid ResultDecoder.ResultDecoder)--unwrap :: Result a -> RequestingOid.RequestingOid (ResultDecoder.ResultDecoder a)-unwrap (Result decoder) = decoder---- * Construction---- |--- Decode no value from the result.------ Useful for statements like @INSERT@ or @CREATE@.-{-# INLINE noResult #-}-noResult :: Result ()-noResult =-  Result (RequestingOid.lift ResultDecoder.ok)---- |--- Get the amount of rows affected by such statements as--- @UPDATE@ or @DELETE@.-{-# INLINE rowsAffected #-}-rowsAffected :: Result Int64-rowsAffected =-  Result (RequestingOid.lift ResultDecoder.rowsAffected)---- |--- Exactly one row.--- Will raise the 'Hasql.Errors.UnexpectedRowCountStatementError' error if it's any other.-{-# INLINE singleRow #-}-singleRow :: Row a -> Result a-singleRow decoder =-  Result (fmap ResultDecoder.single (Row.toDecoder decoder))--refineResult :: (a -> Either Text b) -> Result a -> Result b-refineResult refiner (Result decoder) =-  Result (fmap (ResultDecoder.refine refiner) decoder)---- ** Multi-row traversers---- |--- Foldl multiple rows.-{-# INLINE foldlRows #-}-foldlRows :: (a -> b -> a) -> a -> Row b -> Result a-foldlRows step init decoder =-  Result-    (fmap (ResultDecoder.foldl step init) (Row.toDecoder decoder))---- |--- Foldr multiple rows.-{-# INLINE foldrRows #-}-foldrRows :: (b -> a -> a) -> a -> Row b -> Result a-foldrRows step init decoder =-  Result-    (fmap (ResultDecoder.foldr step init) (Row.toDecoder decoder))---- ** Specialized multi-row results---- |--- Maybe one row or none.-{-# INLINE rowMaybe #-}-rowMaybe :: Row a -> Result (Maybe a)-rowMaybe decoder =-  Result-    (fmap ResultDecoder.maybe (Row.toDecoder decoder))---- |--- Zero or more rows packed into the vector.------ It's recommended to prefer this function to 'rowList',--- since it performs notably better.-{-# INLINE rowVector #-}-rowVector :: Row a -> Result (Vector a)-rowVector decoder =-  Result-    (fmap ResultDecoder.vector (Row.toDecoder decoder))---- |--- Zero or more rows packed into the list.-{-# INLINE rowList #-}-rowList :: Row a -> Result [a]-rowList =-  foldrRows strictCons []
− src/library/Hasql/Engine/Decoders/Row.hs 
@@ -1,65 +0,0 @@-module Hasql.Engine.Decoders.Row where--import Hasql.Codecs.Decoders-import Hasql.Codecs.Decoders.Value qualified as Value-import Hasql.Codecs.RequestingOid qualified as RequestingOid-import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName-import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo-import Hasql.Comms.RowDecoder qualified-import Hasql.Platform.Prelude-import PostgreSQL.Binary.Decoding qualified as Binary---- |--- 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 (RequestingOid.RequestingOid (Hasql.Comms.RowDecoder.RowDecoder a))-  deriving-    (Functor, Applicative, Filterable)-    via (Compose RequestingOid.RequestingOid Hasql.Comms.RowDecoder.RowDecoder)--toDecoder ::-  Row a ->-  RequestingOid.RequestingOid (Hasql.Comms.RowDecoder.RowDecoder a)-toDecoder (Row f) = f---- |--- Lift an individual value decoder to a composable row decoder.-{-# INLINE column #-}-column :: NullableOrNot Value a -> Row a-column = \case-  Nullable valueDecoder ->-    Row case Value.toOid valueDecoder of-      Just oid ->-        fmap-          (Hasql.Comms.RowDecoder.nullableColumn (Just oid) . Binary.valueParser)-          (Value.toDecoder valueDecoder)-      Nothing -> do-        RequestingOid.hoistLookingUp-          (Vocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema valueDecoder) (Value.toTypeName valueDecoder))-          ( \lookupResult decoder ->-              Hasql.Comms.RowDecoder.nullableColumn (Just (chooseLookedUpOid valueDecoder lookupResult)) (Binary.valueParser decoder)-          )-          (Value.toDecoder valueDecoder)-  NonNullable valueDecoder ->-    Row case Value.toOid valueDecoder of-      Just oid ->-        fmap-          (Hasql.Comms.RowDecoder.nonNullableColumn (Just oid) . Binary.valueParser)-          (Value.toDecoder valueDecoder)-      Nothing -> do-        RequestingOid.hoistLookingUp-          (Vocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema valueDecoder) (Value.toTypeName valueDecoder))-          (\lookupResult decoder -> Hasql.Comms.RowDecoder.nonNullableColumn (Just (chooseLookedUpOid valueDecoder lookupResult)) (Binary.valueParser decoder))-          (Value.toDecoder valueDecoder)-  where-    chooseLookedUpOid valueDecoder typeInfo =-      if Value.toDimensionality valueDecoder > 0-        then Vocab.TypeInfo.toArrayOid typeInfo-        else Vocab.TypeInfo.toBaseOid typeInfo
− src/library/Hasql/Engine/Errors.hs 
@@ -1,473 +0,0 @@-module Hasql.Engine.Errors where--import Hasql.Comms.Recv qualified-import Hasql.Comms.ResultDecoder qualified-import Hasql.Comms.Roundtrip qualified-import Hasql.Comms.RowReader qualified-import Hasql.Platform.Prelude-import TextBuilder qualified---- * Error types---- |--- Error that occurs when attempting to establish a database connection.------ These errors can occur when calling 'Hasql.Connection.acquire'.--- Connection errors are categorized into several types to help with--- error handling and logging.-data ConnectionError-  = -- | Network-level error while connecting to the database server.-    ---    -- This typically indicates issues like:-    ---    -- * Server is not reachable (wrong host\/port or server is down)-    -- * Network connectivity problems-    -- * Firewall blocking the connection-    -- * Connection timeout-    ---    -- These errors are transient and the operation can be retried.-    NetworkingConnectionError-      -- | Human readable details intended for logging.-      Text-  | -- | Authentication failed when connecting to the database.-    ---    -- This typically indicates issues like:-    ---    -- * Invalid username or password-    -- * User does not have permission to access the database-    -- * Authentication method mismatch (e.g., server requires SSL but client doesn't use it)-    ---    -- These errors are not transient and require fixing the credentials or permissions.-    AuthenticationConnectionError-      -- | Human readable details intended for logging.-      Text-  | -- | Compatibility issue between client and server.-    ---    -- This typically indicates issues like:-    ---    -- * Server version is too old or too new-    -- * Required PostgreSQL features are not available-    -- * Protocol version mismatch-    ---    -- These errors are not transient and require upgrading/downgrading-    -- the server or client.-    CompatibilityConnectionError-      -- | Human readable details intended for logging.-      Text-  | -- | Uncategorized error coming from @libpq@.-    ---    -- This is a catch-all for connection errors that don't fit into other categories.-    -- The error message may be empty if @libpq@ doesn't provide details.-    ---    -- These errors are not transient by default.-    OtherConnectionError-      -- | Human readable details intended for logging. May be empty.-      Text-  deriving stock (Show, Eq)---- |--- Error that occurs during session execution.------ A session is a batch of actions executed in a database connection context.--- Session errors can occur due to statement failures, connection issues,--- missing types, or internal driver errors.------ Session errors provide detailed context to help diagnose problems,--- including SQL text, parameters, and the location of the error within--- a pipeline of statements.-data SessionError-  = -- | An error occurred while executing a statement in the session.-    ---    -- This wraps statement-level errors and provides additional context about:-    ---    -- * Which statement in the pipeline failed (when multiple statements are batched)-    -- * The SQL text and parameters of the failing statement-    -- * Whether the statement was prepared or unprepared-    ---    -- The error message includes formatted output showing all this context,-    -- making it easier to diagnose issues in production.-    StatementSessionError-      -- | Total number of statements in the running pipeline. 1 if it's executed alone.-      Int-      -- | 0-based index of the statement that failed. 0 if it's executed alone.-      Int-      -- | SQL template of the failing statement.-      Text-      -- | Parameter values as text (for logging purposes).-      [Text]-      -- | Whether the statement was executed as a prepared one.-      Bool-      -- | The underlying statement error.-      StatementError-  | -- | An error occurred while executing a script.-    ---    -- Scripts are multi-statement SQL texts executed via 'Hasql.Session.script'.-    -- Unlike regular statements, scripts don't support parameters or result decoding,-    -- and errors are limited to server-reported issues.-    ScriptSessionError-      -- | The SQL text of the script.-      Text-      -- | The server error that occurred.-      ServerError-  | -- | A connection-level error occurred during session execution.-    ---    -- This indicates that the connection to the database was lost or-    -- became unusable during the session. These errors are transient-    -- and the operation can be retried with a new connection.-    ---    -- Note: As of version 1.10, connections recover from async exceptions-    -- without resetting, preserving connection-local state.-    ConnectionSessionError-      -- | Human-readable details about the connection error.-      Text-  | -- | One or more types referenced in the statement could not be found in the database.-    ---    -- This occurs when using custom types (enums, composite types, domains) that-    -- are resolved by name at runtime, but the types don't exist in the database.-    ---    -- To fix this error:-    ---    -- * Ensure the types are defined in the database-    -- * Check that schema search paths are configured correctly-    -- * Verify that the type names in your code match those in the database-    MissingTypesSessionError-      -- | Set of (schema name, type name) pairs that could not be found.-      ---      -- Schema name is 'Nothing' when the type was looked up without a schema qualifier.-      (HashSet (Maybe Text, Text))-  | -- | An internal driver error occurred.-    ---    -- This indicates either:-    ---    -- * A bug in Hasql-    -- * The PostgreSQL server misbehaving-    -- * An unexpected response from the server-    ---    -- If you encounter this error, please report it as a bug.-    DriverSessionError-      -- | Human-readable details about what went wrong.-      Text-  deriving stock (Show, Eq)---- |--- Error that occurs when executing a single statement.------ Statement errors can be caused by server-side issues (SQL errors, constraint violations)--- or by mismatches between the decoder specification and the actual result structure--- (wrong number of rows/columns, type mismatches, or cell-level decoding failures).-data StatementError-  = -- | The server rejected the statement and returned an error.-    ---    -- This includes SQL syntax errors, constraint violations, permission errors,-    -- and any other error reported by PostgreSQL during statement execution.-    ServerStatementError ServerError-  | -- | The statement returned a different number of rows than expected.-    ---    -- This occurs when using result decoders like @Decoders.singleRow@ or-    -- @Decoders.rowsAffectedAtLeast@ that have specific row count expectations.-    UnexpectedRowCountStatementError-      -- | Expected minimum number of rows.-      Int-      -- | Expected maximum number of rows.-      Int-      -- | Actual number of rows returned.-      Int-  | -- | The statement returned a different number of columns than expected.-    ---    -- This indicates a mismatch between the decoder specification and the-    -- actual result structure, possibly due to:-    ---    -- * Schema changes (columns added or removed)-    -- * Wrong query (selecting different columns than expected)-    -- * Decoder configuration error-    UnexpectedColumnCountStatementError-      -- | Expected number of columns.-      Int-      -- | Actual number of columns returned.-      Int-  | -- | A column has a different type than expected.-    ---    -- This occurs when the decoder expects a specific PostgreSQL type (by OID)-    -- but the actual column has a different type. This can happen due to:-    ---    -- * Schema changes (column type changed)-    -- * Wrong query (selecting wrong column or using a cast)-    -- * Decoder configuration error-    ---    -- Note: As of version 1.10, Hasql performs strict type checking and will-    -- report this error instead of attempting automatic type coercion.-    UnexpectedColumnTypeStatementError-      -- | 0-based column index where the type mismatch occurred.-      Int-      -- | Expected PostgreSQL type OID.-      Word32-      -- | Actual PostgreSQL type OID of the column.-      Word32-  | -- | An error occurred while decoding a specific row.-    ---    -- This wraps errors that occur at the row or cell level, providing-    -- context about which row failed.-    RowStatementError-      -- | 0-based index of the row that failed to decode.-      Int-      -- | The underlying row-level error.-      RowError-  | -- | The database returned an unexpected result structure.-    ---    -- This is a catch-all error that indicates either:-    ---    -- * An improper statement (e.g., executing a query that doesn't match expectations)-    -- * A schema mismatch between the code and database-    -- * A bug in Hasql or server misbehavior-    UnexpectedResultStatementError-      -- | Human-readable details about what went wrong.-      Text-  deriving stock (Show, Eq)---- |--- Error reported by the PostgreSQL server when executing a statement.------ The server provides structured error information including error codes--- (SQL state), messages, and optional context like hints and position information.------ For a complete list of PostgreSQL error codes, see:--- <https://www.postgresql.org/docs/current/errcodes-appendix.html>-data ServerError-  = ServerError-      -- | SQL State Code (SQLSTATE).-      ---      -- A five-character code that identifies the error class and condition.-      -- Examples: @\"23505\"@ (unique violation), @\"42P01\"@ (undefined table).-      Text-      -- | Primary error message.-      ---      -- A human-readable description of the error.-      Text-      -- | Optional detailed error information.-      ---      -- Additional context about the error, if available.-      (Maybe Text)-      -- | Optional hint for resolving the error.-      ---      -- A suggestion for how to fix the problem, if available.-      (Maybe Text)-      -- | Optional position in the SQL string where the error occurred.-      ---      -- A 1-based character index into the SQL string, if the error-      -- relates to a specific location in the query.-      (Maybe Int)-  deriving stock (Show, Eq)---- |--- Error that occurs when decoding a result row.------ Row errors indicate problems when processing an individual row from the result set,--- either at the cell level or during row refinement/validation.-data RowError-  = -- | An error occurred while decoding a specific cell in the row.-    ---    -- This wraps cell-level errors (null handling, deserialization failures)-    -- and provides context about which column failed and its type.-    CellRowError-      -- | 0-based index of the column where the error occurred.-      Int-      -- | PostgreSQL type OID of the column, as reported by the server.-      Word32-      -- | The underlying cell-level error.-      CellError-  | -- | A refinement or validation error when processing the row.-    ---    -- This occurs when using refinement functions in row decoders-    -- (e.g., with 'Decoders.refineRow') to validate or transform-    -- decoded values. The refinement function rejected the row data.-    RefinementRowError-      -- | Human-readable details about why the refinement failed.-      Text-  deriving stock (Show, Eq)---- |--- Error that occurs when decoding a single cell (column value) in a result row.------ Cell errors indicate problems with individual values returned by the database,--- such as unexpected nulls or failures in binary deserialization.-data CellError-  = -- | A NULL value was encountered when a non-NULL value was expected.-    ---    -- This occurs when using non-nullable decoders (e.g., @Decoders.nonNullable@)-    -- on a column that contains a NULL value.-    UnexpectedNullCellError-  | -- | Failed to deserialize the cell value from its binary representation.-    ---    -- This can occur when:-    ---    -- * The binary data is corrupted-    -- * The decoder doesn't match the actual data type-    -- * The data format is invalid for the expected type-    DeserializationCellError-      -- | Human-readable error message describing what went wrong.-      Text-  deriving stock (Show, Eq)--fromRoundtripError :: Hasql.Comms.Roundtrip.Error context -> SessionError-fromRoundtripError = \case-  Hasql.Comms.Roundtrip.ClientError _context details ->-    ConnectionSessionError (maybe "" decodeUtf8Lenient details)-  Hasql.Comms.Roundtrip.ServerError recvError ->-    fromRecvError (Nothing <$ recvError)--fromRecvError :: Hasql.Comms.Recv.Error (Maybe (Int, Int, ByteString, [Text], Bool)) -> SessionError-fromRecvError = \case-  Hasql.Comms.Recv.ResultError location _resultOffset resultError ->-    case location of-      Nothing ->-        (DriverSessionError . TextBuilder.toText . mconcat)-          [ "Unexpected error outside of statement context. ",-            "This indicates a bug in Hasql or the server misbehaving. ",-            "Error: ",-            TextBuilder.string (show resultError)-          ]-      Just (totalStatements, statementIndex, sql, parameters, prepared) ->-        StatementSessionError-          totalStatements-          statementIndex-          (decodeUtf8Lenient sql)-          parameters-          prepared-          (fromStatementResultError resultError)-  Hasql.Comms.Recv.NoResultsError location details ->-    case location of-      Nothing ->-        (DriverSessionError . TextBuilder.toText . mconcat)-          [ "Unexpectedly got no results outside of statement context. ",-            "This indicates a bug in Hasql or the server misbehaving. ",-            "Details: ",-            TextBuilder.string (show details)-          ]-      Just (totalStatements, statementIndex, sql, parameters, prepared) ->-        StatementSessionError-          totalStatements-          statementIndex-          (decodeUtf8Lenient sql)-          parameters-          prepared-          (UnexpectedRowCountStatementError 1 1 0)-  Hasql.Comms.Recv.TooManyResultsError location actual ->-    case location of-      Nothing ->-        (DriverSessionError . TextBuilder.toText . mconcat)-          [ "Unexpectedly got too many results outside of statement context. ",-            "This indicates a bug in Hasql or the server misbehaving. ",-            "Amount: ",-            TextBuilder.decimal actual-          ]-      Just (totalStatements, statementIndex, sql, parameters, prepared) ->-        StatementSessionError-          totalStatements-          statementIndex-          (decodeUtf8Lenient sql)-          parameters-          prepared-          (UnexpectedRowCountStatementError 1 1 actual)--fromStatementResultError :: Hasql.Comms.ResultDecoder.Error -> StatementError-fromStatementResultError = \case-  Hasql.Comms.ResultDecoder.ServerError code message detail hint position ->-    ServerStatementError-      ( ServerError-          (decodeUtf8Lenient code)-          (decodeUtf8Lenient message)-          (fmap decodeUtf8Lenient detail)-          (fmap decodeUtf8Lenient hint)-          position-      )-  Hasql.Comms.ResultDecoder.UnexpectedResult msg ->-    UnexpectedResultStatementError msg-  Hasql.Comms.ResultDecoder.UnexpectedRowCount actual ->-    UnexpectedRowCountStatementError 1 1 actual-  Hasql.Comms.ResultDecoder.UnexpectedColumnCount expected actual ->-    UnexpectedColumnCountStatementError expected actual-  Hasql.Comms.ResultDecoder.DecoderTypeMismatch colIdx expectedOid actualOid ->-    UnexpectedColumnTypeStatementError-      colIdx-      expectedOid-      actualOid-  Hasql.Comms.ResultDecoder.RowError rowIndex rowError ->-    case rowError of-      Hasql.Comms.RowReader.CellError column oid cellErr ->-        RowStatementError-          rowIndex-          ( CellRowError-              column-              oid-              ( case cellErr of-                  Hasql.Comms.RowReader.DecodingCellError msg -> DeserializationCellError msg-                  Hasql.Comms.RowReader.UnexpectedNullCellError -> UnexpectedNullCellError-              )-          )-      Hasql.Comms.RowReader.RefinementError msg ->-        RowStatementError-          rowIndex-          (RefinementRowError msg)--fromRecvErrorInScript :: ByteString -> Hasql.Comms.Recv.Error (Maybe ByteString) -> SessionError-fromRecvErrorInScript scriptSql = \case-  Hasql.Comms.Recv.ResultError _ _ resultError ->-    case resultError of-      Hasql.Comms.ResultDecoder.ServerError code message detail hint position ->-        ScriptSessionError-          (decodeUtf8Lenient scriptSql)-          ( ServerError-              (decodeUtf8Lenient code)-              (decodeUtf8Lenient message)-              (fmap decodeUtf8Lenient detail)-              (fmap decodeUtf8Lenient hint)-              position-          )-      Hasql.Comms.ResultDecoder.UnexpectedResult msg ->-        (DriverSessionError . TextBuilder.toText . mconcat)-          [ "Unexpected result in script: ",-            TextBuilder.text msg-          ]-      Hasql.Comms.ResultDecoder.UnexpectedRowCount actual ->-        (DriverSessionError . TextBuilder.toText . mconcat)-          [ "Unexpected amount of rows in script: ",-            TextBuilder.decimal actual-          ]-      Hasql.Comms.ResultDecoder.UnexpectedColumnCount expected actual ->-        (DriverSessionError . TextBuilder.toText . mconcat)-          [ "Unexpected amount of columns in script: expected ",-            TextBuilder.decimal expected,-            ", got ",-            TextBuilder.decimal actual-          ]-      Hasql.Comms.ResultDecoder.DecoderTypeMismatch colIdx expectedOid actualOid ->-        (DriverSessionError . TextBuilder.toText . mconcat)-          [ "Decoder type mismatch in script: expected OID ",-            TextBuilder.string (show expectedOid),-            " at column ",-            TextBuilder.decimal colIdx,-            ", got ",-            TextBuilder.string (show actualOid)-          ]-      Hasql.Comms.ResultDecoder.RowError rowIndex rowError ->-        (DriverSessionError . TextBuilder.toText . mconcat)-          [ "Row error in script at row ",-            TextBuilder.decimal rowIndex,-            ": ",-            TextBuilder.string (show rowError)-          ]-  Hasql.Comms.Recv.NoResultsError _ details ->-    (DriverSessionError . TextBuilder.toText . mconcat)-      [ "Got no results in script.",-        " This indicates a bug in Hasql or the server misbehaving.",-        details-          & filter (/= "")-          & foldMap (mappend " Details: " . TextBuilder.text . decodeUtf8Lenient)-      ]-  Hasql.Comms.Recv.TooManyResultsError _ actual ->-    (DriverSessionError . TextBuilder.toText . mconcat)-      [ "Got too many results in script. ",-        "This indicates a bug in Hasql or the server misbehaving. ",-        "Amount: ",-        TextBuilder.decimal actual-      ]
− src/library/Hasql/Engine/PqProcedures/SelectTypeInfo.hs 
@@ -1,118 +0,0 @@-module Hasql.Engine.PqProcedures.SelectTypeInfo-  ( SelectTypeInfo (..),-    SelectTypeInfoResult,-    run,-  )-where--import Data.HashMap.Strict qualified as HashMap-import Data.HashSet qualified as HashSet-import Hasql.Codecs.Decoders.Value qualified as Decoders.Value-import Hasql.Codecs.Vocab qualified as Vocab-import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName-import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo-import Hasql.Comms.ResultDecoder qualified-import Hasql.Comms.Roundtrip qualified-import Hasql.Comms.RowDecoder qualified-import Hasql.Engine.Errors qualified as Errors-import Hasql.Platform.Prelude-import Hasql.Pq qualified as Pq-import PostgreSQL.Binary.Encoding qualified as Binary--newtype SelectTypeInfo = SelectTypeInfo-  { -- | Set of (schema name, type name) pairs to look up.-    keys :: HashSet Vocab.QualifiedTypeName-  }---- | Result maps (schema name, type name) pairs to TypeInfo (scalar OID, array OID).-type SelectTypeInfoResult =-  HashMap Vocab.QualifiedTypeName Vocab.TypeInfo.TypeInfo--run :: Pq.Connection -> SelectTypeInfo -> IO (Either Errors.SessionError SelectTypeInfoResult)-run connection (SelectTypeInfo keys) =-  if HashSet.null keys-    then pure (Right HashMap.empty)-    else-      first Errors.fromRoundtripError-        <$> Hasql.Comms.Roundtrip.toSerialIO (roundtrip (SelectTypeInfo keys)) connection--sql :: ByteString-sql =-  "with\n\-  \  inputs as (\n\-  \    select *\n\-  \    from unnest($1, $2) as x(schema_name, type_name)\n\-  \  ),\n\-  \  unnamespaced_results as (\n\-  \    select\n\-  \      null :: text as schema_name,\n\-  \      pg_type.typname :: text as type_name,\n\-  \      pg_type.oid :: int4 as type_oid,\n\-  \      pg_type.typarray :: int4 as array_oid\n\-  \    from inputs\n\-  \    join pg_type on pg_type.oid = to_regtype(inputs.type_name)\n\-  \    where inputs.schema_name is null\n\-  \  ),\n\-  \  namespaced_results as (\n\-  \    select\n\-  \      pg_namespace.nspname :: text as schema_name,\n\-  \      pg_type.typname :: text as type_name,\n\-  \      pg_type.oid :: int4 as type_oid,\n\-  \      pg_type.typarray :: int4 as array_oid\n\-  \    from inputs\n\-  \    join pg_namespace on pg_namespace.nspname = inputs.schema_name\n\-  \    join pg_type\n\-  \      on pg_type.typname = inputs.type_name\n\-  \      and pg_type.typnamespace = pg_namespace.oid\n\-  \    where inputs.schema_name is not null\n\-  \  )\n\-  \select * from unnamespaced_results\n\-  \union\n\-  \select * from namespaced_results"--roundtrip :: SelectTypeInfo -> Hasql.Comms.Roundtrip.Roundtrip () SelectTypeInfoResult-roundtrip params =-  Hasql.Comms.Roundtrip.queryParams () sql (encodeParams params) Pq.Binary decoder---- | Encode the two text-array parameters directly.--- Text OID is 25; text-array OID is 1009.-encodeParams :: SelectTypeInfo -> [Maybe (Pq.Oid, ByteString, Pq.Format)]-encodeParams (SelectTypeInfo keys) =-  let (schemaNames, typeNames) = unzip (fmap Vocab.QualifiedTypeName.toNameTuple (HashSet.toList keys))-      schemaArray = Binary.encodingBytes (Binary.array 25 (encodeTextArray (encodeMaybeText schemaNames)))-      typeArray = Binary.encodingBytes (Binary.array 25 (encodeTextArray (fmap (Binary.encodingArray . Binary.text_strict) typeNames)))-   in [ Just (Pq.Oid 1009, schemaArray, Pq.Binary),-        Just (Pq.Oid 1009, typeArray, Pq.Binary)-      ]-  where-    encodeTextArray elements =-      Binary.dimensionArray foldl' id elements-    encodeMaybeText =-      fmap \case-        Nothing -> Binary.nullArray-        Just text -> Binary.encodingArray (Binary.text_strict text)--decoder :: Hasql.Comms.ResultDecoder.ResultDecoder SelectTypeInfoResult-decoder =-  Hasql.Comms.ResultDecoder.foldl step HashMap.empty rowDecoder-  where-    step acc (schemaName, typeName, typeOid, arrayOid) =-      HashMap.insert (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) (Vocab.TypeInfo.TypeInfo typeOid arrayOid) acc--rowDecoder :: Hasql.Comms.RowDecoder.RowDecoder (Maybe Text, Text, Word32, Word32)-rowDecoder =-  (,,,)-    <$> nullableColumn Decoders.Value.text-    <*> nonNullableColumn Decoders.Value.text-    <*> nonNullableColumn (fromIntegral <$> Decoders.Value.int4)-    <*> nonNullableColumn (fromIntegral <$> Decoders.Value.int4)-  where-    nullableColumn valueDecoder =-      Hasql.Comms.RowDecoder.nullableColumn-        (Decoders.Value.toBaseOid valueDecoder)-        (Decoders.Value.toByteStringParser valueDecoder mempty)--    nonNullableColumn valueDecoder =-      Hasql.Comms.RowDecoder.nonNullableColumn-        (Decoders.Value.toBaseOid valueDecoder)-        (Decoders.Value.toByteStringParser valueDecoder mempty)
− src/library/Hasql/Engine/Statement.hs 
@@ -1,188 +0,0 @@-module Hasql.Engine.Statement-  ( Statement (..),-    preparable,-    unpreparable,-    refineResult,-    toSql,-    compilePreparedStatementData,-    compileUnpreparedStatementData,-  )-where--import Data.Text.Encoding qualified as TextEncoding-import Data.Vector qualified as Vector-import Hasql.Codecs.Encoders.Params qualified as Params-import Hasql.Codecs.RequestingOid qualified as RequestingOid-import Hasql.Codecs.Vocab qualified as Vocab-import Hasql.Codecs.Vocab.OidCache qualified as Vocab.OidCache-import Hasql.Codecs.Vocab.ParamMeta (ParamMeta (..))-import Hasql.Codecs.Vocab.TypeRef qualified as Vocab.TypeRef-import Hasql.Comms.ResultDecoder qualified as ResultDecoder-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Engine.Decoders.Result qualified as Decoders.Result-import Hasql.Platform.Prelude---- |--- Specification of a strictly single-statement query, which can be parameterized and prepared.--- It encapsulates the mapping of parameters and results in association with an SQL template.------ Following is an example of a declaration of a prepared statement with its associated codecs.------ @--- selectSum :: 'Statement' (Int64, Int64) Int64--- selectSum =---   'preparable' sql encoder decoder---   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.nonNullable' Encoders.'Hasql.Encoders.int8'))---     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 params result-  = Statement-  { -- | SQL template pre-encoded as UTF-8 for execution.-    sql :: ByteString,-    -- | Frozen per-parameter metadata: type reference, dimensionality, text-format flag.-    -- Produced once at construction from the Params DList and reused across executions.-    columnsMetadata :: Vector ParamMeta,-    -- | Serialise params to encoded wire values given a resolved OID cache.-    serializer :: Vocab.OidCache -> params -> [Maybe ByteString],-    -- | Render params in human-readable form (for error reporting).-    printer :: params -> [Text],-    -- | Union of encoder and decoder unknown types, resolved once at construction.-    unknownTypes :: HashSet Vocab.QualifiedTypeName,-    -- | Unwrapped result decoder (RequestingOid layer already peeled from Result).-    decoder :: RequestingOid.RequestingOid (ResultDecoder.ResultDecoder result),-    -- | Whether this statement may be prepared on the server.-    isPrepared :: Bool-  }---- |--- Construct a preparable statement.------ Use this for statements that will be executed multiple times with different parameters.--- Preparable statements are cached by PostgreSQL, which avoids reconstructing the execution plan each time.------ Suitable for applications with a limited amount of queries that don't generate SQL dynamically.-preparable ::-  -- | SQL template with parameters in positional notation (@$1@, @$2@, etc.)-  Text ->-  -- | Parameters encoder-  Encoders.Params params ->-  -- | Result decoder-  Decoders.Result result ->-  Statement params result-preparable sqlText encoder resultDecoder =-  Statement-    { sql = TextEncoding.encodeUtf8 sqlText,-      columnsMetadata = Params.toColumnsMetadata encoder,-      serializer = Params.toSerializer encoder,-      printer = Params.toPrinter encoder,-      unknownTypes = Params.toUnknownTypes encoder <> RequestingOid.toUnknownTypes rawDecoder,-      decoder = rawDecoder,-      isPrepared = True-    }-  where-    rawDecoder = Decoders.Result.unwrap resultDecoder---- |--- Construct an unpreparable statement.------ Use this for statements that are dynamically generated or executed only once.--- Unpreparable statements are not cached by PostgreSQL.------ Suitable for dynamic SQL or one-off queries.-unpreparable ::-  -- | SQL template with parameters in positional notation (@$1@, @$2@, etc.)-  Text ->-  -- | Parameters encoder-  Encoders.Params params ->-  -- | Result decoder-  Decoders.Result result ->-  Statement params result-unpreparable sqlText encoder resultDecoder =-  Statement-    { sql = TextEncoding.encodeUtf8 sqlText,-      columnsMetadata = Params.toColumnsMetadata encoder,-      serializer = Params.toSerializer encoder,-      printer = Params.toPrinter encoder,-      unknownTypes = Params.toUnknownTypes encoder <> RequestingOid.toUnknownTypes rawDecoder,-      decoder = rawDecoder,-      isPrepared = False-    }-  where-    rawDecoder = Decoders.Result.unwrap resultDecoder--instance Functor (Statement params) where-  {-# INLINE fmap #-}-  fmap f stmt = stmt {decoder = fmap (fmap f) (decoder stmt)}--instance Filterable (Statement params) where-  {-# INLINE mapMaybe #-}-  mapMaybe filtrator stmt = stmt {decoder = fmap (mapMaybe filtrator) (decoder stmt)}--instance Profunctor Statement where-  {-# INLINE dimap #-}-  dimap f1 f2 stmt =-    stmt-      { serializer = \oidCache -> serializer stmt oidCache . f1,-        printer = printer stmt . f1,-        decoder = fmap (fmap f2) (decoder stmt)-      }---- |--- Refine the result of a statement,--- causing the running session to fail with the 'Hasql.Errors.UnexpectedResultStatementError' error in case of a refinement failure.------ This function is especially useful for refining the results of statements produced with--- <http://hackage.haskell.org/package/hasql-th the \"hasql-th\" library>.-refineResult :: (a -> Either Text b) -> Statement params a -> Statement params b-refineResult refiner stmt = stmt {decoder = fmap (ResultDecoder.refine refiner) (decoder stmt)}---- | Extract the SQL template from a statement.-toSql :: Statement params result -> Text-toSql stmt = decodeUtf8Lenient (sql stmt)---- | Compile prepared-statement data: resolve OIDs and pair encoded values with their format flags.-compilePreparedStatementData ::-  Statement params result ->-  Vocab.OidCache ->-  params ->-  ([Word32], [Maybe (ByteString, Bool)])-compilePreparedStatementData stmt oidCache params =-  unzip-    $ zipWith-      (\(ParamMeta typeRef dim fmt) encoding -> (resolveOid typeRef dim, fmap (,fmt) encoding))-      (Vector.toList (columnsMetadata stmt))-      (serializer stmt oidCache params)-  where-    resolveOid (Vocab.TypeRef.NamedType name) dim =-      case Vocab.OidCache.lookupTypeNameScalar name oidCache of-        Just oid -> if dim == 0 then oid else fromMaybe 0 (Vocab.OidCache.lookupTypeNameArray name oidCache)-        Nothing -> 0-    resolveOid (Vocab.TypeRef.KnownOid oid) _ = oid---- | Compile unprepared-statement data: resolve OIDs inline with encoded values.-compileUnpreparedStatementData ::-  Statement params result ->-  Vocab.OidCache ->-  params ->-  [Maybe (Word32, ByteString, Bool)]-compileUnpreparedStatementData stmt oidCache params =-  zipWith-    (\(ParamMeta typeRef dim fmt) encoding -> (,,) <$> Just (resolveOid typeRef dim) <*> encoding <*> Just fmt)-    (Vector.toList (columnsMetadata stmt))-    (serializer stmt oidCache params)-  where-    resolveOid (Vocab.TypeRef.NamedType name) dim =-      case Vocab.OidCache.lookupTypeNameScalar name oidCache of-        Just oid -> if dim == 0 then oid else fromMaybe 0 (Vocab.OidCache.lookupTypeNameArray name oidCache)-        Nothing -> 0-    resolveOid (Vocab.TypeRef.KnownOid oid) _ = oid
− src/library/Hasql/Engine/Structures/ConnectionState.hs 
@@ -1,98 +0,0 @@--- |--- This module defines the internal state of a database connection.-module Hasql.Engine.Structures.ConnectionState-  ( ConnectionState (..),-    toStatementCache,-    fromConnection,-    setPreparedStatements,-    setStatementCache,-    setConnection,-    setOidCache,-    mapStatementCache,-    mapOidCache,-    traverseStatementCache,-    resetPreparedStatementsCache,-  )-where--import Hasql.Codecs.Vocab.OidCache qualified as OidCache-import Hasql.Engine.Structures.StatementCache qualified as StatementCache-import Hasql.Platform.Prelude-import Hasql.Pq qualified as Pq---- |--- The internal state of a database connection.-data ConnectionState = ConnectionState-  { -- | Whether prepared statements are enabled.-    preparedStatements :: Bool,-    -- | The statement cache for prepared statements.-    statementCache :: StatementCache.StatementCache,-    -- | The OID cache for type name to OID mapping.-    oidCache :: OidCache.OidCache,-    -- | The underlying database connection.-    connection :: Pq.Connection-  }--toStatementCache :: ConnectionState -> StatementCache.StatementCache-toStatementCache ConnectionState {..} = statementCache--fromConnection :: Pq.Connection -> ConnectionState-fromConnection connection =-  ConnectionState-    { preparedStatements = False,-      statementCache = StatementCache.empty,-      oidCache = OidCache.empty,-      connection = connection-    }--setPreparedStatements :: Bool -> ConnectionState -> ConnectionState-setPreparedStatements preparedStatements connectionState =-  connectionState {preparedStatements = preparedStatements}--setStatementCache :: StatementCache.StatementCache -> ConnectionState -> ConnectionState-setStatementCache statementCache connectionState =-  connectionState {statementCache = statementCache}--setConnection :: Pq.Connection -> ConnectionState -> ConnectionState-setConnection connection connectionState =-  connectionState {connection = connection}--setOidCache :: OidCache.OidCache -> ConnectionState -> ConnectionState-setOidCache oidCache connectionState =-  connectionState {oidCache}--mapStatementCache ::-  (StatementCache.StatementCache -> StatementCache.StatementCache) ->-  (ConnectionState -> ConnectionState)-mapStatementCache f ConnectionState {..} =-  ConnectionState-    { statementCache = f statementCache,-      ..-    }--mapOidCache ::-  (OidCache.OidCache -> OidCache.OidCache) ->-  (ConnectionState -> ConnectionState)-mapOidCache f ConnectionState {..} =-  ConnectionState-    { oidCache = f oidCache,-      ..-    }--traverseStatementCache ::-  (Functor f) =>-  (StatementCache.StatementCache -> f StatementCache.StatementCache) ->-  (ConnectionState -> f ConnectionState)-traverseStatementCache f ConnectionState {..} =-  fmap-    ( \newStatementCache ->-        ConnectionState-          { statementCache = newStatementCache,-            ..-          }-    )-    (f statementCache)--resetPreparedStatementsCache :: ConnectionState -> ConnectionState-resetPreparedStatementsCache =-  mapStatementCache (const StatementCache.empty)
− src/library/Hasql/Engine/Structures/StatementCache.hs 
@@ -1,56 +0,0 @@-module Hasql.Engine.Structures.StatementCache-  ( -- * Pure registry operations-    StatementCache,-    empty,-    lookup,-    insert,-    reset,-  )-where--import Data.HashMap.Strict qualified as HashMap-import Hasql.Platform.Prelude hiding (empty, insert, lookup, reset)-import Hasql.Pq qualified as Pq---- | Pure registry state containing the hash map and counter-data StatementCache = StatementCache (HashMap LocalKey ByteString) Word-  deriving stock (Show, Eq)---- | Create an empty registry state-{-# INLINEABLE empty #-}-empty :: StatementCache-empty = StatementCache HashMap.empty 0---- | Pure lookup operation-{-# INLINEABLE lookup #-}-lookup :: ByteString -> [Pq.Oid] -> StatementCache -> Maybe ByteString-lookup sql oids (StatementCache hashMap _) = HashMap.lookup localKey hashMap-  where-    localKey = LocalKey sql oids---- | Pure insert operation that returns new state and the generated remote key-{-# INLINEABLE insert #-}-insert :: ByteString -> [Pq.Oid] -> StatementCache -> (ByteString, StatementCache)-insert sql oids (StatementCache hashMap counter) = (remoteKey, newState)-  where-    remoteKey = fromString $ show $ newCounter-    newHashMap = HashMap.insert localKey remoteKey hashMap-    newCounter = counter + 1-    newState = StatementCache newHashMap newCounter-    localKey = LocalKey sql oids---- | Pure reset operation-{-# INLINEABLE reset #-}-reset :: StatementCache -> StatementCache-reset _ = StatementCache HashMap.empty 0---- |--- Local statement key.-data LocalKey-  = LocalKey ByteString [Pq.Oid]-  deriving (Show, Eq)--instance Hashable LocalKey where-  {-# INLINE hashWithSalt #-}-  hashWithSalt salt (LocalKey template oids) =-    hashWithSalt (hashWithSalt salt template) (fmap Pq.oidToWord32 oids)
− src/library/Hasql/Platform/Prelude.hs 
@@ -1,124 +0,0 @@-module Hasql.Platform.Prelude-  ( module Exports,-    LazyByteString,-    forMToZero_,-    forMFromZero_,-    strictCons,-  )-where--import Control.Applicative as Exports hiding (WrappedArrow (..))-import Control.Arrow as Exports hiding (first, second)-import Control.Category as Exports-import Control.Comonad as Exports (Comonad (..))-import Control.Concurrent as Exports-import Control.Exception as Exports hiding (Handler)-import Control.Monad as Exports hiding (fail, forM, forM_, mapM, mapM_, msum, sequence, sequence_)-import Control.Monad.Error.Class as Exports (MonadError (..))-import Control.Monad.Fail as Exports-import Control.Monad.Fix as Exports hiding (fix)-import Control.Monad.IO.Class as Exports-import Control.Monad.Reader.Class as Exports-import Control.Monad.ST as Exports-import Control.Monad.State.Class as Exports-import Control.Monad.Trans.Class as Exports-import Control.Monad.Trans.Cont as Exports hiding (callCC, shift)-import Control.Monad.Trans.Except as Exports (Except, ExceptT (ExceptT), except, mapExcept, mapExceptT, runExcept, runExceptT, withExcept, withExceptT)-import Control.Monad.Trans.Maybe as Exports-import Control.Monad.Trans.Reader as Exports (Reader, ReaderT (ReaderT), mapReader, mapReaderT, runReader, runReaderT, withReader, withReaderT)-import Control.Monad.Trans.State.Strict as Exports (State, StateT (StateT), evalState, evalStateT, execState, execStateT, mapState, mapStateT, runState, runStateT, withState, withStateT)-import Control.Monad.Trans.Writer.Strict as Exports (Writer, WriterT (..), execWriter, execWriterT, mapWriter, mapWriterT, runWriter)-import Data.Bifunctor as Exports-import Data.Bits as Exports-import Data.Bool as Exports-import Data.ByteString as Exports (ByteString)-import Data.ByteString.Lazy qualified-import Data.Char as Exports-import Data.Coerce as Exports-import Data.Complex as Exports-import Data.DList as Exports (DList)-import Data.Data as Exports-import Data.Dynamic as Exports-import Data.Either as Exports-import Data.Fixed as Exports-import Data.Foldable as Exports hiding (toList)-import Data.Function as Exports hiding (id, (.))-import Data.Functor as Exports hiding (unzip)-import Data.Functor.Compose as Exports-import Data.Functor.Contravariant as Exports-import Data.Functor.Contravariant.Divisible as Exports-import Data.Functor.Identity as Exports-import Data.HashMap.Strict as Exports (HashMap)-import Data.HashSet as Exports (HashSet)-import Data.Hashable as Exports (Hashable (..))-import Data.IORef as Exports-import Data.Int as Exports-import Data.Ix as Exports-import Data.List as Exports hiding (all, and, any, concat, concatMap, elem, filter, find, foldl, foldl', foldl1, foldr, foldr1, isSubsequenceOf, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, notElem, or, product, sortOn, sum, uncons)-import Data.List.NonEmpty as Exports (NonEmpty (..))-import Data.Maybe as Exports hiding (catMaybes, mapMaybe)-import Data.Monoid as Exports hiding (Alt, (<>))-import Data.Ord as Exports-import Data.Profunctor.Unsafe as Exports-import Data.Proxy as Exports-import Data.Ratio as Exports-import Data.STRef as Exports-import Data.Scientific as Exports (Scientific)-import Data.Semigroup as Exports hiding (First (..), Last (..))-import Data.String as Exports-import Data.Text as Exports (Text)-import Data.Text.Encoding as Exports (encodeUtf8)-import Data.Time as Exports-import Data.Traversable as Exports-import Data.Tuple as Exports-import Data.UUID as Exports (UUID)-import Data.Unique as Exports-import Data.Vector as Exports (Vector)-import Data.Version as Exports-import Data.Void as Exports-import Data.Word as Exports-import Debug.Trace as Exports-import Foreign.ForeignPtr as Exports-import Foreign.Ptr as Exports-import Foreign.StablePtr as Exports-import Foreign.Storable as Exports-import GHC.Conc as Exports hiding (orElse, threadWaitRead, threadWaitReadSTM, threadWaitWrite, threadWaitWriteSTM, withMVar)-import GHC.Exts as Exports (IsList (..), groupWith, inline, lazy, sortWith)-import GHC.Generics as Exports (Generic)-import GHC.IO.Exception as Exports-import GHC.OverloadedLabels as Exports-import Hasql.Platform.Prelude.Text as Exports-import Numeric as Exports-import System.Environment as Exports-import System.Exit as Exports-import System.IO as Exports (Handle, hClose)-import System.IO.Error as Exports-import System.IO.Unsafe as Exports-import System.Mem as Exports-import System.Mem.StableName as Exports-import System.Timeout as Exports-import Text.ParserCombinators.ReadP as Exports (ReadP, readP_to_S, readS_to_P)-import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readP_to_Prec, readPrec_to_P, readPrec_to_S, readS_to_Prec)-import Text.Printf as Exports (hPrintf, printf)-import TextBuilder as Exports (TextBuilder)-import Unsafe.Coerce as Exports-import Witherable as Exports-import Prelude as Exports hiding (Read, all, and, any, concat, concatMap, elem, fail, filter, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.))--type LazyByteString =-  Data.ByteString.Lazy.ByteString--{-# INLINE forMToZero_ #-}-forMToZero_ :: (Applicative m) => Int -> (Int -> m a) -> m ()-forMToZero_ !startN f =-  ($ pred startN) $ fix $ \loop !n -> if n >= 0 then f n *> loop (pred n) else pure ()--{-# INLINE forMFromZero_ #-}-forMFromZero_ :: (Applicative m) => Int -> (Int -> m a) -> m ()-forMFromZero_ !endN f =-  ($ 0) $ fix $ \loop !n -> if n < endN then f n *> loop (succ n) else pure ()--{-# INLINE strictCons #-}-strictCons :: a -> [a] -> [a]-strictCons !a b =-  let !c = a : b in c
− src/library/Hasql/Platform/Prelude/Text.hs 
@@ -1,14 +0,0 @@-module Hasql.Platform.Prelude.Text where--import Data.ByteString qualified-import Data.Text qualified-import Data.Text.Encoding qualified-import Data.Text.Encoding.Error qualified-import Data.Text.Lazy qualified--type LazyText =-  Data.Text.Lazy.Text--decodeUtf8Lenient :: Data.ByteString.ByteString -> Data.Text.Text-decodeUtf8Lenient =-  Data.Text.Encoding.decodeUtf8With Data.Text.Encoding.Error.lenientDecode
− src/library/Hasql/Pq.hs 
@@ -1,99 +0,0 @@-module Hasql.Pq-  ( module Base,--    -- * Updated and new types-    Mappings.ExecStatus (..),-    Mappings.PipelineStatus (..),--    -- * Updated and new procedures-    resultStatus,-    pipelineStatus,-    enterPipelineMode,-    exitPipelineMode,-    pipelineSync,-    sendFlushRequest,--    -- * Helpers-    oidToWord32,-    rowToInt,-    colToInt,-  )-where--import Database.PostgreSQL.LibPQ as Base hiding (ExecStatus (..), PipelineStatus (..), enterPipelineMode, exitPipelineMode, pipelineStatus, pipelineSync, resultStatus, sendFlushRequest)-import Database.PostgreSQL.LibPQ.Internal qualified as BaseInternal-import Hasql.Platform.Prelude-import Hasql.Pq.Ffi qualified as Ffi-import Hasql.Pq.Mappings qualified as Mappings--resultStatus :: Result -> IO Mappings.ExecStatus-resultStatus result = do-  -- Unsafe-coercing because the constructor is not exposed by the lib,-  -- but it's implemented as a newtype over ForeignPtr.-  -- Since internal changes in the \"postgresql-lipbq\" may break this,-  -- it requires us to avoid using an open dependency range on it.-  ffiStatus <- withForeignPtr (unsafeCoerce result) Ffi.resultStatus-  decodeProcedureResult "resultStatus" Mappings.decodeExecStatus ffiStatus--pipelineStatus ::-  Connection ->-  IO Mappings.PipelineStatus-pipelineStatus =-  parameterlessProcedure "pipelineStatus" Ffi.pipelineStatus Mappings.decodePipelineStatus--enterPipelineMode ::-  Connection ->-  IO Bool-enterPipelineMode =-  parameterlessProcedure "enterPipelineMode" Ffi.enterPipelineMode Mappings.decodeBool--exitPipelineMode ::-  Connection ->-  IO Bool-exitPipelineMode =-  parameterlessProcedure "exitPipelineMode" Ffi.exitPipelineMode Mappings.decodeBool--pipelineSync ::-  Connection ->-  IO Bool-pipelineSync =-  parameterlessProcedure "pipelineSync" Ffi.pipelineSync Mappings.decodeBool--sendFlushRequest ::-  Connection ->-  IO Bool-sendFlushRequest =-  parameterlessProcedure "sendFlushRequest" Ffi.sendFlushRequest Mappings.decodeBool--parameterlessProcedure ::-  (Show a) =>-  String ->-  (Ptr BaseInternal.PGconn -> IO a) ->-  (a -> Maybe b) ->-  Connection ->-  IO b-parameterlessProcedure label procedure decoder connection = do-  ffiResult <- BaseInternal.withConn connection procedure-  decodeProcedureResult label decoder ffiResult--decodeProcedureResult ::-  (Show a) =>-  String ->-  (a -> Maybe b) ->-  a ->-  IO b-decodeProcedureResult label decoder ffiResult =-  case decoder ffiResult of-    Just res -> pure res-    Nothing -> fail ("Failed to decode result of " <> label <> " from: " <> show ffiResult)---- * Helpers--oidToWord32 :: Oid -> Word32-oidToWord32 (Oid x) = fromIntegral x--rowToInt :: Row -> Int-rowToInt (Row x) = fromIntegral x--colToInt :: Column -> Int-colToInt (Col x) = fromIntegral x
− src/library/Hasql/Pq/Ffi.hs 
@@ -1,25 +0,0 @@-{-# LANGUAGE CApiFFI #-}--module Hasql.Pq.Ffi where--import Database.PostgreSQL.LibPQ.Internal-import Foreign.C.Types (CInt (..))-import Hasql.Platform.Prelude--foreign import capi "libpq-fe.h PQresultStatus"-  resultStatus :: Ptr () -> IO CInt--foreign import capi "libpq-fe.h PQpipelineStatus"-  pipelineStatus :: Ptr PGconn -> IO CInt--foreign import capi "libpq-fe.h PQenterPipelineMode"-  enterPipelineMode :: Ptr PGconn -> IO CInt--foreign import capi "libpq-fe.h PQexitPipelineMode"-  exitPipelineMode :: Ptr PGconn -> IO CInt--foreign import capi "libpq-fe.h PQpipelineSync"-  pipelineSync :: Ptr PGconn -> IO CInt--foreign import capi "libpq-fe.h PQsendFlushRequest"-  sendFlushRequest :: Ptr PGconn -> IO CInt
− src/library/Hasql/Pq/Mappings.hsc 
@@ -1,71 +0,0 @@-module Hasql.Pq.Mappings where--#include "libpq-fe.h"--import Foreign.C.Types (CInt (..))-import Hasql.Platform.Prelude--data ExecStatus-  = EmptyQuery-  | CommandOk-  | TuplesOk-  | CopyOut-  | CopyIn-  | CopyBoth-  | BadResponse-  | NonfatalError-  | FatalError-  | SingleTuple-  | PipelineSync-  | PipelineAbort-  deriving (Eq, Show)--decodeExecStatus :: CInt -> Maybe ExecStatus-decodeExecStatus = \case-  (#const PGRES_EMPTY_QUERY) -> Just EmptyQuery-  (#const PGRES_COMMAND_OK) -> Just CommandOk-  (#const PGRES_TUPLES_OK) -> Just TuplesOk-  (#const PGRES_COPY_OUT) -> Just CopyOut-  (#const PGRES_COPY_IN) -> Just CopyIn-  (#const PGRES_COPY_BOTH) -> Just CopyBoth-  (#const PGRES_BAD_RESPONSE) -> Just BadResponse-  (#const PGRES_NONFATAL_ERROR) -> Just NonfatalError-  (#const PGRES_FATAL_ERROR) -> Just FatalError-  (#const PGRES_SINGLE_TUPLE) -> Just SingleTuple-  (#const PGRES_PIPELINE_SYNC) -> Just PipelineSync-  (#const PGRES_PIPELINE_ABORTED) -> Just PipelineAbort-  _ -> Nothing--encodeExecStatus :: ExecStatus -> CInt-encodeExecStatus = \case-  EmptyQuery -> #const PGRES_EMPTY_QUERY-  CommandOk -> #const PGRES_COMMAND_OK-  TuplesOk -> #const PGRES_TUPLES_OK-  CopyOut -> #const PGRES_COPY_OUT-  CopyIn -> #const PGRES_COPY_IN-  CopyBoth -> #const PGRES_COPY_BOTH-  BadResponse -> #const PGRES_BAD_RESPONSE-  NonfatalError -> #const PGRES_NONFATAL_ERROR-  FatalError -> #const PGRES_FATAL_ERROR-  SingleTuple -> #const PGRES_SINGLE_TUPLE-  PipelineSync -> #const PGRES_PIPELINE_SYNC-  PipelineAbort -> #const PGRES_PIPELINE_ABORTED--data PipelineStatus-  = PipelineOn-  | PipelineOff-  | PipelineAborted-  deriving (Eq, Show)--decodePipelineStatus :: CInt -> Maybe PipelineStatus-decodePipelineStatus = \case-  (#const PQ_PIPELINE_ON) -> Just PipelineOn-  (#const PQ_PIPELINE_OFF) -> Just PipelineOff-  (#const PQ_PIPELINE_ABORTED) -> Just PipelineAborted-  _ -> Nothing--decodeBool :: CInt -> Maybe Bool-decodeBool = \case-  0 -> Just False-  1 -> Just True-  _ -> Nothing
+ src/platform/Hasql/Platform/Prelude.hs view
@@ -0,0 +1,124 @@+module Hasql.Platform.Prelude+  ( module Exports,+    LazyByteString,+    forMToZero_,+    forMFromZero_,+    strictCons,+  )+where++import Control.Applicative as Exports hiding (WrappedArrow (..))+import Control.Arrow as Exports hiding (first, second)+import Control.Category as Exports+import Control.Comonad as Exports (Comonad (..))+import Control.Concurrent as Exports+import Control.Exception as Exports hiding (Handler)+import Control.Monad as Exports hiding (fail, forM, forM_, mapM, mapM_, msum, sequence, sequence_)+import Control.Monad.Error.Class as Exports (MonadError (..))+import Control.Monad.Fail as Exports+import Control.Monad.Fix as Exports hiding (fix)+import Control.Monad.IO.Class as Exports+import Control.Monad.Reader.Class as Exports+import Control.Monad.ST as Exports+import Control.Monad.State.Class as Exports+import Control.Monad.Trans.Class as Exports+import Control.Monad.Trans.Cont as Exports hiding (callCC, shift)+import Control.Monad.Trans.Except as Exports (Except, ExceptT (ExceptT), except, mapExcept, mapExceptT, runExcept, runExceptT, withExcept, withExceptT)+import Control.Monad.Trans.Maybe as Exports+import Control.Monad.Trans.Reader as Exports (Reader, ReaderT (ReaderT), mapReader, mapReaderT, runReader, runReaderT, withReader, withReaderT)+import Control.Monad.Trans.State.Strict as Exports (State, StateT (StateT), evalState, evalStateT, execState, execStateT, mapState, mapStateT, runState, runStateT, withState, withStateT)+import Control.Monad.Trans.Writer.Strict as Exports (Writer, WriterT (..), execWriter, execWriterT, mapWriter, mapWriterT, runWriter)+import Data.Bifunctor as Exports+import Data.Bits as Exports+import Data.Bool as Exports+import Data.ByteString as Exports (ByteString)+import Data.ByteString.Lazy qualified+import Data.Char as Exports+import Data.Coerce as Exports+import Data.Complex as Exports+import Data.DList as Exports (DList)+import Data.Data as Exports+import Data.Dynamic as Exports+import Data.Either as Exports+import Data.Fixed as Exports+import Data.Foldable as Exports hiding (toList)+import Data.Function as Exports hiding (id, (.))+import Data.Functor as Exports hiding (unzip)+import Data.Functor.Compose as Exports+import Data.Functor.Contravariant as Exports+import Data.Functor.Contravariant.Divisible as Exports+import Data.Functor.Identity as Exports+import Data.HashMap.Strict as Exports (HashMap)+import Data.HashSet as Exports (HashSet)+import Data.Hashable as Exports (Hashable (..))+import Data.IORef as Exports+import Data.Int as Exports+import Data.Ix as Exports+import Data.List as Exports hiding (all, and, any, concat, concatMap, elem, filter, find, foldl, foldl', foldl1, foldr, foldr1, isSubsequenceOf, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, notElem, or, product, sortOn, sum, uncons)+import Data.List.NonEmpty as Exports (NonEmpty (..))+import Data.Maybe as Exports hiding (catMaybes, mapMaybe)+import Data.Monoid as Exports hiding (Alt, (<>))+import Data.Ord as Exports+import Data.Profunctor.Unsafe as Exports+import Data.Proxy as Exports+import Data.Ratio as Exports+import Data.STRef as Exports+import Data.Scientific as Exports (Scientific)+import Data.Semigroup as Exports hiding (First (..), Last (..))+import Data.String as Exports+import Data.Text as Exports (Text)+import Data.Text.Encoding as Exports (encodeUtf8)+import Data.Time as Exports+import Data.Traversable as Exports+import Data.Tuple as Exports+import Data.UUID as Exports (UUID)+import Data.Unique as Exports+import Data.Vector as Exports (Vector)+import Data.Version as Exports+import Data.Void as Exports+import Data.Word as Exports+import Debug.Trace as Exports+import Foreign.ForeignPtr as Exports+import Foreign.Ptr as Exports+import Foreign.StablePtr as Exports+import Foreign.Storable as Exports+import GHC.Conc as Exports hiding (orElse, threadWaitRead, threadWaitReadSTM, threadWaitWrite, threadWaitWriteSTM, withMVar)+import GHC.Exts as Exports (IsList (..), groupWith, inline, lazy, sortWith)+import GHC.Generics as Exports (Generic)+import GHC.IO.Exception as Exports+import GHC.OverloadedLabels as Exports+import Hasql.Platform.Prelude.Text as Exports+import Numeric as Exports+import Prelude as Exports hiding (Read, all, and, any, concat, concatMap, elem, fail, filter, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.))+import System.Environment as Exports+import System.Exit as Exports+import System.IO as Exports (Handle, hClose)+import System.IO.Error as Exports+import System.IO.Unsafe as Exports+import System.Mem as Exports+import System.Mem.StableName as Exports+import System.Timeout as Exports+import Text.ParserCombinators.ReadP as Exports (ReadP, readP_to_S, readS_to_P)+import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readP_to_Prec, readPrec_to_P, readPrec_to_S, readS_to_Prec)+import Text.Printf as Exports (hPrintf, printf)+import TextBuilder as Exports (TextBuilder)+import Unsafe.Coerce as Exports+import Witherable as Exports++type LazyByteString =+  Data.ByteString.Lazy.ByteString++{-# INLINE forMToZero_ #-}+forMToZero_ :: (Applicative m) => Int -> (Int -> m a) -> m ()+forMToZero_ !startN f =+  ($ pred startN) $ fix $ \loop !n -> if n >= 0 then f n *> loop (pred n) else pure ()++{-# INLINE forMFromZero_ #-}+forMFromZero_ :: (Applicative m) => Int -> (Int -> m a) -> m ()+forMFromZero_ !endN f =+  ($ 0) $ fix $ \loop !n -> if n < endN then f n *> loop (succ n) else pure ()++{-# INLINE strictCons #-}+strictCons :: a -> [a] -> [a]+strictCons !a b =+  let !c = a : b in c
+ src/platform/Hasql/Platform/Prelude/Text.hs view
@@ -0,0 +1,14 @@+module Hasql.Platform.Prelude.Text where++import Data.ByteString qualified+import Data.Text qualified+import Data.Text.Encoding qualified+import Data.Text.Encoding.Error qualified+import Data.Text.Lazy qualified++type LazyText =+  Data.Text.Lazy.Text++decodeUtf8Lenient :: Data.ByteString.ByteString -> Data.Text.Text+decodeUtf8Lenient =+  Data.Text.Encoding.decodeUtf8With Data.Text.Encoding.Error.lenientDecode
src/profiling/Main.hs view
@@ -7,8 +7,9 @@ import Hasql.Decoders qualified as D import Hasql.Session qualified as B import Hasql.Statement qualified as Statement-import TestcontainersPostgresql qualified+import Pqi.Ffi qualified import Prelude+import TestcontainersPostgresql qualified  main :: IO () main =@@ -93,7 +94,7 @@  withConnectionByTagName :: Text -> (Connection.Connection -> IO ()) -> IO () withConnectionByTagName tagName action = withConnectionSettings tagName \settings -> do-  connection <- Connection.acquire settings+  connection <- Connection.acquire Pqi.Ffi.adapter settings   case connection of     Left err -> fail ("Connection failed: " <> show err)     Right conn -> finally (action conn) (Connection.release conn)