packages feed

hasql 1.10.3.7 → 2.0.0.3

raw patch · 155 files changed

Files

CHANGELOG.md view
@@ -1,3 +1,25 @@+# v2.0.0.3++## Fixes++- Work around the bug in Cabal due to which documentation does not get generated for definitions reexported from sublibs.++# v2.0.0.2++Work around the bugs in Cabal/Haddock that cause missing documentation for two-hop reexported internal modules.++# v2.0.0.1++Support for `pqi-1.1`.++# 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
@@ -5,14 +5,39 @@  PostgreSQL driver for Haskell, that prioritizes: -- Performance-- Typesafety+- Reliability - Flexibility+- Performance  # Status  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. +# Pluggable Transport++Hasql's transport is pluggable via [`pqi`](https://github.com/nikita-volkov/pqi). Hasql itself carries no C dependency. It programs against the `pqi` interface, and you pick the adapter that implements it. That means you depend on two packages, not one:++```cabal+build-depends:+  hasql,+  pqi-ffi,  -- or pqi-native+```++`Hasql.Connection.acquire` then takes the adapter explicitly, as its first argument:++```haskell+import Pqi.Ffi qualified    -- the 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-ffi`](https://github.com/nikita-volkov/pqi-ffi) is the stable, production-proven default. It binds the C `libpq` library, so it requires `libpq` of at least version 14 to be installed to compile - which typically just means having a recent PostgreSQL distro installed. Through it Hasql is tested against a wide range of PostgreSQL servers, starting from version 9.++[`pqi-native`](https://github.com/nikita-volkov/pqi-native) is a from-scratch, pure-Haskell implementation of the Postgres wire protocol, with no C dependency at all. It is thoroughly tested: [`pqi-conformance`](https://github.com/nikita-volkov/pqi-conformance) runs it side by side with `libpq` on the same inputs and checks that the results agree, and the test-suites of `hasql`, [`hasql-pool`](https://github.com/nikita-volkov/hasql-pool) and [`hasql-transaction`](https://github.com/nikita-volkov/hasql-transaction) now run against both adapters, so the whole stack above the transport is exercised on `pqi-native` too. **It's still labelled alpha** - not yet proven at production scale. The two adapters are fully interchangeable: swapping between them is a one-line change (a different `Adapter` value, nothing else), so you can try `pqi-native` today with no lock-in and no rewrite to fall back if needed.+ # 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.@@ -45,6 +70,16 @@  <sup>Want to list your package or correct something here? Make a PR.</sup> +## Transport adapters++Unlike the extension libraries above, which are optional, a transport adapter is mandatory: Hasql needs one to talk to the server at all. See [Pluggable Transport](#pluggable-transport) for how to pick one.++- ["pqi"](https://github.com/nikita-volkov/pqi) - the driver-agnostic interface that Hasql programs against. Pulled in automatically. You don't depend on it directly.++- ["pqi-ffi"](https://github.com/nikita-volkov/pqi-ffi) - the stable adapter, backed by the C `libpq` library.++- ["pqi-native"](https://github.com/nikita-volkov/pqi-native) - an alpha pure-Haskell adapter speaking the PostgreSQL wire protocol directly, with no C dependency.+ ## Why make it an ecosystem?  - **Focus.**@@ -92,10 +127,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.3 category: Hasql, Database, PostgreSQL synopsis: Fast PostgreSQL driver with a flexible mapping API description:@@ -9,16 +9,35 @@   Extended functionality such as pooling, transactions and compile-time checking of SQL is provided by extension libraries.   For more details and tutorials see <https://github.com/nikita-volkov/hasql the readme>. -  The API comes free from all kinds of exceptions.-  All error-reporting is explicit and is presented using the 'Either' type.+  All error-reporting is explicit:+  database, protocol and connection failures are reported via the 'Either' type+  instead of being thrown as exceptions. -  \"hasql\" requires you to have the \"libpq\" C-library of at least version 14 installed to compile.-  \"libpq\" comes distributed with PostgreSQL,-  so typically all you need is just to install the latest PostgreSQL distro.+  The transport layer is pluggable via <https://hackage.haskell.org/package/pqi pqi>,+  so \"hasql\" itself carries no C dependency.+  To compile an application you need to depend on \"hasql\" together with one adapter package+  and pass that adapter to @Hasql.Connection.acquire@ as its first argument.+  Two adapters are available: -  Despite the mentioned requirements for \"libpq\" \"hasql\" is thoroughly tested to be compatible-  with a wide range of PostgreSQL servers starting from version 9.+  * <https://hackage.haskell.org/package/pqi-ffi pqi-ffi> -+    the stable, production-proven adapter, backed by the C \"libpq\" library.+    It requires \"libpq\" of at least version 14 to be installed to compile.+    \"libpq\" comes distributed with PostgreSQL,+    so typically all you need is just to install the latest PostgreSQL distro.+    Via this adapter \"hasql\" is thoroughly tested to be compatible+    with a wide range of PostgreSQL servers starting from version 9. +  * <https://hackage.haskell.org/package/pqi-native pqi-native> -+    a pure-Haskell adapter, which speaks the PostgreSQL wire protocol directly+    and thus requires no C dependency at all.+    It is thoroughly tested:+    <https://github.com/nikita-volkov/pqi-conformance pqi-conformance> runs it+    side by side with \"libpq\" on the same inputs and checks that the results agree,+    and the test-suites of \"hasql\", \"hasql-pool\" and \"hasql-transaction\"+    run against both adapters.+    It is still labelled __alpha__, but is fully interchangeable with \"pqi-ffi\":+    switching between the two is a one-line change.+ homepage: https://github.com/nikita-volkov/hasql bug-reports: https://github.com/nikita-volkov/hasql/issues author: Nikita Volkov <nikita.y.volkov@mail.ru>@@ -123,21 +142,6 @@     Hasql.Codecs.Encoders.NullableOrNot     Hasql.Codecs.Encoders.Params     Hasql.Codecs.Encoders.Value-    Hasql.Codecs.RequestingOid-    Hasql.Codecs.RequestingOid.LookingUp-    Hasql.Codecs.Vocab-    Hasql.Codecs.Vocab.OidCache-    Hasql.Codecs.Vocab.ParamMeta-    Hasql.Codecs.Vocab.QualifiedTypeName-    Hasql.Codecs.Vocab.TypeInfo-    Hasql.Codecs.Vocab.TypeRef-    Hasql.Comms.Recv-    Hasql.Comms.ResultDecoder-    Hasql.Comms.Roundtrip-    Hasql.Comms.RowDecoder-    Hasql.Comms.RowReader-    Hasql.Comms.Send-    Hasql.Comms.Session     Hasql.Connection.Config     Hasql.Connection.ServerVersion     Hasql.Engine.Contexts.Pipeline@@ -147,29 +151,42 @@     Hasql.Engine.Errors     Hasql.Engine.PqProcedures.SelectTypeInfo     Hasql.Engine.Statement-    Hasql.Engine.Structures.ConnectionState-    Hasql.Engine.Structures.StatementCache++  build-depends:+    aeson >=2 && <3,+    bytestring >=0.10 && <0.13,+    bytestring-strict-builder >=0.4.5.4 && <0.5,+    hasql:codec-vocab,+    hasql:comms,+    hasql:connection-state,+    hasql:platform,+    hasql:to-be-resolved,+    iproute >=1.7 && <1.8,+    postgresql-binary ^>=0.15,+    postgresql-connection-string ^>=0.1,+    pqi >=1.0 && <1.2,+    text >=1 && <3,+    text-builder >=1 && <1.1,+    unordered-containers >=0.2 && <0.3,+    vector >=0.10 && <0.14,++library platform+  import: base+  hs-source-dirs: src/platform+  exposed-modules:     Hasql.Platform.Prelude++  other-modules:     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,-    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,     text >=1 && <3,@@ -181,6 +198,61 @@     vector >=0.10 && <0.14,     witherable >=0.5 && <0.6, +library to-be-resolved+  import: base+  hs-source-dirs: src/to-be-resolved+  exposed-modules:+    Hasql.ToBeResolved++  build-depends:+    base >=4.14 && <5++library codec-vocab+  import: base+  hs-source-dirs: src/codec-vocab+  exposed-modules:+    CodecVocab+    CodecVocab.QualifiedTypeName+    CodecVocab.TypeInfo+    CodecVocab.TypeRef+    CodecVocab.TypeShape++  build-depends:+    hasql:platform++library connection-state+  import: base+  hs-source-dirs: src/connection-state+  exposed-modules:+    Hasql.ConnectionState+    Hasql.ConnectionState.OidCache+    Hasql.ConnectionState.StatementCache++  build-depends:+    hasql:codec-vocab,+    hasql:platform,+    pqi >=1.0 && <1.2,+    unordered-containers >=0.2 && <0.3,++library comms+  import: base+  hs-source-dirs: src/comms+  exposed-modules:+    Hasql.Comms.Recv+    Hasql.Comms.ResultDecoder+    Hasql.Comms.Roundtrip+    Hasql.Comms.RowDecoder+    Hasql.Comms.RowReader+    Hasql.Comms.Send+    Hasql.Comms.Session++  build-depends:+    attoparsec >=0.10 && <0.15,+    bytestring >=0.10 && <0.13,+    hasql:platform,+    pqi >=1.0 && <1.2,+    vector >=0.10 && <0.14,+ benchmark benchmarks   import: executable   type: exitcode-stdio-1.0@@ -189,6 +261,8 @@   build-depends:     criterion >=1.6 && <2,     hasql,+    pqi-ffi ^>=1.0,+    pqi-native ^>=1.0,     rerebase <2,  test-suite profiling@@ -203,106 +277,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 && <1.2,+    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+test-suite connection-state-tests   import: test   type: exitcode-stdio-1.0-  hs-source-dirs:-    src/engine-tests-    src/library-+  hs-source-dirs: src/connection-state-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+    Hasql.ConnectionState.OidCacheSpec+    Hasql.ConnectionState.StatementCacheSpec    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:codec-vocab,+    hasql:connection-state,     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 +327,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 +341,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 +389,9 @@     hasql,     hspec ^>=2.11.12,     iproute,+    pqi >=1.0 && <1.2,+    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/codec-vocab/CodecVocab.hs view
@@ -0,0 +1,12 @@+module CodecVocab+  ( QualifiedTypeName (QualifiedTypeName),+    TypeInfo (TypeInfo),+    TypeRef (..),+    TypeShape (TypeShape),+  )+where++import CodecVocab.QualifiedTypeName+import CodecVocab.TypeInfo+import CodecVocab.TypeRef+import CodecVocab.TypeShape
+ src/codec-vocab/CodecVocab/QualifiedTypeName.hs view
@@ -0,0 +1,43 @@+module CodecVocab.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/codec-vocab/CodecVocab/TypeInfo.hs view
@@ -0,0 +1,235 @@+module CodecVocab.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++-- | Postgres's actual @unknown@ type, assigned to untyped literals. Not to be confused with 'invalid'.+unknown :: TypeInfo+unknown = TypeInfo 705 705++-- | Sentinel for a type name that failed to resolve to a real OID. Not to be confused with 'unknown', which is a real Postgres type.+invalid :: TypeInfo+invalid = TypeInfo 0 0++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/codec-vocab/CodecVocab/TypeRef.hs view
@@ -0,0 +1,20 @@+module CodecVocab.TypeRef+  ( TypeRef (..),+  )+where++import CodecVocab.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/codec-vocab/CodecVocab/TypeShape.hs view
@@ -0,0 +1,13 @@+module CodecVocab.TypeShape+  ( TypeShape (..),+  )+where++import CodecVocab.TypeRef (TypeRef)+import Hasql.Platform.Prelude++-- | A value's type shape: type reference, array dimensionality, text-format flag.+data TypeShape = TypeShape TypeRef Word Bool+  deriving stock (Eq, Ord, Show, Generic)++instance Hashable TypeShape
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,344 @@+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+      oidsLength = length oids+   in ResultDecoder \result -> do+        maxCols <- Pq.nfields result+        if oidsLength == 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 oidsLength (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/connection-state-tests/Hasql/ConnectionState/OidCacheSpec.hs view
@@ -0,0 +1,114 @@+module Hasql.ConnectionState.OidCacheSpec (spec) where++import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName+import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo+import Data.HashMap.Strict qualified as HashMap+import Data.HashSet qualified as HashSet+import Hasql.ConnectionState.OidCache qualified as OidCache+import Prelude+import Test.Hspec++int4Key :: CodecVocab.QualifiedTypeName.QualifiedTypeName+int4Key = CodecVocab.QualifiedTypeName.QualifiedTypeName Nothing "int4"++int8Key :: CodecVocab.QualifiedTypeName.QualifiedTypeName+int8Key = CodecVocab.QualifiedTypeName.QualifiedTypeName Nothing "int8"++spec :: Spec+spec = do+  describe "empty" do+    it "returns Nothing on lookup" do+      OidCache.lookupTypeInfo int4Key OidCache.empty+        `shouldBe` Nothing++  describe "fromHashMap and lookupTypeInfo" do+    it "can look up an inserted type" do+      let cache = OidCache.fromHashMap (HashMap.singleton int4Key (CodecVocab.TypeInfo.TypeInfo 23 1007))+      OidCache.lookupTypeInfo int4Key cache+        `shouldBe` Just (CodecVocab.TypeInfo.TypeInfo 23 1007)++    it "returns Nothing for a non-inserted type" do+      let cache = OidCache.fromHashMap (HashMap.singleton int4Key (CodecVocab.TypeInfo.TypeInfo 23 1007))+      OidCache.lookupTypeInfo int8Key cache+        `shouldBe` Nothing++    it "handles schema-qualified names" do+      let key = CodecVocab.QualifiedTypeName.QualifiedTypeName (Just "public") "my_type"+          cache = OidCache.fromHashMap (HashMap.singleton key (CodecVocab.TypeInfo.TypeInfo 100 200))+      OidCache.lookupTypeInfo key cache+        `shouldBe` Just (CodecVocab.TypeInfo.TypeInfo 100 200)+      OidCache.lookupTypeInfo (CodecVocab.QualifiedTypeName.QualifiedTypeName Nothing "my_type") cache+        `shouldBe` Nothing++    it "distinguishes same type name in different schemas" do+      let keyA = CodecVocab.QualifiedTypeName.QualifiedTypeName (Just "schema_a") "my_type"+          keyB = CodecVocab.QualifiedTypeName.QualifiedTypeName (Just "schema_b") "my_type"+          cache = OidCache.fromHashMap (HashMap.fromList [(keyA, CodecVocab.TypeInfo.TypeInfo 100 200), (keyB, CodecVocab.TypeInfo.TypeInfo 300 400)])+      OidCache.lookupTypeInfo keyA cache+        `shouldBe` Just (CodecVocab.TypeInfo.TypeInfo 100 200)+      OidCache.lookupTypeInfo keyB cache+        `shouldBe` Just (CodecVocab.TypeInfo.TypeInfo 300 400)++  describe "selectUnknownNames" do+    it "returns all names when cache is empty" do+      let names = HashSet.fromList [int4Key, int8Key]+      OidCache.selectUnknownNames names OidCache.empty+        `shouldBe` names++    it "returns empty when all names are known" do+      let cache = OidCache.fromHashMap (HashMap.fromList [(int4Key, CodecVocab.TypeInfo.TypeInfo 23 1007), (int8Key, CodecVocab.TypeInfo.TypeInfo 20 1016)])+          names = HashSet.fromList [int4Key, int8Key]+      OidCache.selectUnknownNames names cache+        `shouldBe` HashSet.empty++    it "returns only unknown names" do+      let cache = OidCache.fromHashMap (HashMap.singleton int4Key (CodecVocab.TypeInfo.TypeInfo 23 1007))+          names = HashSet.fromList [int4Key, int8Key]+      OidCache.selectUnknownNames names cache+        `shouldBe` HashSet.fromList [int8Key]++  describe "toResolver" do+    it "resolves a known type" do+      let cache = OidCache.fromHashMap (HashMap.singleton int4Key (CodecVocab.TypeInfo.TypeInfo 23 1007))+      OidCache.toResolver cache int4Key+        `shouldBe` CodecVocab.TypeInfo.TypeInfo 23 1007++    it "falls back to invalid for an unknown type" do+      OidCache.toResolver OidCache.empty int4Key+        `shouldBe` CodecVocab.TypeInfo.invalid++  describe "Semigroup" do+    it "right operand takes precedence for duplicate keys" do+      let cacheA = OidCache.fromHashMap (HashMap.singleton int4Key (CodecVocab.TypeInfo.TypeInfo 23 1007))+          cacheB = OidCache.fromHashMap (HashMap.singleton int4Key (CodecVocab.TypeInfo.TypeInfo 99 999))+          merged = cacheA <> cacheB+      OidCache.lookupTypeInfo int4Key merged+        `shouldBe` Just (CodecVocab.TypeInfo.TypeInfo 99 999)++    it "preserves entries from both sides when no conflict" do+      let cacheA = OidCache.fromHashMap (HashMap.singleton int4Key (CodecVocab.TypeInfo.TypeInfo 23 1007))+          cacheB = OidCache.fromHashMap (HashMap.singleton int8Key (CodecVocab.TypeInfo.TypeInfo 20 1016))+          merged = cacheA <> cacheB+      OidCache.lookupTypeInfo int4Key merged+        `shouldBe` Just (CodecVocab.TypeInfo.TypeInfo 23 1007)+      OidCache.lookupTypeInfo int8Key merged+        `shouldBe` Just (CodecVocab.TypeInfo.TypeInfo 20 1016)++    it "is associative" do+      let a = OidCache.fromHashMap (HashMap.singleton "t1" (CodecVocab.TypeInfo.TypeInfo 1 2))+          b = OidCache.fromHashMap (HashMap.fromList [("t1", CodecVocab.TypeInfo.TypeInfo 3 4), ("t2", CodecVocab.TypeInfo.TypeInfo 5 6)])+          c = OidCache.fromHashMap (HashMap.fromList [("t2", CodecVocab.TypeInfo.TypeInfo 7 8), ("t3", CodecVocab.TypeInfo.TypeInfo 9 10)])+      (a <> b) <> c+        `shouldBe` a <> (b <> c)++  describe "Monoid" do+    it "mempty is identity for Semigroup" do+      let cache = OidCache.fromHashMap (HashMap.singleton int4Key (CodecVocab.TypeInfo.TypeInfo 23 1007))+      cache <> mempty+        `shouldBe` cache+      mempty <> cache+        `shouldBe` cache++    it "empty equals mempty" do+      OidCache.empty+        `shouldBe` mempty
+ src/connection-state-tests/Hasql/ConnectionState/StatementCacheSpec.hs view
@@ -0,0 +1,93 @@+module Hasql.ConnectionState.StatementCacheSpec (spec) where++import Data.Maybe+import Hasql.ConnectionState.StatementCache qualified as StatementCache+import Test.Hspec++spec :: Spec+spec = do+  describe "empty" do+    it "returns Nothing on lookup" do+      StatementCache.lookup "SELECT 1" [] StatementCache.empty+        `shouldBe` Nothing++  describe "insert and lookup" do+    it "can insert and retrieve a statement" do+      let (remoteKey, cache) = StatementCache.insert "SELECT 1" [] StatementCache.empty+      StatementCache.lookup "SELECT 1" [] cache+        `shouldBe` Just remoteKey++    it "generates unique remote keys for different SQL" do+      let (key1, cache1) = StatementCache.insert "SELECT 1" [] StatementCache.empty+          (key2, _cache2) = StatementCache.insert "SELECT 2" [] cache1+      key1 `shouldNotBe` key2++    it "generates unique remote keys for same SQL with different OIDs" do+      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 = 23+          oid25 = 25+          (_key1, cache1) = StatementCache.insert "SELECT $1" [oid23] StatementCache.empty+          (_key2, cache2) = StatementCache.insert "SELECT $1" [oid25] cache1+      -- Both should be findable+      StatementCache.lookup "SELECT $1" [oid23] cache2+        `shouldSatisfy` isJust+      StatementCache.lookup "SELECT $1" [oid25] cache2+        `shouldSatisfy` isJust+      -- And should have different remote keys+      let rk1 = StatementCache.lookup "SELECT $1" [oid23] cache2+          rk2 = StatementCache.lookup "SELECT $1" [oid25] cache2+      rk1 `shouldNotBe` rk2++    it "returns Nothing for a non-inserted SQL" do+      let (_key, cache) = StatementCache.insert "SELECT 1" [] StatementCache.empty+      StatementCache.lookup "SELECT 2" [] cache+        `shouldBe` Nothing++    it "returns Nothing for matching SQL but different OIDs" do+      let oid23 = 23+          oid25 = 25+          (_key, cache) = StatementCache.insert "SELECT $1" [oid23] StatementCache.empty+      StatementCache.lookup "SELECT $1" [oid25] cache+        `shouldBe` Nothing++    it "handles empty OID list" do+      let (key, cache) = StatementCache.insert "SELECT 1" [] StatementCache.empty+      StatementCache.lookup "SELECT 1" [] cache+        `shouldBe` Just key++    it "handles multiple OIDs" do+      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 = [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+        `shouldSatisfy` isJust+      StatementCache.lookup "SELECT $1, $2" oidsB cache2+        `shouldSatisfy` isJust+      let rkA = StatementCache.lookup "SELECT $1, $2" oidsA cache2+          rkB = StatementCache.lookup "SELECT $1, $2" oidsB cache2+      rkA `shouldNotBe` rkB++  describe "reset" do+    it "clears all cached statements" do+      let (_key, cache) = StatementCache.insert "SELECT 1" [] StatementCache.empty+          resetCache = StatementCache.reset cache+      StatementCache.lookup "SELECT 1" [] resetCache+        `shouldBe` Nothing++    it "results in a cache equal to empty" do+      let (_key, cache) = StatementCache.insert "SELECT 1" [] StatementCache.empty+      StatementCache.reset cache+        `shouldBe` StatementCache.empty
+ src/connection-state-tests/Main.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ src/connection-state/Hasql/ConnectionState.hs view
@@ -0,0 +1,98 @@+-- |+-- This module defines the internal state of a database connection.+module Hasql.ConnectionState+  ( ConnectionState (..),+    toStatementCache,+    fromConnection,+    setPreparedStatements,+    setStatementCache,+    setConnection,+    setOidCache,+    mapStatementCache,+    mapOidCache,+    traverseStatementCache,+    resetPreparedStatementsCache,+  )+where++import Hasql.ConnectionState.OidCache qualified as OidCache+import Hasql.ConnectionState.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/connection-state/Hasql/ConnectionState/OidCache.hs view
@@ -0,0 +1,63 @@+module Hasql.ConnectionState.OidCache+  ( OidCache,++    -- * Accessors+    lookupTypeInfo,+    toResolver,++    -- * Constructors+    fromHashMap,+    empty,+    selectUnknownNames,+  )+where++import CodecVocab qualified as CodecVocab+import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo+import Data.HashMap.Strict qualified as HashMap+import Data.HashSet qualified as HashSet+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 CodecVocab.QualifiedTypeName CodecVocab.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 CodecVocab.QualifiedTypeName -> OidCache -> HashSet CodecVocab.QualifiedTypeName+selectUnknownNames keys (OidCache byName) =+  HashSet.filter (\key -> not (HashMap.member key byName)) keys++{-# INLINE fromHashMap #-}+fromHashMap :: HashMap CodecVocab.QualifiedTypeName CodecVocab.TypeInfo -> OidCache+fromHashMap byName = OidCache byName++-- * Accessors++{-# INLINE lookupTypeInfo #-}+lookupTypeInfo :: CodecVocab.QualifiedTypeName -> OidCache -> Maybe CodecVocab.TypeInfo+lookupTypeInfo name (OidCache byName) =+  HashMap.lookup name byName++-- | Resolution function for a name against the cache, falling back to 'TypeInfo.invalid' on a miss.+{-# INLINE toResolver #-}+toResolver :: OidCache -> CodecVocab.QualifiedTypeName -> CodecVocab.TypeInfo+toResolver oidCache name =+  lookupTypeInfo name oidCache & fromMaybe CodecVocab.TypeInfo.invalid
+ src/connection-state/Hasql/ConnectionState/StatementCache.hs view
@@ -0,0 +1,55 @@+module Hasql.ConnectionState.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/engine-tests/Hasql/Engine/Structures/OidCacheSpec.hs 
@@ -1,116 +0,0 @@-module Hasql.Engine.Structures.OidCacheSpec (spec) where--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--spec :: Spec-spec = do-  describe "empty" do-    it "returns Nothing on scalar lookup" do-      OidCache.lookupScalar Nothing "int4" OidCache.empty-        `shouldBe` Nothing--    it "returns Nothing on array lookup" do-      OidCache.lookupArray Nothing "int4" OidCache.empty-        `shouldBe` Nothing--  describe "insertScalar and lookup" do-    it "can insert and lookup a scalar OID" do-      let cache = OidCache.insertScalar Nothing "int4" 23 1007 OidCache.empty-      OidCache.lookupScalar Nothing "int4" cache-        `shouldBe` Just 23--    it "can insert and lookup an array OID" do-      let cache = OidCache.insertScalar Nothing "int4" 23 1007 OidCache.empty-      OidCache.lookupArray Nothing "int4" cache-        `shouldBe` Just 1007--    it "returns Nothing for a non-inserted type" do-      let cache = OidCache.insertScalar Nothing "int4" 23 1007 OidCache.empty-      OidCache.lookupScalar Nothing "int8" cache-        `shouldBe` Nothing--    it "handles schema-qualified names" do-      let cache = OidCache.insertScalar (Just "public") "my_type" 100 200 OidCache.empty-      OidCache.lookupScalar (Just "public") "my_type" cache-        `shouldBe` Just 100-      OidCache.lookupScalar Nothing "my_type" cache-        `shouldBe` Nothing--    it "distinguishes same type name in different schemas" do-      let cache =-            OidCache.insertScalar-              (Just "schema_a")-              "my_type"-              100-              200-              (OidCache.insertScalar (Just "schema_b") "my_type" 300 400 OidCache.empty)-      OidCache.lookupScalar (Just "schema_a") "my_type" cache-        `shouldBe` Just 100-      OidCache.lookupScalar (Just "schema_b") "my_type" cache-        `shouldBe` Just 300--  describe "selectUnknownNames" do-    it "returns all names when cache is empty" do-      let names = HashSet.fromList [Vocab.QualifiedTypeName.QualifiedTypeName Nothing "int4", Vocab.QualifiedTypeName.QualifiedTypeName Nothing "int8"]-      OidCache.selectUnknownNames names OidCache.empty-        `shouldBe` names--    it "returns empty when all names are known" do-      let cache =-            OidCache.insertScalar-              Nothing-              "int4"-              23-              1007-              (OidCache.insertScalar Nothing "int8" 20 1016 OidCache.empty)-          names = HashSet.fromList [Vocab.QualifiedTypeName.QualifiedTypeName Nothing "int4", Vocab.QualifiedTypeName.QualifiedTypeName Nothing "int8"]-      OidCache.selectUnknownNames names cache-        `shouldBe` HashSet.empty--    it "returns only unknown names" do-      let cache = OidCache.insertScalar Nothing "int4" 23 1007 OidCache.empty-          names = HashSet.fromList [Vocab.QualifiedTypeName.QualifiedTypeName Nothing "int4", Vocab.QualifiedTypeName.QualifiedTypeName Nothing "int8"]-      OidCache.selectUnknownNames names cache-        `shouldBe` HashSet.fromList [Vocab.QualifiedTypeName.QualifiedTypeName Nothing "int8"]--  describe "Semigroup" do-    it "right operand takes precedence for duplicate keys" do-      let cacheA = OidCache.insertScalar Nothing "int4" 23 1007 OidCache.empty-          cacheB = OidCache.insertScalar Nothing "int4" 99 999 OidCache.empty-          merged = cacheA <> cacheB-      OidCache.lookupScalar Nothing "int4" merged-        `shouldBe` Just 99-      OidCache.lookupArray Nothing "int4" merged-        `shouldBe` Just 999--    it "preserves entries from both sides when no conflict" do-      let cacheA = OidCache.insertScalar Nothing "int4" 23 1007 OidCache.empty-          cacheB = OidCache.insertScalar Nothing "int8" 20 1016 OidCache.empty-          merged = cacheA <> cacheB-      OidCache.lookupScalar Nothing "int4" merged-        `shouldBe` Just 23-      OidCache.lookupScalar Nothing "int8" merged-        `shouldBe` Just 20--    it "is associative" do-      let a = OidCache.insertScalar Nothing "t1" 1 2 OidCache.empty-          b = OidCache.insertScalar Nothing "t1" 3 4 (OidCache.insertScalar Nothing "t2" 5 6 OidCache.empty)-          c = OidCache.insertScalar Nothing "t2" 7 8 (OidCache.insertScalar Nothing "t3" 9 10 OidCache.empty)-      OidCache.toHashMap ((a <> b) <> c)-        `shouldBe` OidCache.toHashMap (a <> (b <> c))--  describe "Monoid" do-    it "mempty is identity for Semigroup" do-      let cache = OidCache.insertScalar Nothing "int4" 23 1007 OidCache.empty-      OidCache.toHashMap (cache <> mempty)-        `shouldBe` OidCache.toHashMap cache-      OidCache.toHashMap (mempty <> cache)-        `shouldBe` OidCache.toHashMap cache--    it "empty equals mempty" do-      OidCache.toHashMap OidCache.empty-        `shouldBe` OidCache.toHashMap mempty
− src/engine-tests/Hasql/Engine/Structures/StatementCacheSpec.hs 
@@ -1,94 +0,0 @@-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--spec :: Spec-spec = do-  describe "empty" do-    it "returns Nothing on lookup" do-      StatementCache.lookup "SELECT 1" [] StatementCache.empty-        `shouldBe` Nothing--  describe "insert and lookup" do-    it "can insert and retrieve a statement" do-      let (remoteKey, cache) = StatementCache.insert "SELECT 1" [] StatementCache.empty-      StatementCache.lookup "SELECT 1" [] cache-        `shouldBe` Just remoteKey--    it "generates unique remote keys for different SQL" do-      let (key1, cache1) = StatementCache.insert "SELECT 1" [] StatementCache.empty-          (key2, _cache2) = StatementCache.insert "SELECT 2" [] cache1-      key1 `shouldNotBe` key2--    it "generates unique remote keys for same SQL with different OIDs" do-      let oid23 = Oid 23-          oid25 = Oid 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-          (_key1, cache1) = StatementCache.insert "SELECT $1" [oid23] StatementCache.empty-          (_key2, cache2) = StatementCache.insert "SELECT $1" [oid25] cache1-      -- Both should be findable-      StatementCache.lookup "SELECT $1" [oid23] cache2-        `shouldSatisfy` isJust-      StatementCache.lookup "SELECT $1" [oid25] cache2-        `shouldSatisfy` isJust-      -- And should have different remote keys-      let rk1 = StatementCache.lookup "SELECT $1" [oid23] cache2-          rk2 = StatementCache.lookup "SELECT $1" [oid25] cache2-      rk1 `shouldNotBe` rk2--    it "returns Nothing for a non-inserted SQL" do-      let (_key, cache) = StatementCache.insert "SELECT 1" [] StatementCache.empty-      StatementCache.lookup "SELECT 2" [] cache-        `shouldBe` Nothing--    it "returns Nothing for matching SQL but different OIDs" do-      let oid23 = Oid 23-          oid25 = Oid 25-          (_key, cache) = StatementCache.insert "SELECT $1" [oid23] StatementCache.empty-      StatementCache.lookup "SELECT $1" [oid25] cache-        `shouldBe` Nothing--    it "handles empty OID list" do-      let (key, cache) = StatementCache.insert "SELECT 1" [] StatementCache.empty-      StatementCache.lookup "SELECT 1" [] cache-        `shouldBe` Just key--    it "handles multiple OIDs" do-      let oids = [Oid 23, Oid 25, Oid 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]-          (_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-        `shouldSatisfy` isJust-      StatementCache.lookup "SELECT $1, $2" oidsB cache2-        `shouldSatisfy` isJust-      let rkA = StatementCache.lookup "SELECT $1, $2" oidsA cache2-          rkB = StatementCache.lookup "SELECT $1, $2" oidsB cache2-      rkA `shouldNotBe` rkB--  describe "reset" do-    it "clears all cached statements" do-      let (_key, cache) = StatementCache.insert "SELECT 1" [] StatementCache.empty-          resetCache = StatementCache.reset cache-      StatementCache.lookup "SELECT 1" [] resetCache-        `shouldBe` Nothing--    it "results in a cache equal to empty" do-      let (_key, cache) = StatementCache.insert "SELECT 1" [] StatementCache.empty-      StatementCache.reset cache-        `shouldBe` StatementCache.empty
− src/engine-tests/Main.hs 
@@ -1,1 +0,0 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ 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,29 @@+-- 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 = 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))+          )+          (parallel 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 view
@@ -65,12 +65,12 @@   ) where +import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo 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@@ -139,9 +139,9 @@   Value.Value     Nothing     "record"-    (Just (Vocab.TypeInfo.toBaseOid typeInfo))-    (Just (Vocab.TypeInfo.toArrayOid typeInfo))+    (Just (CodecVocab.TypeInfo.toBaseOid typeInfo))+    (Just (CodecVocab.TypeInfo.toArrayOid typeInfo))     0     (Composite.toValueDecoder composite)   where-    typeInfo = Vocab.TypeInfo.record+    typeInfo = CodecVocab.TypeInfo.record
src/library/Hasql/Codecs/Decoders/Array.hs view
@@ -12,10 +12,12 @@   ) where +import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName+import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo 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 Hasql.ToBeResolved qualified as ToBeResolved import PostgreSQL.Binary.Decoding qualified as Binary import TextBuilder qualified @@ -41,11 +43,11 @@       -- | Number of dimensions.       Word       -- | Decoding function-      (RequestingOid.RequestingOid (Binary.Array a))+      (ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo (Binary.Array a))   deriving (Functor)  {-# INLINE toValueDecoder #-}-toValueDecoder :: Array a -> RequestingOid.RequestingOid (Binary.Value a)+toValueDecoder :: Array a -> ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo (Binary.Value a) toValueDecoder (Array _ _ _ _ _ decoder) =   fmap Binary.array decoder
src/library/Hasql/Codecs/Decoders/Composite.hs view
@@ -1,22 +1,22 @@ module Hasql.Codecs.Decoders.Composite where +import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName+import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo 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 Hasql.ToBeResolved qualified as ToBeResolved import PostgreSQL.Binary.Decoding qualified as Binary  -- | -- Composable decoder of composite values (rows, records). newtype Composite a-  = Composite (RequestingOid.RequestingOid (Binary.Composite a))+  = Composite (ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo (Binary.Composite a))   deriving     (Functor, Applicative)-    via (Compose RequestingOid.RequestingOid Binary.Composite)+    via (Compose (ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo) Binary.Composite) -toValueDecoder :: Composite a -> RequestingOid.RequestingOid (Binary.Value a)+toValueDecoder :: Composite a -> ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo (Binary.Value a) toValueDecoder (Composite imp) =   fmap Binary.composite imp @@ -32,10 +32,9 @@             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)+              ( (\typeInfo decoder -> Binary.typedValueComposite (if dimensionality == 0 then CodecVocab.TypeInfo.toBaseOid typeInfo else CodecVocab.TypeInfo.toArrayOid typeInfo) decoder)+                  <$> ToBeResolved.lookup (CodecVocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema imp) (Value.toTypeName imp))+                  <*> Value.toDecoder imp               )   NullableOrNot.Nullable imp ->     let dimensionality = Value.toDimensionality imp@@ -45,8 +44,7 @@             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)+              ( (\typeInfo decoder -> Binary.typedNullableValueComposite (if dimensionality == 0 then CodecVocab.TypeInfo.toBaseOid typeInfo else CodecVocab.TypeInfo.toArrayOid typeInfo) decoder)+                  <$> ToBeResolved.lookup (CodecVocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema imp) (Value.toTypeName imp))+                  <*> Value.toDecoder imp               )
src/library/Hasql/Codecs/Decoders/Value.hs view
@@ -49,19 +49,16 @@     toOid,     toBaseOid,     toArrayOid,-    toHandler,-    toByteStringParser,     isArray,   ) where +import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName+import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo 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 Hasql.ToBeResolved qualified as ToBeResolved import PostgreSQL.Binary.Decoding qualified as Binary import PostgreSQL.Binary.Range qualified as R @@ -80,7 +77,7 @@       -- | 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))+      (ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo (Binary.Value a))   deriving (Functor)  type role Value representational@@ -93,9 +90,9 @@ -- | -- Create a decoder from TypeInfo metadata and a decoding function. {-# INLINE primitive #-}-primitive :: Text -> Vocab.TypeInfo.TypeInfo -> Binary.Value a -> Value a+primitive :: Text -> CodecVocab.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)+  Value Nothing typeName (Just (CodecVocab.TypeInfo.toBaseOid pti)) (Just (CodecVocab.TypeInfo.toArrayOid pti)) 0 (pure decoder)  -- * Static types @@ -103,19 +100,19 @@ -- Decoder of the @BOOL@ values. {-# INLINEABLE bool #-} bool :: Value Bool-bool = primitive "bool" Vocab.TypeInfo.bool Binary.bool+bool = primitive "bool" CodecVocab.TypeInfo.bool Binary.bool  -- | -- Decoder of the @INT2@ values. {-# INLINEABLE int2 #-} int2 :: Value Int16-int2 = primitive "int2" Vocab.TypeInfo.int2 Binary.int+int2 = primitive "int2" CodecVocab.TypeInfo.int2 Binary.int  -- | -- Decoder of the @INT4@ values. {-# INLINEABLE int4 #-} int4 :: Value Int32-int4 = primitive "int4" Vocab.TypeInfo.int4 Binary.int+int4 = primitive "int4" CodecVocab.TypeInfo.int4 Binary.int  -- | -- Decoder of the @INT8@ values.@@ -123,68 +120,68 @@ int8 :: Value Int64 int8 =   {-# SCC "int8" #-}-  primitive "int8" Vocab.TypeInfo.int8 ({-# SCC "int8.int" #-} Binary.int)+  primitive "int8" CodecVocab.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+float4 = primitive "float4" CodecVocab.TypeInfo.float4 Binary.float4  -- | -- Decoder of the @FLOAT8@ values. {-# INLINEABLE float8 #-} float8 :: Value Double-float8 = primitive "float8" Vocab.TypeInfo.float8 Binary.float8+float8 = primitive "float8" CodecVocab.TypeInfo.float8 Binary.float8  -- | -- Decoder of the @NUMERIC@ values. {-# INLINEABLE numeric #-} numeric :: Value Scientific-numeric = primitive "numeric" Vocab.TypeInfo.numeric Binary.numeric+numeric = primitive "numeric" CodecVocab.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+char = primitive "char" CodecVocab.TypeInfo.char Binary.char  -- | -- Decoder of the @TEXT@ values. {-# INLINEABLE text #-} text :: Value Text-text = primitive "text" Vocab.TypeInfo.text Binary.text_strict+text = primitive "text" CodecVocab.TypeInfo.text Binary.text_strict  -- | -- Decoder of the @VARCHAR@ values. {-# INLINEABLE varchar #-} varchar :: Value Text-varchar = primitive "varchar" Vocab.TypeInfo.varchar Binary.text_strict+varchar = primitive "varchar" CodecVocab.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+bpchar = primitive "bpchar" CodecVocab.TypeInfo.bpchar Binary.text_strict  -- | -- Decoder of the @BYTEA@ values. {-# INLINEABLE bytea #-} bytea :: Value ByteString-bytea = primitive "bytea" Vocab.TypeInfo.bytea Binary.bytea_strict+bytea = primitive "bytea" CodecVocab.TypeInfo.bytea Binary.bytea_strict  -- | -- Decoder of the @DATE@ values. {-# INLINEABLE date #-} date :: Value Day-date = primitive "date" Vocab.TypeInfo.date Binary.date+date = primitive "date" CodecVocab.TypeInfo.date Binary.date  -- | -- Decoder of the @TIMESTAMP@ values. {-# INLINEABLE timestamp #-} timestamp :: Value LocalTime-timestamp = primitive "timestamp" Vocab.TypeInfo.timestamp Binary.timestamp_int+timestamp = primitive "timestamp" CodecVocab.TypeInfo.timestamp Binary.timestamp_int  -- | -- Decoder of the @TIMESTAMPTZ@ values.@@ -198,13 +195,13 @@ -- and communicates with Postgres using the UTC values directly. {-# INLINEABLE timestamptz #-} timestamptz :: Value UTCTime-timestamptz = primitive "timestamptz" Vocab.TypeInfo.timestamptz Binary.timestamptz_int+timestamptz = primitive "timestamptz" CodecVocab.TypeInfo.timestamptz Binary.timestamptz_int  -- | -- Decoder of the @TIME@ values. {-# INLINEABLE time #-} time :: Value TimeOfDay-time = primitive "time" Vocab.TypeInfo.time Binary.time_int+time = primitive "time" CodecVocab.TypeInfo.time Binary.time_int  -- | -- Decoder of the @TIMETZ@ values.@@ -216,25 +213,25 @@ -- to represent a value on the Haskell's side. {-# INLINEABLE timetz #-} timetz :: Value (TimeOfDay, TimeZone)-timetz = primitive "timetz" Vocab.TypeInfo.timetz Binary.timetz_int+timetz = primitive "timetz" CodecVocab.TypeInfo.timetz Binary.timetz_int  -- | -- Decoder of the @INTERVAL@ values. {-# INLINEABLE interval #-} interval :: Value DiffTime-interval = primitive "interval" Vocab.TypeInfo.interval Binary.interval_int+interval = primitive "interval" CodecVocab.TypeInfo.interval Binary.interval_int  -- | -- Decoder of the @UUID@ values. {-# INLINEABLE uuid #-} uuid :: Value UUID-uuid = primitive "uuid" Vocab.TypeInfo.uuid Binary.uuid+uuid = primitive "uuid" CodecVocab.TypeInfo.uuid Binary.uuid  -- | -- Decoder of the @INET@ values. {-# INLINEABLE inet #-} inet :: Value Iproute.IPRange-inet = primitive "inet" Vocab.TypeInfo.inet Binary.inet+inet = primitive "inet" CodecVocab.TypeInfo.inet Binary.inet  -- | -- Decoder of the @MACADDR@ values.@@ -245,103 +242,103 @@ -- > (\(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+macaddr = primitive "macaddr" CodecVocab.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+json = primitive "json" CodecVocab.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)+jsonBytes fn = primitive "json" CodecVocab.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+jsonb = primitive "jsonb" CodecVocab.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)+jsonbBytes fn = primitive "jsonb" CodecVocab.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+int4range = primitive "int4range" CodecVocab.TypeInfo.int4range Binary.int4range  -- | -- Decoder of the @INT8RANGE@ values. {-# INLINEABLE int8range #-} int8range :: Value (R.Range Int64)-int8range = primitive "int8range" Vocab.TypeInfo.int8range Binary.int8range+int8range = primitive "int8range" CodecVocab.TypeInfo.int8range Binary.int8range  -- | -- Decoder of the @NUMRANGE@ values. {-# INLINEABLE numrange #-} numrange :: Value (R.Range Scientific)-numrange = primitive "numrange" Vocab.TypeInfo.numrange Binary.numrange+numrange = primitive "numrange" CodecVocab.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+tsrange = primitive "tsrange" CodecVocab.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+tstzrange = primitive "tstzrange" CodecVocab.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+daterange = primitive "daterange" CodecVocab.TypeInfo.daterange Binary.daterange  -- | -- Decoder of the @INT4MULTIRANGE@ values. {-# INLINEABLE int4multirange #-} int4multirange :: Value (R.Multirange Int32)-int4multirange = primitive "int4multirange" Vocab.TypeInfo.int4multirange Binary.int4multirange+int4multirange = primitive "int4multirange" CodecVocab.TypeInfo.int4multirange Binary.int4multirange  -- | -- Decoder of the @INT8MULTIRANGE@ values. {-# INLINEABLE int8multirange #-} int8multirange :: Value (R.Multirange Int64)-int8multirange = primitive "int8multirange" Vocab.TypeInfo.int8multirange Binary.int8multirange+int8multirange = primitive "int8multirange" CodecVocab.TypeInfo.int8multirange Binary.int8multirange  -- | -- Decoder of the @NUMMULTIRANGE@ values. {-# INLINEABLE nummultirange #-} nummultirange :: Value (R.Multirange Scientific)-nummultirange = primitive "nummultirange" Vocab.TypeInfo.nummultirange Binary.nummultirange+nummultirange = primitive "nummultirange" CodecVocab.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+tsmultirange = primitive "tsmultirange" CodecVocab.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+tstzmultirange = primitive "tstzmultirange" CodecVocab.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+datemultirange = primitive "datemultirange" CodecVocab.TypeInfo.datemultirange Binary.datemultirange  -- | -- Decoder of the @CITEXT@ values.@@ -349,7 +346,7 @@ -- 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)+citext = Value Nothing "citext" Nothing Nothing 0 (pure Binary.text_strict)  -- | -- Low level API for defining custom value decoders.@@ -385,9 +382,9 @@     (fmap fst staticOids)     (fmap snd staticOids)     0-    (RequestingOid.requestAndHandle (fmap Vocab.QualifiedTypeName.fromNameTuple requestedTypes) (\lookup -> Binary.fn (fn (toTuple . lookup . Vocab.QualifiedTypeName.fromNameTuple))))+    (ToBeResolved.ToBeResolved (fmap CodecVocab.QualifiedTypeName.fromNameTuple requestedTypes) (\lookup -> Binary.fn (fn (toTuple . lookup . CodecVocab.QualifiedTypeName.fromNameTuple))))   where-    toTuple typeInfo = (Vocab.TypeInfo.toBaseOid typeInfo, Vocab.TypeInfo.toArrayOid typeInfo)+    toTuple typeInfo = (CodecVocab.TypeInfo.toBaseOid typeInfo, CodecVocab.TypeInfo.toArrayOid typeInfo)  -- | -- Refine a value decoder, lifting the possible error to the session level.@@ -408,7 +405,7 @@ {-# 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))+  Value Nothing "hstore" Nothing Nothing 0 (pure (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.@@ -421,7 +418,7 @@   (Text -> Maybe a) ->   Value a enum schema typeName mapping =-  Value schema typeName Nothing Nothing 0 (RequestingOid.lift (Binary.enum mapping))+  Value schema typeName Nothing Nothing 0 (pure (Binary.enum mapping))  -- * Relations @@ -446,16 +443,8 @@ toArrayOid :: Value a -> Maybe Word32 toArrayOid (Value _ _ _ oid _ _) = oid -toDecoder :: Value a -> RequestingOid.RequestingOid (Binary.Value a)+toDecoder :: Value a -> ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo (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 view
@@ -77,15 +77,15 @@   ) where -import Data.HashMap.Strict qualified as HashMap+import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName+import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo 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 Hasql.ToBeResolved qualified as ToBeResolved import PostgreSQL.Binary.Encoding qualified as Binary import TextBuilder qualified @@ -116,19 +116,15 @@ -- | -- 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+array (Array.Array baseTypeSchema baseTypeName _isText dimensionality scalarOidIfKnown arrayOidIfKnown arrayEncoder renderer) =+  let toEncoder baseOid encode = \input -> Binary.array baseOid (encode input)+      encoder = case scalarOidIfKnown of+        Just oid -> fmap (toEncoder oid) arrayEncoder+        Nothing ->+          (\typeInfo -> toEncoder (CodecVocab.TypeInfo.toBaseOid typeInfo))+            <$> ToBeResolved.lookup (CodecVocab.QualifiedTypeName.QualifiedTypeName baseTypeSchema baseTypeName)+            <*> arrayEncoder+   in Value.Value baseTypeSchema baseTypeName scalarOidIfKnown arrayOidIfKnown dimensionality False encoder renderer  -- | -- Lift a composite encoder into a value encoder for named composite types.@@ -143,10 +139,9 @@   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+composite schema name (Composite.Composite request print) =+  Value.Value schema name Nothing Nothing 0 False encoder printValue   where-    encodeValue oidCache val =-      Binary.composite (encode oidCache val)+    encoder = fmap (Binary.composite .) request     printValue val =       "ROW (" <> TextBuilder.intercalate ", " (print val) <> ")"
src/library/Hasql/Codecs/Encoders/Array.hs view
@@ -1,9 +1,11 @@ module Hasql.Codecs.Encoders.Array where +import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName+import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo 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 Hasql.ToBeResolved qualified as ToBeResolved import PostgreSQL.Binary.Encoding qualified as Binary import TextBuilder qualified as TextBuilder @@ -33,22 +35,20 @@       (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)+      -- | Serialization function, deferring the names of types that must be looked up at runtime.+      (ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.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)+  contramap fn (Array schemaName typeName textFormat dimensionality valueOid arrayOid elEncoder elRenderer) =+    Array schemaName typeName textFormat dimensionality valueOid arrayOid (fmap (\encode -> encode . fn) elEncoder) (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) ->+  NullableOrNot.NonNullable (Value.Value schemaName typeName scalarOid arrayOid dimensionality textFormat serialize print) ->     Array       schemaName       typeName@@ -56,12 +56,11 @@       dimensionality       scalarOid       arrayOid-      unknownTypes-      (\oidCache -> Binary.encodingArray . serialize oidCache)+      (fmap (Binary.encodingArray .) serialize)       print-  NullableOrNot.Nullable (Value.Value schemaName typeName scalarOid arrayOid dimensionality textFormat unknownTypes serialize print) ->-    let maybeSerialize oidCache =-          maybe Binary.nullArray (Binary.encodingArray . serialize oidCache)+  NullableOrNot.Nullable (Value.Value schemaName typeName scalarOid arrayOid dimensionality textFormat serialize print) ->+    let maybeSerialize encode =+          maybe Binary.nullArray (Binary.encodingArray . encode)         maybePrint =           maybe (TextBuilder.string "null") print      in Array@@ -71,8 +70,7 @@           dimensionality           scalarOid           arrayOid-          unknownTypes-          maybeSerialize+          (fmap maybeSerialize serialize)           maybePrint  -- |@@ -88,9 +86,9 @@ -- * 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)+dimension fold (Array schemaName typeName textFormat dimensionality valueOid arrayOid elEncoder elRenderer) =+  let encoder =+        Binary.dimensionArray fold       renderer els =         let folded =               let step builder el =@@ -101,4 +99,4 @@          in if TextBuilder.isEmpty folded               then TextBuilder.string "[]"               else folded <> TextBuilder.char ']'-   in Array schemaName typeName textFormat (succ dimensionality) valueOid arrayOid unknownTypes encoder renderer+   in Array schemaName typeName textFormat (succ dimensionality) valueOid arrayOid (fmap encoder elEncoder) renderer
src/library/Hasql/Codecs/Encoders/Composite.hs view
@@ -1,13 +1,11 @@ module Hasql.Codecs.Encoders.Composite where -import Data.HashMap.Strict qualified as HashMap-import Data.HashSet qualified as HashSet+import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName+import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo 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 Hasql.ToBeResolved qualified as ToBeResolved import PostgreSQL.Binary.Encoding qualified as Binary import TextBuilder qualified @@ -15,83 +13,61 @@ -- 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)+      -- | Serialization function, deferring the names of types that must be looked up at runtime.+      (ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.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)+  contramap f (Composite request print) =+    Composite (fmap (. f) request) (print . f)  instance Divisible Composite where-  divide f (Composite unknownTypesL encodeL printL) (Composite unknownTypesR encodeR printR) =+  divide f (Composite requestL printL) (Composite requestR printR) =     Composite-      (unknownTypesL <> unknownTypesR)-      (\oidCache val -> case f val of (lVal, rVal) -> encodeL oidCache lVal <> encodeR oidCache rVal)+      ( liftA2+          (\encodeL encodeR val -> case f val of (lVal, rVal) -> encodeL lVal <> encodeR rVal)+          requestL+          requestR+      )       (\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 requestL printL <> Composite requestR printR =     Composite-      (unknownTypesL <> unknownTypesR)-      (\oidCache val -> encodeL oidCache val <> encodeR oidCache val)+      (liftA2 (\encodeL encodeR val -> encodeL val <> encodeR val) requestL requestR)       (\val -> printL val <> printR val)  instance Monoid (Composite a) where-  mempty = Composite mempty mempty mempty+  mempty = Composite (pure 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) ->+  NullableOrNot.NonNullable (Value.Value schemaName typeName scalarOid arrayOid dimensionality _ serialize print) ->     let staticOid = if dimensionality == 0 then scalarOid else arrayOid+        toField oid encode = \val -> Binary.field oid (encode val)      in case staticOid of           Just oid ->-            Composite-              unknownTypes-              (\oidCache val -> Binary.field oid (encode oidCache val))-              (\val -> [print val])+            Composite (fmap (toField oid) serialize) (\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)+              ( (\typeInfo -> toField (if dimensionality == 0 then CodecVocab.TypeInfo.toBaseOid typeInfo else CodecVocab.TypeInfo.toArrayOid typeInfo))+                  <$> ToBeResolved.lookup (CodecVocab.QualifiedTypeName.QualifiedTypeName schemaName typeName)+                  <*> serialize               )               (\val -> [print val])-  NullableOrNot.Nullable (Value.Value schemaName typeName scalarOid arrayOid dimensionality _ unknownTypes encode print) ->+  NullableOrNot.Nullable (Value.Value schemaName typeName scalarOid arrayOid dimensionality _ serialize print) ->     let staticOid = if dimensionality == 0 then scalarOid else arrayOid+        toField oid encode = maybe (Binary.nullField oid) (Binary.field oid . encode)      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]-              )+            Composite (fmap (toField oid) serialize) (maybe ["NULL"] (\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]+              ( (\typeInfo -> toField (if dimensionality == 0 then CodecVocab.TypeInfo.toBaseOid typeInfo else CodecVocab.TypeInfo.toArrayOid typeInfo))+                  <$> ToBeResolved.lookup (CodecVocab.QualifiedTypeName.QualifiedTypeName schemaName typeName)+                  <*> serialize               )+              (maybe ["NULL"] (\val -> [print val]))
src/library/Hasql/Codecs/Encoders/Params.hs view
@@ -9,37 +9,36 @@   ) where -import Data.HashSet qualified as HashSet+import CodecVocab qualified as CodecVocab+import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName+import CodecVocab.TypeRef qualified as CodecVocab.TypeRef+import CodecVocab.TypeShape (TypeShape (..)) 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 Hasql.ToBeResolved qualified as ToBeResolved 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+-- | Frozen per-parameter type shapes: type reference, dimensionality, text-format flag.+toColumnsMetadata :: Params a -> Vector TypeShape+toColumnsMetadata (Params _ _ columnsMetadata _) = freezeColumnsMetadata columnsMetadata   where     freezeColumnsMetadata =       Vector.fromList . toList -toUnknownTypes :: Params a -> HashSet Vocab.QualifiedTypeName-toUnknownTypes (Params _ unknownTypes _ _ _) =-  unknownTypes+toUnknownTypes :: Params a -> HashSet CodecVocab.QualifiedTypeName+toUnknownTypes (Params _ (ToBeResolved.ToBeResolved unknownTypes _) _ _) =+  fromList unknownTypes --- | Serialise params to encoded wire values given a resolved OID cache.-toSerializer :: Params a -> Vocab.OidCache -> a -> [Maybe ByteString]-toSerializer (Params _ _ _ serializer _) = serializer+-- | Serialise params to encoded wire values given a resolver of type names to their OIDs.+toSerializer :: Params a -> (CodecVocab.QualifiedTypeName -> CodecVocab.TypeInfo) -> a -> [Maybe ByteString]+toSerializer (Params _ (ToBeResolved.ToBeResolved _ serializer) _ _) resolve = serializer resolve  -- | Render params in human-readable form (for error reporting). toPrinter :: Params a -> a -> [Text]-toPrinter (Params _ _ _ _ printer) = toList . printer+toPrinter (Params _ _ _ printer) = toList . printer  -- | -- Encoder of some representation of a parameters product.@@ -87,49 +86,49 @@ -- @ 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],+    -- | Serialization function, deferring the names of types that must be looked up at runtime.+    request :: ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName CodecVocab.TypeInfo (a -> [Maybe ByteString]),+    -- | Type shape for each parameter.+    columnsMetadata :: DList TypeShape,     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+  contramap fn (Params size request columnsMetadata printer) =+    Params size (fmap (. fn) request) columnsMetadata (printer . fn)  instance Divisible Params where   divide     divisor-    (Params leftSize leftUnknownTypes leftColumnsMetadata leftSerializer leftPrinter)-    (Params rightSize rightUnknownTypes rightColumnsMetadata rightSerializer rightPrinter) =+    (Params leftSize leftRequest leftColumnsMetadata leftPrinter)+    (Params rightSize rightRequest rightColumnsMetadata rightPrinter) =       Params         { size = leftSize + rightSize,-          unknownTypes = leftUnknownTypes <> rightUnknownTypes,+          request =+            liftA2+              ( \leftSerializer rightSerializer input -> case divisor input of+                  (leftInput, rightInput) -> leftSerializer leftInput <> rightSerializer rightInput+              )+              leftRequest+              rightRequest,           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,+        request = pure 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 leftSize leftRequest leftColumnsMetadata leftPrinter <> Params rightSize rightRequest rightColumnsMetadata rightPrinter =     Params       { size = leftSize + rightSize,-        unknownTypes = leftUnknownTypes <> rightUnknownTypes,+        request = liftA2 (\leftSerializer rightSerializer input -> leftSerializer input <> rightSerializer input) leftRequest rightRequest,         columnsMetadata = leftColumnsMetadata <> rightColumnsMetadata,-        serializer = \oidCache input -> leftSerializer oidCache input <> rightSerializer oidCache input,         printer = \input -> leftPrinter input <> rightPrinter input       } @@ -137,52 +136,50 @@   mempty = conquer  value :: Value.Value a -> Params a-value (Value.Value schemaName typeName scalarOid arrayOid dimensionality textFormat unknownTypes serialize print) =+value (Value.Value schemaName typeName scalarOid arrayOid dimensionality textFormat serialize print) =   let staticOid = if dimensionality == 0 then scalarOid else arrayOid-      serializer oidCache = pure . Just . Binary.encodingBytes . serialize (Vocab.OidCache.toHashMap oidCache)+      toRequest = fmap (\encode -> pure . Just . Binary.encodingBytes . encode)       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,+              request = toRequest serialize,+              columnsMetadata = pure (TypeShape (CodecVocab.TypeRef.KnownOid oid) dimensionality textFormat),               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-            }+          let key = CodecVocab.QualifiedTypeName.QualifiedTypeName schemaName typeName+           in Params+                { size,+                  request = toRequest (ToBeResolved.lookup key *> serialize),+                  columnsMetadata = pure (TypeShape (CodecVocab.TypeRef.NamedType key) dimensionality textFormat),+                  printer+                }  nullableValue :: Value.Value a -> Params (Maybe a)-nullableValue (Value.Value schemaName typeName scalarOid arrayOid dimensionality textFormat unknownTypes serialize print) =+nullableValue (Value.Value schemaName typeName scalarOid arrayOid dimensionality textFormat serialize print) =   let staticOid = if dimensionality == 0 then scalarOid else arrayOid-      serializer oidCache = pure . fmap (Binary.encodingBytes . serialize (Vocab.OidCache.toHashMap oidCache))+      toRequest = fmap (\encode -> pure . fmap (Binary.encodingBytes . encode))       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,+              request = toRequest serialize,+              columnsMetadata = pure (TypeShape (CodecVocab.TypeRef.KnownOid oid) dimensionality textFormat),               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-            }+          let key = CodecVocab.QualifiedTypeName.QualifiedTypeName schemaName typeName+           in Params+                { size,+                  request = toRequest (ToBeResolved.lookup key *> serialize),+                  columnsMetadata = pure (TypeShape (CodecVocab.TypeRef.NamedType key) dimensionality textFormat),+                  printer+                }  -- | -- No parameters. Same as `mempty` and `conquered`.
src/library/Hasql/Codecs/Encoders/Value.hs view
@@ -1,15 +1,14 @@ module Hasql.Codecs.Encoders.Value where  import ByteString.StrictBuilder qualified+import CodecVocab qualified as CodecVocab+import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName+import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo 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 Hasql.ToBeResolved qualified as ToBeResolved import PostgreSQL.Binary.Encoding qualified as Binary import PostgreSQL.Binary.Range qualified as Range import TextBuilder qualified as TextBuilder@@ -33,73 +32,70 @@       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)+      -- | Serialization function, deferring the names of types that must be looked up at runtime.+      (ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName CodecVocab.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)+  contramap f (Value schemaName typeName valueOid arrayOid dimensionality textFormat serialize render) =+    Value schemaName typeName valueOid arrayOid dimensionality textFormat (fmap (\encode -> encode . f) serialize) (render . f)  {-# INLINE primitive #-}-primitive :: Text -> Bool -> Vocab.TypeInfo.TypeInfo -> (a -> Binary.Encoding) -> (a -> TextBuilder.TextBuilder) -> Value a+primitive :: Text -> Bool -> CodecVocab.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))+    (Just (CodecVocab.TypeInfo.toBaseOid typeInfo))+    (Just (CodecVocab.TypeInfo.toArrayOid typeInfo))     0     isText-    HashSet.empty-    (const encode)+    (pure encode)     render  -- | -- Encoder of @BOOL@ values. {-# INLINEABLE bool #-} bool :: Value Bool-bool = primitive "bool" False Vocab.TypeInfo.bool Binary.bool (TextBuilder.string . show)+bool = primitive "bool" False CodecVocab.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)+int2 = primitive "int2" False CodecVocab.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)+int4 = primitive "int4" False CodecVocab.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)+int8 = primitive "int8" False CodecVocab.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)+float4 = primitive "float4" False CodecVocab.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)+float8 = primitive "float8" False CodecVocab.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)+numeric = primitive "numeric" False CodecVocab.TypeInfo.numeric Binary.numeric (TextBuilder.string . show)  -- | -- Encoder of @CHAR@ values.@@ -108,79 +104,79 @@ -- 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)+char = primitive "char" False CodecVocab.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)+text = primitive "text" False CodecVocab.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)+varchar = primitive "varchar" False CodecVocab.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)+bpchar = primitive "bpchar" False CodecVocab.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)+bytea = primitive "bytea" False CodecVocab.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)+date = primitive "date" False CodecVocab.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)+timestamp = primitive "timestamp" False CodecVocab.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)+timestamptz = primitive "timestamptz" False CodecVocab.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)+time = primitive "time" False CodecVocab.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)+timetz = primitive "timetz" False CodecVocab.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)+interval = primitive "interval" False CodecVocab.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)+uuid = primitive "uuid" False CodecVocab.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)+inet = primitive "inet" False CodecVocab.TypeInfo.inet Binary.inet (TextBuilder.string . show)  -- | -- Encoder of @MACADDR@ values.@@ -191,127 +187,127 @@ -- > toOctets >$< macaddr {-# INLINEABLE macaddr #-} macaddr :: Value (Word8, Word8, Word8, Word8, Word8, Word8)-macaddr = primitive "macaddr" False Vocab.TypeInfo.macaddr Binary.macaddr (TextBuilder.string . show)+macaddr = primitive "macaddr" False CodecVocab.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)+json = primitive "json" False CodecVocab.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)+jsonBytes = primitive "json" False CodecVocab.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)+jsonLazyBytes = primitive "json" False CodecVocab.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)+jsonb = primitive "jsonb" False CodecVocab.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)+jsonbBytes = primitive "jsonb" False CodecVocab.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)+jsonbLazyBytes = primitive "jsonb" False CodecVocab.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)+oid = primitive "oid" False CodecVocab.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)+name = primitive "name" False CodecVocab.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)+int4range = primitive "int4range" False CodecVocab.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)+int8range = primitive "int8range" False CodecVocab.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)+numrange = primitive "numrange" False CodecVocab.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)+tsrange = primitive "tsrange" False CodecVocab.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)+tstzrange = primitive "tstzrange" False CodecVocab.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)+daterange = primitive "daterange" False CodecVocab.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)+int4multirange = primitive "int4multirange" False CodecVocab.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)+int8multirange = primitive "int8multirange" False CodecVocab.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)+nummultirange = primitive "nummultirange" False CodecVocab.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)+tsmultirange = primitive "tsmultirange" False CodecVocab.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)+tstzmultirange = primitive "tstzmultirange" False CodecVocab.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)+datemultirange = primitive "datemultirange" False CodecVocab.TypeInfo.datemultirange Binary.datemultirange (TextBuilder.string . show)  -- | -- Encoder of @CITEXT@ values.@@ -327,8 +323,7 @@     Nothing     0     False-    HashSet.empty-    (const Binary.text_strict)+    (pure Binary.text_strict)     (TextBuilder.string . show)  -- |@@ -351,8 +346,7 @@     Nothing     0     False-    (HashSet.singleton (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName))-    (const (Binary.text_strict . mapping))+    (fmap (\_typeInfo -> Binary.text_strict . mapping) (ToBeResolved.lookup (CodecVocab.QualifiedTypeName schemaName typeName)))     (TextBuilder.text . mapping)  -- |@@ -369,7 +363,7 @@ {-# DEPRECATED unknown "Use 'custom' instead." #-} {-# INLINEABLE unknown #-} unknown :: Value ByteString-unknown = primitive "unknown" True Vocab.TypeInfo.unknown Binary.bytea_strict (TextBuilder.string . show)+unknown = primitive "unknown" True CodecVocab.TypeInfo.unknown Binary.bytea_strict (TextBuilder.string . show)  -- | -- Low level API for defining custom value encoders.@@ -408,15 +402,16 @@     (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)-            )+    ( ToBeResolved.ToBeResolved+        (fmap CodecVocab.QualifiedTypeName.fromNameTuple requiredTypes)+        ( \resolve ->+            ByteString.StrictBuilder.bytes+              . encode+                ( \name ->+                    let typeInfo = resolve (CodecVocab.QualifiedTypeName.fromNameTuple name)+                     in (CodecVocab.TypeInfo.toBaseOid typeInfo, CodecVocab.TypeInfo.toArrayOid typeInfo)+                )+        )     )     (TextBuilder.text . render) @@ -434,8 +429,7 @@     Nothing     0     False-    HashSet.empty-    (const Binary.hStore_foldable)+    (pure Binary.hStore_foldable)     renderHstore   where     renderHstore items =
− 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
@@ -13,12 +13,13 @@ import Hasql.Connection.Config qualified as Config import Hasql.Connection.ServerVersion qualified as ServerVersion import Hasql.Connection.Settings qualified as Settings+import Hasql.ConnectionState qualified as ConnectionState+import Hasql.ConnectionState.StatementCache qualified as StatementCache import Hasql.Engine.Contexts.Session qualified as Session import Hasql.Engine.Errors-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.@@ -27,16 +28,34 @@  -- | -- Establish a connection according to the provided settings.+--+-- The first argument is an 'Pqi.Adapter', which defines the backend+-- implementation used to talk to PostgreSQL (for example, libpq via the+-- <https://hackage.haskell.org/package/pqi-ffi pqi-ffi> package, or a pure+-- Haskell implementation via the+-- <https://hackage.haskell.org/package/pqi-native pqi-native> package).+-- This is the only place in the library where users choose the adapter.+--+-- This function:+--+-- - Opens a PostgreSQL connection using the constructed connection string.+-- - Validates that the connection is healthy.+-- - Checks the server version for compatibility.+-- - Initializes session-level settings (encoding and message verbosity).+--+-- On success, returns a 'Connection' wrapped in 'Right'.+-- On failure, returns a classified 'ConnectionError' in 'Left'. 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 view
@@ -5,19 +5,18 @@   ) where +import CodecVocab qualified as CodecVocab+import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName 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.ConnectionState.OidCache qualified as OidCache+import Hasql.ConnectionState.StatementCache qualified as StatementCache 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+import Pqi qualified as Pq  run ::   Pipeline a ->@@ -44,7 +43,7 @@             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))+                  then Left (Errors.MissingTypesSessionError (HashSet.map CodecVocab.QualifiedTypeName.toNameTuple notFoundTypes))                   else Right (oidCache <> OidCache.fromHashMap oidCacheUpdates)   case resolvedOidCache of     Left err -> pure (Left err, oidCache, statementCache)@@ -144,8 +143,8 @@       -- 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)+      -- In the execution function we will be defaulting to OID 0 for unknown types as a fallback in case of bugs.+      (HashSet CodecVocab.QualifiedTypeName)       -- | Function that runs the pipeline.       --       -- The integer parameter indicates the current offset of the statement in the pipeline (0-based).@@ -217,11 +216,10 @@         then runPrepared         else runUnprepared       where-        (oidList, valueAndFormatList) =-          Statement.compilePreparedStatementData stmt oidCache params+        resolve = OidCache.toResolver oidCache -        pqOidList =-          fmap (Pq.Oid . fromIntegral) oidList+        (oidList, valueAndFormatList) =+          Statement.compilePreparedStatementData stmt resolve params          prepare =           usePreparedStatements && Statement.isPrepared stmt@@ -238,16 +236,16 @@           (roundtrip, newStatementCache)           where             (isNew, remoteKey, newStatementCache) =-              case StatementCache.lookup sql pqOidList statementCache of+              case StatementCache.lookup sql oidList statementCache of                 Just remoteKey -> (False, remoteKey, statementCache)                 Nothing ->-                  let (remoteKey, newStatementCache) = StatementCache.insert sql pqOidList statementCache+                  let (remoteKey, newStatementCache) = StatementCache.insert sql oidList statementCache                    in (True, remoteKey, newStatementCache)              roundtrip =               when                 isNew-                (Comms.Roundtrip.prepare (context statementCache) remoteKey sql pqOidList)+                (Comms.Roundtrip.prepare (context statementCache) remoteKey sql oidList)                 *> Comms.Roundtrip.queryPrepared (context newStatementCache) remoteKey encodedParams Pq.Binary decoder'               where                 encodedParams =@@ -261,8 +259,8 @@               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)))+                  Statement.compileUnpreparedStatementData stmt resolve params+                    & fmap (fmap (\(oid, bytes, format) -> (oid, bytes, bool Pq.Binary Pq.Text format)))          decoder' =-          RequestingOid.toBase (Statement.decoder stmt) oidCache+          Statement.decoder stmt resolve
src/library/Hasql/Engine/Contexts/Session.hs view
@@ -1,19 +1,18 @@ module Hasql.Engine.Contexts.Session where +import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName 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.ConnectionState qualified as ConnectionState+import Hasql.ConnectionState.OidCache qualified as OidCache+import Hasql.ConnectionState.StatementCache qualified as StatementCache 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+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.@@ -100,12 +99,13 @@               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))+                    then Left (Errors.MissingTypesSessionError (HashSet.map CodecVocab.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+        let resolve = OidCache.toResolver newOidCache+            decoder' = Statement.decoder stmt resolve             prepared = usePreparedStatements && Statement.isPrepared stmt             -- Single-statement context for error reporting:             -- total statements 1, index 0.@@ -126,8 +126,7 @@           $ if prepared             then do               let (oidList, valueAndFormatList) =-                    Statement.compilePreparedStatementData stmt newOidCache params-                  pqOidList = fmap (Pq.Oid . fromIntegral) oidList+                    Statement.compilePreparedStatementData stmt resolve params                   encodedParams =                     valueAndFormatList                       & fmap (fmap (\(bytes, format) -> (bytes, bool Pq.Binary Pq.Text format)))@@ -135,17 +134,17 @@                     Comms.Roundtrip.toSerialIO                       (Comms.Roundtrip.queryPrepared context remoteKey encodedParams Pq.Binary decoder')                       connection-              case StatementCache.lookup sql pqOidList statementCache of+              case StatementCache.lookup sql oidList statementCache of                 Just remoteKey -> do                   result <- execute remoteKey                   pure (result, statementCache)                 Nothing -> do-                  let (remoteKey, newStatementCache) = StatementCache.insert sql pqOidList statementCache+                  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 pqOidList)+                      (Comms.Roundtrip.prepare context remoteKey sql oidList)                       connection                   case prepareResult of                     -- PARSE failed: the statement is not on the server, so@@ -160,8 +159,8 @@                       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)))+                    Statement.compileUnpreparedStatementData stmt resolve 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')
src/library/Hasql/Engine/Decoders/Result.hs view
@@ -1,22 +1,29 @@ module Hasql.Engine.Decoders.Result where -import Hasql.Codecs.RequestingOid qualified as RequestingOid+import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName+import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo 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+import Hasql.ToBeResolved qualified as ToBeResolved  -- | -- Decoder of a query result. newtype Result a-  = Result (RequestingOid.RequestingOid (ResultDecoder.ResultDecoder a))+  = Result (ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo (ResultDecoder.ResultDecoder a))   deriving     (Functor, Applicative, Filterable)-    via (Compose RequestingOid.RequestingOid ResultDecoder.ResultDecoder)+    via (Compose (ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo) ResultDecoder.ResultDecoder) -unwrap :: Result a -> RequestingOid.RequestingOid (ResultDecoder.ResultDecoder a)-unwrap (Result decoder) = decoder+-- | Names of types that must be looked up at runtime before the decoder can run.+toUnknownTypes :: Result a -> HashSet CodecVocab.QualifiedTypeName.QualifiedTypeName+toUnknownTypes (Result (ToBeResolved.ToBeResolved unknownTypes _)) = fromList unknownTypes +-- | Resolve the decoder given a resolver of type names to their OIDs.+toBase :: Result a -> (CodecVocab.QualifiedTypeName.QualifiedTypeName -> CodecVocab.TypeInfo.TypeInfo) -> ResultDecoder.ResultDecoder a+toBase (Result (ToBeResolved.ToBeResolved _ decoder)) = decoder+ -- * Construction  -- |@@ -26,7 +33,7 @@ {-# INLINE noResult #-} noResult :: Result () noResult =-  Result (RequestingOid.lift ResultDecoder.ok)+  Result (pure ResultDecoder.ok)  -- | -- Get the amount of rows affected by such statements as@@ -34,7 +41,7 @@ {-# INLINE rowsAffected #-} rowsAffected :: Result Int64 rowsAffected =-  Result (RequestingOid.lift ResultDecoder.rowsAffected)+  Result (pure ResultDecoder.rowsAffected)  -- | -- Exactly one row.
src/library/Hasql/Engine/Decoders/Row.hs view
@@ -1,12 +1,12 @@ module Hasql.Engine.Decoders.Row where +import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName+import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo 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 Hasql.ToBeResolved qualified as ToBeResolved import PostgreSQL.Binary.Decoding qualified as Binary  -- |@@ -19,14 +19,14 @@ -- x = (,,) '<$>' ('column' . 'nullable') 'int8' '<*>' ('column' . 'nonNullable') 'text' '<*>' ('column' . 'nonNullable') 'time' -- @ newtype Row a-  = Row (RequestingOid.RequestingOid (Hasql.Comms.RowDecoder.RowDecoder a))+  = Row (ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo (Hasql.Comms.RowDecoder.RowDecoder a))   deriving     (Functor, Applicative, Filterable)-    via (Compose RequestingOid.RequestingOid Hasql.Comms.RowDecoder.RowDecoder)+    via (Compose (ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo) Hasql.Comms.RowDecoder.RowDecoder)  toDecoder ::   Row a ->-  RequestingOid.RequestingOid (Hasql.Comms.RowDecoder.RowDecoder a)+  ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo (Hasql.Comms.RowDecoder.RowDecoder a) toDecoder (Row f) = f  -- |@@ -40,26 +40,24 @@         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)+      Nothing ->+        ( \lookupResult decoder ->+            Hasql.Comms.RowDecoder.nullableColumn (Just (chooseLookedUpOid valueDecoder lookupResult)) (Binary.valueParser decoder)+        )+          <$> ToBeResolved.lookup (CodecVocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema valueDecoder) (Value.toTypeName valueDecoder))+          <*> 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)+      Nothing ->+        (\lookupResult decoder -> Hasql.Comms.RowDecoder.nonNullableColumn (Just (chooseLookedUpOid valueDecoder lookupResult)) (Binary.valueParser decoder))+          <$> ToBeResolved.lookup (CodecVocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema valueDecoder) (Value.toTypeName valueDecoder))+          <*> Value.toDecoder valueDecoder   where     chooseLookedUpOid valueDecoder typeInfo =       if Value.toDimensionality valueDecoder > 0-        then Vocab.TypeInfo.toArrayOid typeInfo-        else Vocab.TypeInfo.toBaseOid typeInfo+        then CodecVocab.TypeInfo.toArrayOid typeInfo+        else CodecVocab.TypeInfo.toBaseOid typeInfo
src/library/Hasql/Engine/PqProcedures/SelectTypeInfo.hs view
@@ -5,28 +5,28 @@   ) where +import CodecVocab qualified as CodecVocab+import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName+import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo 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.Decoding qualified as BinaryDecoding 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+    keys :: HashSet CodecVocab.QualifiedTypeName   }  -- | Result maps (schema name, type name) pairs to TypeInfo (scalar OID, array OID). type SelectTypeInfoResult =-  HashMap Vocab.QualifiedTypeName Vocab.TypeInfo.TypeInfo+  HashMap CodecVocab.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo  run :: Pq.Connection -> SelectTypeInfo -> IO (Either Errors.SessionError SelectTypeInfoResult) run connection (SelectTypeInfo keys) =@@ -76,13 +76,13 @@  -- | 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 -> [Maybe (Word32, ByteString, Pq.Format)] encodeParams (SelectTypeInfo keys) =-  let (schemaNames, typeNames) = unzip (fmap Vocab.QualifiedTypeName.toNameTuple (HashSet.toList keys))+  let (schemaNames, typeNames) = unzip (fmap CodecVocab.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)+   in [ Just (1009, schemaArray, Pq.Binary),+        Just (1009, typeArray, Pq.Binary)       ]   where     encodeTextArray elements =@@ -97,22 +97,28 @@   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+      HashMap.insert (CodecVocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) (CodecVocab.TypeInfo.TypeInfo typeOid arrayOid) acc +-- | These four columns have permanently fixed, well-known Postgres OIDs+-- (text = 25, int4 = 23), so they're decoded directly against+-- "postgresql-binary" rather than through the dynamic codec framework. 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)+    <$> nullableColumn textOid BinaryDecoding.text_strict+    <*> nonNullableColumn textOid BinaryDecoding.text_strict+    <*> nonNullableColumn int4Oid BinaryDecoding.int+    <*> nonNullableColumn int4Oid BinaryDecoding.int   where-    nullableColumn valueDecoder =+    textOid = 25+    int4Oid = 23++    nullableColumn oid valueDecoder =       Hasql.Comms.RowDecoder.nullableColumn-        (Decoders.Value.toBaseOid valueDecoder)-        (Decoders.Value.toByteStringParser valueDecoder mempty)+        (Just oid)+        (BinaryDecoding.valueParser valueDecoder) -    nonNullableColumn valueDecoder =+    nonNullableColumn oid valueDecoder =       Hasql.Comms.RowDecoder.nonNullableColumn-        (Decoders.Value.toBaseOid valueDecoder)-        (Decoders.Value.toByteStringParser valueDecoder mempty)+        (Just oid)+        (BinaryDecoding.valueParser valueDecoder)
src/library/Hasql/Engine/Statement.hs view
@@ -9,17 +9,16 @@   ) where +import CodecVocab qualified as CodecVocab+import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo+import CodecVocab.TypeRef qualified as CodecVocab.TypeRef+import CodecVocab.TypeShape (TypeShape (..)) 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.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders+import Hasql.Engine.Decoders.Result qualified as Decoders import Hasql.Engine.Decoders.Result qualified as Decoders.Result import Hasql.Platform.Prelude @@ -49,17 +48,17 @@   = Statement   { -- | SQL template pre-encoded as UTF-8 for execution.     sql :: ByteString,-    -- | Frozen per-parameter metadata: type reference, dimensionality, text-format flag.+    -- | Frozen per-parameter type shapes.     -- 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],+    columnsMetadata :: Vector TypeShape,+    -- | Serialise params to encoded wire values given a resolver of type names to their OIDs.+    serializer :: (CodecVocab.QualifiedTypeName -> CodecVocab.TypeInfo) -> 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),+    unknownTypes :: HashSet CodecVocab.QualifiedTypeName,+    -- | Result decoder, given a resolver of type names to their OIDs.+    decoder :: (CodecVocab.QualifiedTypeName -> CodecVocab.TypeInfo) -> ResultDecoder.ResultDecoder result,     -- | Whether this statement may be prepared on the server.     isPrepared :: Bool   }@@ -85,12 +84,10 @@       columnsMetadata = Params.toColumnsMetadata encoder,       serializer = Params.toSerializer encoder,       printer = Params.toPrinter encoder,-      unknownTypes = Params.toUnknownTypes encoder <> RequestingOid.toUnknownTypes rawDecoder,-      decoder = rawDecoder,+      unknownTypes = Params.toUnknownTypes encoder <> Decoders.Result.toUnknownTypes resultDecoder,+      decoder = Decoders.Result.toBase resultDecoder,       isPrepared = True     }-  where-    rawDecoder = Decoders.Result.unwrap resultDecoder  -- | -- Construct an unpreparable statement.@@ -113,12 +110,10 @@       columnsMetadata = Params.toColumnsMetadata encoder,       serializer = Params.toSerializer encoder,       printer = Params.toPrinter encoder,-      unknownTypes = Params.toUnknownTypes encoder <> RequestingOid.toUnknownTypes rawDecoder,-      decoder = rawDecoder,+      unknownTypes = Params.toUnknownTypes encoder <> Decoders.Result.toUnknownTypes resultDecoder,+      decoder = Decoders.Result.toBase resultDecoder,       isPrepared = False     }-  where-    rawDecoder = Decoders.Result.unwrap resultDecoder  instance Functor (Statement params) where   {-# INLINE fmap #-}@@ -132,7 +127,7 @@   {-# INLINE dimap #-}   dimap f1 f2 stmt =     stmt-      { serializer = \oidCache -> serializer stmt oidCache . f1,+      { serializer = \resolve -> serializer stmt resolve . f1,         printer = printer stmt . f1,         decoder = fmap (fmap f2) (decoder stmt)       }@@ -153,36 +148,30 @@ -- | Compile prepared-statement data: resolve OIDs and pair encoded values with their format flags. compilePreparedStatementData ::   Statement params result ->-  Vocab.OidCache ->+  (CodecVocab.QualifiedTypeName -> CodecVocab.TypeInfo) ->   params ->   ([Word32], [Maybe (ByteString, Bool)])-compilePreparedStatementData stmt oidCache params =+compilePreparedStatementData stmt resolve params =   unzip     $ zipWith-      (\(ParamMeta typeRef dim fmt) encoding -> (resolveOid typeRef dim, fmap (,fmt) encoding))+      (\(TypeShape typeRef dim fmt) encoding -> (resolveOid resolve 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+      (serializer stmt resolve params)  -- | Compile unprepared-statement data: resolve OIDs inline with encoded values. compileUnpreparedStatementData ::   Statement params result ->-  Vocab.OidCache ->+  (CodecVocab.QualifiedTypeName -> CodecVocab.TypeInfo) ->   params ->   [Maybe (Word32, ByteString, Bool)]-compileUnpreparedStatementData stmt oidCache params =+compileUnpreparedStatementData stmt resolve params =   zipWith-    (\(ParamMeta typeRef dim fmt) encoding -> (,,) <$> Just (resolveOid typeRef dim) <*> encoding <*> Just fmt)+    (\(TypeShape typeRef dim fmt) encoding -> (,,) <$> Just (resolveOid resolve 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+    (serializer stmt resolve params)++-- | Resolve a param's wire OID given the dictionary of resolved type names.+resolveOid :: (CodecVocab.QualifiedTypeName -> CodecVocab.TypeInfo) -> CodecVocab.TypeRef.TypeRef -> Word -> Word32+resolveOid resolve (CodecVocab.TypeRef.NamedType name) dim =+  (if dim == 0 then CodecVocab.TypeInfo.toBaseOid else CodecVocab.TypeInfo.toArrayOid) (resolve name)+resolveOid _ (CodecVocab.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)
+ src/to-be-resolved/Hasql/ToBeResolved.hs view
@@ -0,0 +1,40 @@+module Hasql.ToBeResolved+  ( ToBeResolved (..),+    lookup,+  )+where++import Control.Applicative+import Prelude hiding (lookup)++-- |+-- A computation that first declares the keys it needs resolved and then,+-- once a resolver @k -> v@ is provided, produces its result.+--+-- The defining trait is the upfront collection of keys prior to resolution,+-- hence the name.+data ToBeResolved k v a+  = ToBeResolved+      -- | Keys requested to be available for lookup.+      [k]+      -- | Continuation that looks up values by keys.+      ((k -> v) -> a)++type role ToBeResolved _ _ representational++deriving stock instance Functor (ToBeResolved k v)++instance Applicative (ToBeResolved k v) where+  {-# INLINE pure #-}+  pure a =+    ToBeResolved [] (\_ -> a)+  {-# INLINE (<*>) #-}+  ToBeResolved lKeys lUse <*> ToBeResolved rKeys rUse =+    ToBeResolved+      (lKeys <> rKeys)+      (\lookup -> lUse lookup (rUse lookup))++{-# INLINE lookup #-}+lookup :: k -> ToBeResolved k v v+lookup key =+  ToBeResolved [key] (\lookupFn -> lookupFn key)