packages feed

hasql 1.6.4.4 → 1.10.3.5

raw patch · 153 files changed

Files

CHANGELOG.md view
@@ -1,3 +1,143 @@+# 1.10++Major revision happened.++## New Features++- **OID by name resolution**.++  Encoders and decoders now support resolving PostgreSQL type OIDs by their names at runtime. This enables working with custom types (enums, composite types, domains) without hardcoding OID values. The system includes an OID cache to optimize repeated lookups and automatically queries `pg_type` and related system catalogs when needed. This change affects array, composite, and value encoders/decoders throughout the codec system.++- **Decoder compatibility checks**.++  Previously decoders were silently accepting values of different types, if binary decoding did not fail. Now decoders check if the actual type of the column matches the expected type of the decoder and report `UnexpectedColumnTypeStatementError` error if they do not match. They also match the amount of columns in the result with the amount of columns expected by the decoder and report an error if they do not match.++- **No resets on errors**.++  Previously when an async exception was raised during the execution of a session, the connection would get reestablished to recover from any possible half-finished states. That led to a loss of the connection-local state on the server side. Now the connection recovers without resetting.++- **Redesigned connection configuration API**.++  The connection settings API has been completely redesigned to be more composable and user-friendly. Settings are now represented as a monoid, allowing easy combination of multiple configuration options. The API now supports both URI and key-value connection string formats, with individual setters for common parameters like host, port, user, password, etc.++- **Custom codec API**.++  Added `Hasql.Encoders.custom` and `Hasql.Decoders.custom` functions providing a low-level API for defining custom value encoders and decoders. These functions offer fine-grained control over OID resolution, allowing you to:+  - Specify static OIDs when known at compile time+  - Automatically resolve OIDs at runtime by type name+  - Declare dependencies on other types needed for serialization/deserialization (e.g., field types in composite types)+  - Implement custom binary encoding/decoding logic with access to resolved OIDs++  This is particularly useful for advanced use cases like custom composite types with field validation or specialized binary formats.++## Breaking changes++- Text instead of ByteString for textual data.+  - The public API now uses `Text` instead of `ByteString` for SQL statements and error messages.++- Custom type mappings (enums and composite types) now require specifying names for the types being mapped.+  - This will automatically identify the types with the DB and do deep compatibility checks.++- Decoder checks are now more strict and report `UnexpectedColumnTypeStatementError` when the actual type of a column does not match the expected type of the decoder. Previously such mismatches were silently ignored and could lead to either autocasts or runtime errors in later stages.+  - E.g., `int4` column decoded with `int8` decoder will now report `UnexpectedColumnTypeStatementError` instead of silently accepting the value.++- Session now has exclusive access to the connection for its entire duration. Previously it was releasing and reacquiring the lock on the connection between statements.+  - If you need the old behaviour, you can use `ReaderT Connection (ExceptT SessionError IO)`.++- Dropped `MonadReader Connection` instance for `Session`.++- Dropped `Monad` and `MonadFail` instances for the `Row` decoder. `Applicative` is enough for all practical purposes.++- Errors model completely overhauled.+  - `ConnectionError` restructured and moved from the `Hasql.Connection` module to `Hasql.Errors`.+  - `SessionError` restructured and moved from the `Hasql.Session` module to `Hasql.Errors`.++- `usePreparedStatements` setting dropped. Use `disablePreparedStatements` instead.++- `Hasql.Session.sql` renamed to `Hasql.Session.script` to better reflect its purpose.++- Connection configuration API overhaul to improve UX.+  - `Hasql.Connection.acquire` now takes a single `Settings` value instead of a list of `Setting` values.+  - The `Hasql.Connection.Setting` module has been replaced with `Hasql.Connection.Settings`.+  - Settings are now constructed using flat monoid composition instead of hierarchical lists requiring multiple imports.+  - Removed `Hasql.Connection.Setting.Connection` and related submodules.++- Custom value decoder signature changed.++  The `Hasql.Decoders.custom` function signature has been extended to support more explicit control over type resolution. It now requires:+  - Optional static OIDs parameter (previously implicit)+  - List of additional type dependencies needed for decoding+  - The decoder function now receives an OID lookup function as its first parameter++  This change enables more robust custom type handling but requires updating existing custom decoder implementations.++- Exception instances on error types removed. The error types here were never thrown as exceptions. Wrap them in your own exception type if you need to throw them.++# 1.9++- Revised the settings construction exposing a tree of modules+- Added a global prepared statements setting++## Why the changes?++To introduce the new global prepared statements setting and to make the settings API ready for extension without backward compatibility breakage.++## Instructions on upgrading the 1.8 code++### When explicit connection string is used++Replace++```haskell+Hasql.Connection.acquire connectionString+```++with++```haskell+Hasql.Connection.acquire +  [ Hasql.Connection.Setting.connection (Hasql.Connection.Setting.Connection.string connectionString)+  ]+```++### When parameteric connection string is used++Replace++```haskell+Hasql.Connection.acquire (Hasql.Connection.settings host port user password dbname)+```++with++```haskell+Hasql.Connection.acquire+  [ Hasql.Connection.Setting.connection+    ( Hasql.Connection.Setting.Connection.params+      [ Hasql.Connection.Setting.Connection.Param.host host,+        Hasql.Connection.Setting.Connection.Param.port port,+        Hasql.Connection.Setting.Connection.Param.user user,+        Hasql.Connection.Setting.Connection.Param.password password,+        Hasql.Connection.Setting.Connection.Param.dbname dbname+      ]+    )+  ]+```++# 1.8.1++- In case of exceptions thrown by user from inside of Session, the connection status gets checked to be out of transaction and unless it is the connection gets reset.++# 1.8++- Move to "iproute" from "network-ip" for the "inet" datatype (#163).++# 1.7++- Decidable instance on `Encoders.Params` removed. It was useless and limited the design.+- `QueryError` type renamed to `SessionError`.+- `PipelineError` constructor added to the `SessionError` type.+ # 1.6.3.1  - Moved to "postgresql-libpq-0.10"
README.md view
@@ -1,55 +1,67 @@-# Summary+# Hasql -Hasql is a highly efficient PostgreSQL driver for Haskell with a typesafe yet flexible mapping API. It targets both the users, who need maximum control, and the users who face the typical tasks of DB-powered applications, providing them with higher-level APIs. Currently it is known to be [the fastest driver](https://nikita-volkov.github.io/hasql-benchmarks/) in the Haskell ecosystem.+[![Hackage](https://img.shields.io/hackage/v/hasql.svg)](https://hackage.haskell.org/package/hasql)+[![Continuous Haddock](https://img.shields.io/badge/haddock-master-blue)](https://nikita-volkov.github.io/hasql/) -> [!IMPORTANT]-> Hasql is one of the supported targets of the [pGenie](https://pgenie.io) code generator, which empowers it with schema and query validation, and relieves you from boilerplate.+PostgreSQL driver for Haskell, that prioritizes: -# Status+- Performance+- Typesafety+- Flexibility -[![Hackage](https://img.shields.io/hackage/v/hasql.svg)](https://hackage.haskell.org/package/hasql)+# Status -Hasql is production-ready, actively maintained and the API is pretty stable. It's used by many companies and most notably by the [Postgrest](https://postgrest.org/) project.+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.  # 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. -* ["hasql"](https://github.com/nikita-volkov/hasql) - the root of the ecosystem, which provides the essential abstraction over the PostgreSQL client functionality and mapping of values. Everything else revolves around that library.+- ["hasql"](https://github.com/nikita-volkov/hasql) - the root of the ecosystem, which provides the essential abstraction over the PostgreSQL client functionality and mapping of values. Everything else revolves around that library. -* ["hasql-th"](https://github.com/nikita-volkov/hasql-th) - Template Haskell utilities, providing compile-time syntax checking and easy statement declaration. -* ["hasql-transaction"](https://github.com/nikita-volkov/hasql-transaction) - an STM-inspired composable abstraction over database transactions providing automated conflict resolution.+- ["hasql-transaction"](https://github.com/nikita-volkov/hasql-transaction) - an STM-inspired composable abstraction over database transactions providing automated conflict resolution. -* ["hasql-dynamic-statements"](https://github.com/nikita-volkov/hasql-dynamic-statements) - a toolkit for generating statements based on the parameters.+- ["hasql-pool"](https://github.com/nikita-volkov/hasql-pool) - a Hasql-specialized abstraction over the connection pool. -* ["hasql-cursor-query"](https://github.com/nikita-volkov/hasql-cursor-query) - a declarative abstraction over cursors.+- ["hasql-postgresql-types"](https://github.com/nikita-volkov/hasql-postgresql-types) - integration with the ["postgresql-types"](https://github.com/nikita-volkov/postgresql-types) library, which is a collection of Haskell types precisely modeling PostgreSQL types without data loss or compromise. -* ["hasql-cursor-transaction"](https://github.com/nikita-volkov/hasql-cursor-transaction) - a lower-level abstraction over cursors, which however allows to fetch from multiple cursors simultaneously. Generally though "hasql-cursor-query" is the recommended alternative.+- ["hasql-dynamic-statements"](https://github.com/nikita-volkov/hasql-dynamic-statements) - a toolkit for generating statements based on the parameters. -* ["hasql-pool"](https://github.com/nikita-volkov/hasql-pool) - a Hasql-specialized abstraction over the connection pool.+- ["hasql-th"](https://github.com/nikita-volkov/hasql-th) - Template Haskell utilities, providing compile-time syntax checking and easy statement declaration.  -* ["hasql-migration"](https://github.com/tvh/hasql-migration) - A port of postgresql-simple-migration for use with hasql.+- ["hasql-cursor-query"](https://github.com/nikita-volkov/hasql-cursor-query) - a declarative abstraction over cursors. -* ["hasql-listen-notify"](https://github.com/awkward-squad/hasql-listen-notify) / ["hasql-notifications"](https://github.com/diogob/hasql-notifications) - Support for PostgreSQL asynchronous notifications.+- ["hasql-cursor-transaction"](https://github.com/nikita-volkov/hasql-cursor-transaction) - a lower-level abstraction over cursors, which however allows to fetch from multiple cursors simultaneously. Generally though "hasql-cursor-query" is the recommended alternative. -* ["hasql-optparse-applicative"](https://github.com/sannsyn/hasql-optparse-applicative) - "optparse-applicative" parsers for Hasql.+- ["hasql-migration"](https://github.com/tvh/hasql-migration) - A port of postgresql-simple-migration for use with hasql. -* ["hasql-implicits"](https://github.com/nikita-volkov/hasql-implicits) - implicit definitions, such as default codecs for standard types.+- ["hasql-listen-notify"](https://github.com/awkward-squad/hasql-listen-notify) / ["hasql-notifications"](https://github.com/diogob/hasql-notifications) - Support for PostgreSQL asynchronous notifications. -* ["hasql-interpolate"](https://github.com/awkward-squad/hasql-interpolate) - a QuasiQuoter that supports interpolating Haskell expressions into Hasql queries.+- ["hasql-optparse-applicative"](https://github.com/sannsyn/hasql-optparse-applicative) - "optparse-applicative" parsers for Hasql. -### Benefits of being an ecosystem+- ["hasql-implicits"](https://github.com/nikita-volkov/hasql-implicits) - implicit definitions, such as default codecs for standard types. -* **Simplicity.** Each library in isolation provides a simple API, which is hopefully easier to comprehend.+- ["hasql-interpolate"](https://github.com/awkward-squad/hasql-interpolate) - a QuasiQuoter that supports interpolating Haskell expressions into Hasql queries. -* **Flexibility and composability.** The user picks and chooses the features, thus precisely matching the level of abstraction that he needs for his task.+<sup>Want to list your package or correct something here? Make a PR.</sup> -* **Much more stable and more descriptive semantic versioning.** E.g., a change in the API of the "hasql-transaction" library won't affect any of the other libraries and it gives the user a more precise information about which part of his application he needs to update to conform.+## Why make it an ecosystem? -* **Interchangeability and competition of the ecosystem components.** E.g., [not everyone will agree](https://github.com/nikita-volkov/hasql/issues/41) with the restrictive design decisions made in the "hasql-transaction" library. However those decisions are not imposed on the user, and instead of having endless debates about how to abstract over transactions, another extension library can simply be released, which will provide a different interpretation of what the abstraction over transactions should be.+- **Focus.**+Each library in isolation provides a simple API, which is focused on a specific task or a few related tasks. -* **Horizontal scalability of the ecosystem.** Instead of posting feature- or pull-requests, the users are encouraged to release their own small extension-libraries, with themselves becoming the copyright owners and taking on the maintenance responsibilities. Compare this model to the classical one, where some core-team is responsible for everything. One is scalable, the other is not.+- **Flexibility.**+The user picks and chooses the features, thus precisely matching the level of abstraction that he needs for his task. +- **Much more stable and descriptive semantic versioning.**+E.g., a change in the API of the "hasql-transaction" library won't affect any of the other libraries and it gives the user a more precise information about which part of his application he needs to update to conform.++- **Interchangeability and competition of the ecosystem components.**+E.g., [not everyone will agree](https://github.com/nikita-volkov/hasql/issues/41) with the restrictive design decisions made in the "hasql-transaction" library. However those decisions are not imposed on the user, and instead of having endless debates about how to abstract over transactions, another extension library can simply be released, which will provide a different interpretation of what the abstraction over transactions should be.++- **Horizontal scalability of the ecosystem.**+Instead of posting feature- or pull-requests, the users are encouraged to release their own small extension-libraries, with themselves becoming the copyright owners and taking on the maintenance responsibilities. Compare this model to the classical one, where some core-team is responsible for everything. One is scalable, the other is not.+ # Tutorials  ## Videos@@ -61,7 +73,7 @@  ## Articles -- [Organization of Hasql code in a dedicated library](https://github.com/nikita-volkov/hasql-tutorial1)+- [Organization of Hasql code in a dedicated library <sup>(outdated)</sup>](https://github.com/nikita-volkov/hasql-tutorial1)  # Short Example @@ -69,34 +81,39 @@  ```haskell {-# LANGUAGE OverloadedStrings, QuasiQuotes #-}-import Prelude-import Data.Int+ import Data.Functor.Contravariant+import Data.Int import Hasql.Session (Session)-import Hasql.Statement (Statement(..))-import qualified Hasql.Session as Session+import Prelude+import qualified Hasql.Connection as Connection+import qualified Hasql.Connection.Settings as Settings import qualified Hasql.Decoders as Decoders import qualified Hasql.Encoders as Encoders-import qualified Hasql.Connection as Connection-+import qualified Hasql.Session as Session+import qualified Hasql.Statement as Statement  main :: IO () main = do   Right connection <- Connection.acquire connectionSettings-  result <- Session.run (sumAndDivModSession 3 8 3) connection+  result <- Connection.use connection (sumAndDivModSession 3 8 3)   print result   where-    connectionSettings = Connection.settings "localhost" 5432 "postgres" "" "postgres"-+    connectionSettings =+      mconcat+        [ Settings.hostAndPort "localhost" 5432,+          Settings.user "postgres",+          Settings.password "postgres",+          Settings.dbname "postgres"+          -- Prepared statements are enabled by default.+          -- To disable them (e.g., for pgbouncer compatibility):+          -- Settings.noPreparedStatements True+        ]  -- * Sessions--- --- Session is an abstraction over the database connection and all possible errors.--- It is used to execute statements.++-- Session abstracts over the execution of operations on a database connection. -- It is composable and has a Monad instance.--- --- It's recommended to define sessions in a dedicated 'Sessions'--- submodule of your project. -------------------------  sumAndDivModSession :: Int64 -> Int64 -> Int64 -> Session (Int64, Int64)@@ -106,36 +123,57 @@   -- Divide the sum by c and get the modulo as well   Session.statement (sumOfAAndB, c) divModStatement - -- * Statements--- + -- Statement is a definition of an individual SQL-statement, -- accompanied by a specification of how to encode its parameters and -- decode its result.--- --- It's recommended to define statements in a dedicated 'Statements'--- submodule of your project. ------------------------- -sumStatement :: Statement (Int64, Int64) Int64-sumStatement = Statement sql encoder decoder True where-  sql = "select $1 + $2"-  encoder =-    (fst >$< Encoders.param (Encoders.nonNullable Encoders.int8)) <>-    (snd >$< Encoders.param (Encoders.nonNullable Encoders.int8))-  decoder = Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8))+-- | A statement with two integer parameters and an integer result.+sumStatement :: Statement.Statement (Int64, Int64) Int64+sumStatement = Statement.preparable sql encoder decoder+  where+    -- The SQL of the statement, with $1, $2, ... placeholders for parameters.+    sql =+      "select $1 + $2"+    -- Specification of how to encode the parameters of the statement+    -- where the association with placeholders is achieved by order.+    encoder =+      mconcat+        [ -- Encoder of the first parameter as a non-nullable int8.+          -- It extracts the first element of the tuple using the contravariant functor+          -- instance.+          fst >$< Encoders.param (Encoders.nonNullable Encoders.int8),+          -- Encoder of the second parameter,+          -- which extracts the second element of the tuple.+          snd >$< Encoders.param (Encoders.nonNullable Encoders.int8)+        ]+    -- Specification of how to decode the result of the statement.+    -- States that we expect a single row with a single non-nullable int8 column.+    decoder =+      Decoders.singleRow+        (Decoders.column (Decoders.nonNullable Decoders.int8)) -divModStatement :: Statement (Int64, Int64) (Int64, Int64)-divModStatement = Statement sql encoder decoder True where-  sql = "select $1 / $2, $1 % $2"-  encoder =-    (fst >$< Encoders.param (Encoders.nonNullable Encoders.int8)) <>-    (snd >$< Encoders.param (Encoders.nonNullable Encoders.int8))-  decoder = Decoders.singleRow row where-    row =-      (,) <$>-      Decoders.column (Decoders.nonNullable Decoders.int8) <*>-      Decoders.column (Decoders.nonNullable Decoders.int8)+divModStatement :: Statement.Statement (Int64, Int64) (Int64, Int64)+divModStatement = Statement.preparable sql encoder decoder+  where+    sql =+      "select $1 / $2, $1 % $2"+    encoder =+      mconcat+        [ fst >$< Encoders.param (Encoders.nonNullable Encoders.int8),+          snd >$< Encoders.param (Encoders.nonNullable Encoders.int8)+        ]+    -- Decoder that expects a single row with two non-nullable int8 columns,+    -- returning the result as a tuple.+    -- Uses the applicative functor instance to combine two column decoders.+    decoder =+      Decoders.singleRow+        ( (,)+            <$> Decoders.column (Decoders.nonNullable Decoders.int8)+            <*> Decoders.column (Decoders.nonNullable Decoders.int8)+        ) ```  For the general use-case it is advised to prefer declaring statements using the "hasql-th" library, which validates the statements at compile-time and generates codecs automatically. So the above two statements could be implemented the following way:@@ -143,17 +181,31 @@ ```haskell import qualified Hasql.TH as TH -- from "hasql-th" -sumStatement :: Statement (Int64, Int64) Int64+sumStatement :: Statement.Statement (Int64, Int64) Int64 sumStatement =   [TH.singletonStatement|     select ($1 :: int8 + $2 :: int8) :: int8-    |]+  |] -divModStatement :: Statement (Int64, Int64) (Int64, Int64)+divModStatement :: Statement.Statement (Int64, Int64) (Int64, Int64) divModStatement =   [TH.singletonStatement|     select       (($1 :: int8) / ($2 :: int8)) :: int8,       (($1 :: int8) % ($2 :: int8)) :: int8-    |]+  |] ```++# Discussions++Join [GitHub Discussions](https://github.com/nikita-volkov/hasql/discussions) to ask questions, provide feedback, suggest and vote on features, and help shape the future of Hasql.++# Support Policy++This policy is intended to balance stability for users with the ability to evolve the library.++Each major release of Hasql is supported for at least **one year** from the date of its first release. During this period, fixes are backported to the latest minor version of that major release.++After the support period ends, the release may continue to work but is no longer guaranteed to receive fixes.++You're welcome to post requests to change the policy or issues if you believe something is not being addressed.
− benchmarks/Main.hs 
@@ -1,96 +0,0 @@-module Main where--import Criterion-import Criterion.Main-import Hasql.Connection qualified as A-import Hasql.Decoders qualified as D-import Hasql.Session qualified as B-import Hasql.Statement qualified as C-import Prelude--main :: IO ()-main =-  do-    Right connection <- acquireConnection-    useConnection connection-  where-    acquireConnection =-      A.acquire ""-    useConnection connection =-      defaultMain-        [ sessionBench "largeResultInVector" sessionWithSingleLargeResultInVector,-          sessionBench "largeResultInList" sessionWithSingleLargeResultInList,-          sessionBench "manyLargeResults" sessionWithManyLargeResults,-          sessionBench "manySmallResults" sessionWithManySmallResults-        ]-      where-        sessionBench :: (NFData a) => String -> B.Session a -> Benchmark-        sessionBench name session =-          bench name (nfIO (fmap (either (error "") id) (B.run session connection)))---- * Sessions--sessionWithManySmallParameters :: Vector (Int64, Int64) -> B.Session ()-sessionWithManySmallParameters =-  error "TODO: sessionWithManySmallParameters"--sessionWithSingleLargeResultInVector :: B.Session (Vector (Int64, Int64))-sessionWithSingleLargeResultInVector =-  B.statement () statementWithManyRowsInVector--sessionWithManyLargeResults :: B.Session [Vector (Int64, Int64)]-sessionWithManyLargeResults =-  replicateM 1000 (B.statement () statementWithManyRowsInVector)--sessionWithSingleLargeResultInList :: B.Session [(Int64, Int64)]-sessionWithSingleLargeResultInList =-  B.statement () statementWithManyRowsInList--sessionWithManySmallResults :: B.Session [(Int64, Int64)]-sessionWithManySmallResults =-  replicateM 1000 (B.statement () statementWithSingleRow)---- * Statements--statementWithManyParameters :: C.Statement (Vector (Int64, Int64)) ()-statementWithManyParameters =-  error "TODO: statementWithManyParameters"--statementWithSingleRow :: C.Statement () (Int64, Int64)-statementWithSingleRow =-  C.Statement template encoder decoder True-  where-    template =-      "SELECT 1, 2"-    encoder =-      conquer-    decoder =-      D.singleRow row-      where-        row =-          tuple <$> (D.column . D.nonNullable) D.int8 <*> (D.column . D.nonNullable) D.int8-          where-            tuple !a !b =-              (a, b)--statementWithManyRows :: (D.Row (Int64, Int64) -> D.Result result) -> C.Statement () result-statementWithManyRows decoder =-  C.Statement template encoder (decoder rowDecoder) True-  where-    template =-      "SELECT generate_series(0,1000) as a, generate_series(1000,2000) as b"-    encoder =-      conquer-    rowDecoder =-      tuple <$> (D.column . D.nonNullable) D.int8 <*> (D.column . D.nonNullable) D.int8-      where-        tuple !a !b =-          (a, b)--statementWithManyRowsInVector :: C.Statement () (Vector (Int64, Int64))-statementWithManyRowsInVector =-  statementWithManyRows D.rowVector--statementWithManyRowsInList :: C.Statement () [(Int64, Int64)]-statementWithManyRowsInList =-  statementWithManyRows D.rowList
hasql.cabal view
@@ -1,14 +1,24 @@ cabal-version: 3.0 name: hasql-version: 1.6.4.4+version: 1.10.3.5 category: Hasql, Database, PostgreSQL-synopsis: An efficient PostgreSQL driver with a flexible mapping API+synopsis: Fast PostgreSQL driver with a flexible mapping API description:   Root of the \"hasql\" ecosystem.-  For 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.+  This library provides connection management, execution of queries and mapping of parameters and results.+  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.++  \"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.++  Despite the mentioned requirements for \"libpq\" \"hasql\" is thoroughly tested to be compatible+  with a wide range of PostgreSQL servers starting from version 9.+ homepage: https://github.com/nikita-volkov/hasql bug-reports: https://github.com/nikita-volkov/hasql/issues author: Nikita Volkov <nikita.y.volkov@mail.ru>@@ -17,26 +27,32 @@ license: MIT license-file: LICENSE extra-source-files:-  CHANGELOG.md   README.md +extra-doc-files:+  CHANGELOG.md+ source-repository head   type: git-  location: git://github.com/nikita-volkov/hasql.git+  location: https://github.com/nikita-volkov/hasql  common base   default-language: Haskell2010   default-extensions:+    ApplicativeDo     Arrows     BangPatterns+    BlockArguments     ConstraintKinds     DataKinds     DefaultSignatures-    DeriveDataTypeable+    DeriveAnyClass     DeriveFoldable     DeriveFunctor     DeriveGeneric     DeriveTraversable+    DerivingVia+    DuplicateRecordFields     EmptyDataDecls     FlexibleContexts     FlexibleInstances@@ -46,13 +62,13 @@     ImportQualifiedPost     LambdaCase     LiberalTypeSynonyms-    MagicHash     MultiParamTypeClasses     MultiWayIf+    NamedFieldPuns     NoImplicitPrelude     NoMonomorphismRestriction+    NumericUnderscores     OverloadedStrings-    ParallelListComp     PatternGuards     QuasiQuotes     RankNTypes@@ -60,11 +76,12 @@     RoleAnnotations     ScopedTypeVariables     StandaloneDeriving-    TemplateHaskell+    StrictData     TupleSections+    TypeApplications     TypeFamilies     TypeOperators-    UnboxedTuples+    ViewPatterns  common executable   import: base@@ -83,120 +100,285 @@  library   import: base-  hs-source-dirs: library+  hs-source-dirs: src/library   exposed-modules:     Hasql.Connection+    Hasql.Connection.Settings     Hasql.Decoders     Hasql.Encoders+    Hasql.Errors+    Hasql.Pipeline     Hasql.Session     Hasql.Statement    other-modules:-    Hasql.Commands-    Hasql.Connection.Core-    Hasql.Decoders.All-    Hasql.Decoders.Array-    Hasql.Decoders.Composite-    Hasql.Decoders.Result-    Hasql.Decoders.Results-    Hasql.Decoders.Row-    Hasql.Decoders.Value-    Hasql.Encoders.All-    Hasql.Encoders.Array-    Hasql.Encoders.Params-    Hasql.Encoders.Value-    Hasql.Errors-    Hasql.IO-    Hasql.PostgresTypeInfo-    Hasql.Prelude-    Hasql.PreparedStatementRegistry-    Hasql.Session.Core-    Hasql.Settings+    Hasql.Codecs.Decoders+    Hasql.Codecs.Decoders.Array+    Hasql.Codecs.Decoders.Composite+    Hasql.Codecs.Decoders.NullableOrNot+    Hasql.Codecs.Decoders.Value+    Hasql.Codecs.Encoders+    Hasql.Codecs.Encoders.Array+    Hasql.Codecs.Encoders.Composite+    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+    Hasql.Engine.Contexts.Session+    Hasql.Engine.Decoders.Result+    Hasql.Engine.Decoders.Row+    Hasql.Engine.Errors+    Hasql.Engine.PqProcedures.SelectTypeInfo+    Hasql.Engine.Statement+    Hasql.Engine.Structures.ConnectionState+    Hasql.Engine.Structures.StatementCache+    Hasql.Platform.Prelude+    Hasql.Platform.Prelude.Text+    Hasql.Pq+    Hasql.Pq.Ffi+    Hasql.Pq.Mappings    build-depends:     aeson >=2 && <3,     attoparsec >=0.10 && <0.15,     base >=4.14 && <5,     bytestring >=0.10 && <0.13,-    bytestring-strict-builder >=0.4.5.1 && <0.5,+    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,-    hashtables >=1.1 && <2,+    iproute >=1.7 && <1.8,     mtl >=2 && <3,-    network-ip >=0.3.0.3 && <0.4,-    postgresql-binary >=0.13.1 && <0.14,-    postgresql-libpq >=0.9 && <0.11,+    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,-    text-builder >=0.6.7 && <0.7,+    text-builder >=1 && <1.1,     time >=1.9 && <2,-    transformers >=0.3 && <0.7,+    transformers >=0.5 && <0.7,+    unordered-containers >=0.2 && <0.3,     uuid >=1.3 && <2,     vector >=0.10 && <0.14,--library testing-utils-  import: base-  hs-source-dirs: testing-utils-  exposed-modules:-    Hasql.TestingUtils.Constants-    Hasql.TestingUtils.TestingDsl+    witherable >=0.5 && <0.6, +benchmark benchmarks+  import: executable+  type: exitcode-stdio-1.0+  hs-source-dirs: src/benchmarks+  main-is: Main.hs   build-depends:+    criterion >=1.6 && <2,     hasql,     rerebase <2, -test-suite tasty+test-suite profiling   import: base   type: exitcode-stdio-1.0-  hs-source-dirs: tasty+  hs-source-dirs: src/profiling   main-is: Main.hs-  other-modules:-    Main.Connection-    Main.Prelude-    Main.Statements+  ghc-options:+    -O2+    -threaded+    -rtsopts    build-depends:-    contravariant-extras >=0.3.5.2 && <0.4,     hasql,-    hasql:testing-utils,-    quickcheck-instances >=0.3.11 && <0.4,-    rerebase <2,-    tasty >=0.12 && <2,-    tasty-hunit >=0.9 && <0.11,-    tasty-quickcheck >=0.9 && <0.11,+    rerebase >=1 && <2,+    testcontainers-postgresql ^>=0.2, -test-suite threads-test+test-suite comms-tests   import: test   type: exitcode-stdio-1.0-  hs-source-dirs: threads-test+  hs-source-dirs:+    src/comms-tests+    src/library+   main-is: Main.hs-  other-modules: Main.Statements+  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:-    hasql,-    rerebase,+    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,+    hspec ^>=2.11.12,+    mtl >=2 && <3,+    postgresql-libpq >=0.10.1 && <0.12,+    profunctors >=5.1 && <6,+    scientific >=0.3 && <0.4,+    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, -benchmark benchmarks-  import: executable+test-suite engine-tests+  import: test   type: exitcode-stdio-1.0-  hs-source-dirs: benchmarks+  hs-source-dirs:+    src/engine-tests+    src/library+   main-is: Main.hs+  other-modules:+    Hasql.Codecs.Vocab+    Hasql.Codecs.Vocab.OidCache+    Hasql.Codecs.Vocab.ParamMeta+    Hasql.Codecs.Vocab.QualifiedTypeName+    Hasql.Codecs.Vocab.TypeInfo+    Hasql.Codecs.Vocab.TypeRef+    Hasql.Engine.Structures.OidCacheSpec+    Hasql.Engine.Structures.StatementCache+    Hasql.Engine.Structures.StatementCacheSpec+    Hasql.Platform.Prelude+    Hasql.Platform.Prelude.Text+    Hasql.Pq+    Hasql.Pq.Ffi+    Hasql.Pq.Mappings++  build-tool-depends:+    hspec-discover:hspec-discover ^>=2.11.12+   build-depends:-    criterion >=1.6 && <2,-    hasql,-    rerebase <2,+    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,+    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 profiling-  import: base+test-suite library-tests+  import: test   type: exitcode-stdio-1.0-  hs-source-dirs: profiling+  hs-source-dirs: src/library-tests   main-is: Main.hs-  ghc-options:-    -O2-    -threaded-    -rtsopts+  other-modules:+    Helpers.Dsls.Execution+    Helpers.Dsls.Statement+    Helpers.Scripts+    Helpers.Statements+    Helpers.Statements.BrokenSyntax+    Helpers.Statements.CountPreparedStatements+    Helpers.Statements.CurrentSetting+    Helpers.Statements.GenerateSeries+    Helpers.Statements.SelectOne+    Helpers.Statements.SelectProvidedInt8+    Helpers.Statements.SetConfig+    Helpers.Statements.Sleep+    Helpers.Statements.WrongDecoder+    Isolated.ByUnit.Connection.AcquireSpec+    Pure.ByUnit.ErrorsSpec+    Sharing.ByBug.ExceptionConnectionResetRaceSpec+    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 +  build-tool-depends:+    hspec-discover:hspec-discover ^>=2.11.12+   build-depends:+    aeson,     hasql,+    hspec ^>=2.11.12,+    iproute,+    QuickCheck,+    quickcheck-instances >=0.3.11 && <0.4,+    random >=1.3 && <1.4,+    random ^>=1.3.1,     rerebase >=1 && <2,+    testcontainers-postgresql ^>=0.2,+    text-builder >=1 && <1.1,
− library/Hasql/Commands.hs 
@@ -1,27 +0,0 @@-module Hasql.Commands-  ( Commands,-    asBytes,-    setEncodersToUTF8,-    setMinClientMessagesToWarning,-  )-where--import Data.ByteString.Builder qualified as BB-import Data.ByteString.Lazy qualified as BL-import Hasql.Prelude--newtype Commands-  = Commands (DList BB.Builder)-  deriving (Semigroup, Monoid)--asBytes :: Commands -> ByteString-asBytes (Commands list) =-  BL.toStrict $ BB.toLazyByteString $ foldMap (<> BB.char7 ';') $ list--setEncodersToUTF8 :: Commands-setEncodersToUTF8 =-  Commands (pure "SET client_encoding = 'UTF8'")--setMinClientMessagesToWarning :: Commands-setMinClientMessagesToWarning =-  Commands (pure "SET client_min_messages TO WARNING")
− library/Hasql/Connection.hs 
@@ -1,15 +0,0 @@--- |--- This module provides a low-level effectful API dealing with the connections to the database.-module Hasql.Connection-  ( Connection,-    ConnectionError,-    acquire,-    release,-    Settings,-    settings,-    withLibPQConnection,-  )-where--import Hasql.Connection.Core-import Hasql.Settings
− library/Hasql/Connection/Core.hs 
@@ -1,50 +0,0 @@--- |--- This module provides a low-level effectful API dealing with the connections to the database.-module Hasql.Connection.Core where--import Database.PostgreSQL.LibPQ qualified as LibPQ-import Hasql.IO qualified as IO-import Hasql.Prelude-import Hasql.PreparedStatementRegistry qualified as PreparedStatementRegistry-import Hasql.Settings qualified as Settings---- |--- A single connection to the database.-data Connection-  = Connection !(MVar LibPQ.Connection) !Bool !PreparedStatementRegistry.PreparedStatementRegistry---- |--- Possible details of the connection acquistion error.-type ConnectionError =-  Maybe ByteString---- |--- Acquire a connection using the provided settings encoded according to the PostgreSQL format.-acquire :: Settings.Settings -> IO (Either ConnectionError Connection)-acquire settings =-  {-# SCC "acquire" #-}-  runExceptT $ do-    pqConnection <- lift (IO.acquireConnection settings)-    lift (IO.checkConnectionStatus pqConnection) >>= traverse throwError-    lift (IO.initConnection pqConnection)-    integerDatetimes <- lift (IO.getIntegerDatetimes pqConnection)-    registry <- lift (IO.acquirePreparedStatementRegistry)-    pqConnectionRef <- lift (newMVar pqConnection)-    pure (Connection pqConnectionRef integerDatetimes registry)---- |--- Release the connection.-release :: Connection -> IO ()-release (Connection pqConnectionRef _ _) =-  mask_ $ do-    nullConnection <- LibPQ.newNullConnection-    pqConnection <- swapMVar pqConnectionRef nullConnection-    IO.releaseConnection pqConnection---- |--- Execute an operation on the raw @libpq@ 'LibPQ.Connection'.------ The access to the connection is exclusive.-withLibPQConnection :: Connection -> (LibPQ.Connection -> IO a) -> IO a-withLibPQConnection (Connection pqConnectionRef _ _) =-  withMVar pqConnectionRef
− library/Hasql/Decoders.hs 
@@ -1,72 +0,0 @@--- |--- A DSL for declaration of result decoders.-module Hasql.Decoders-  ( -- * Result-    Result,-    noResult,-    rowsAffected,-    singleRow,--    -- ** Specialized multi-row results-    rowMaybe,-    rowVector,-    rowList,--    -- ** Multi-row traversers-    foldlRows,-    foldrRows,--    -- * Row-    Row,-    column,--    -- * Nullability-    NullableOrNot,-    nonNullable,-    nullable,--    -- * Value-    Value,-    bool,-    int2,-    int4,-    int8,-    float4,-    float8,-    numeric,-    char,-    text,-    bytea,-    date,-    timestamp,-    timestamptz,-    time,-    timetz,-    interval,-    uuid,-    inet,-    json,-    jsonBytes,-    jsonb,-    jsonbBytes,-    array,-    listArray,-    vectorArray,-    composite,-    hstore,-    enum,-    custom,-    refine,--    -- * Array-    Array,-    dimension,-    element,--    -- * Composite-    Composite,-    field,-  )-where--import Hasql.Decoders.All
− library/Hasql/Decoders/All.hs 
@@ -1,407 +0,0 @@--- |--- A DSL for declaration of result decoders.-module Hasql.Decoders.All where--import Data.Aeson qualified as Aeson-import Data.Vector.Generic qualified as GenericVector-import Hasql.Decoders.Array qualified as Array-import Hasql.Decoders.Composite qualified as Composite-import Hasql.Decoders.Result qualified as Result-import Hasql.Decoders.Results qualified as Results-import Hasql.Decoders.Row qualified as Row-import Hasql.Decoders.Value qualified as Value-import Hasql.Prelude hiding (bool, maybe)-import Hasql.Prelude qualified as Prelude-import Network.IP.Addr qualified as NetworkIp-import PostgreSQL.Binary.Decoding qualified as A---- * Result---- |--- Decoder of a query result.-newtype Result a = Result (Results.Results a) deriving (Functor)---- |--- Decode no value from the result.------ Useful for statements like @INSERT@ or @CREATE@.-{-# INLINEABLE noResult #-}-noResult :: Result ()-noResult = Result (Results.single Result.noResult)---- |--- Get the amount of rows affected by such statements as--- @UPDATE@ or @DELETE@.-{-# INLINEABLE rowsAffected #-}-rowsAffected :: Result Int64-rowsAffected = Result (Results.single Result.rowsAffected)---- |--- Exactly one row.--- Will raise the 'Errors.UnexpectedAmountOfRows' error if it's any other.-{-# INLINEABLE singleRow #-}-singleRow :: Row a -> Result a-singleRow (Row row) = Result (Results.single (Result.single row))--refineResult :: (a -> Either Text b) -> Result a -> Result b-refineResult refiner (Result results) = Result (Results.refine refiner results)---- ** Multi-row traversers---- |--- Foldl multiple rows.-{-# INLINEABLE foldlRows #-}-foldlRows :: (a -> b -> a) -> a -> Row b -> Result a-foldlRows step init (Row row) = Result (Results.single (Result.foldl step init row))---- |--- Foldr multiple rows.-{-# INLINEABLE foldrRows #-}-foldrRows :: (b -> a -> a) -> a -> Row b -> Result a-foldrRows step init (Row row) = Result (Results.single (Result.foldr step init row))---- ** Specialized multi-row results---- |--- Maybe one row or none.-{-# INLINEABLE rowMaybe #-}-rowMaybe :: Row a -> Result (Maybe a)-rowMaybe (Row row) = Result (Results.single (Result.maybe row))---- |--- Zero or more rows packed into the vector.------ It's recommended to prefer this function to 'rowList',--- since it performs notably better.-{-# INLINEABLE rowVector #-}-rowVector :: Row a -> Result (Vector a)-rowVector (Row row) = Result (Results.single (Result.vector row))---- |--- Zero or more rows packed into the list.-{-# INLINEABLE rowList #-}-rowList :: Row a -> Result [a]-rowList = foldrRows strictCons []---- * Row---- |--- Decoder of an individual row,--- which gets composed of column value decoders.------ E.g.:------ @--- x :: 'Row' (Maybe Int64, Text, TimeOfDay)--- x = (,,) '<$>' ('column' . 'nullable') 'int8' '<*>' ('column' . 'nonNullable') 'text' '<*>' ('column' . 'nonNullable') 'time'--- @-newtype Row a = Row (Row.Row a)-  deriving (Functor, Applicative, Monad, MonadFail)---- |--- Lift an individual value decoder to a composable row decoder.-{-# INLINEABLE column #-}-column :: NullableOrNot Value a -> Row a-column = \case-  NonNullable (Value imp) -> Row (Row.nonNullValue imp)-  Nullable (Value imp) -> Row (Row.value imp)---- * Nullability---- |--- Extensional specification of nullability over a generic decoder.-data NullableOrNot decoder a where-  NonNullable :: decoder a -> NullableOrNot decoder a-  Nullable :: decoder a -> NullableOrNot decoder (Maybe a)---- |--- Specify that a decoder produces a non-nullable value.-nonNullable :: decoder a -> NullableOrNot decoder a-nonNullable = NonNullable---- |--- Specify that a decoder produces a nullable value.-nullable :: decoder a -> NullableOrNot decoder (Maybe a)-nullable = Nullable---- * Value---- |--- Decoder of a value.-newtype Value a = Value (Value.Value a)-  deriving (Functor)--type role Value representational---- |--- Decoder of the @BOOL@ values.-{-# INLINEABLE bool #-}-bool :: Value Bool-bool = Value (Value.decoder (const A.bool))---- |--- Decoder of the @INT2@ values.-{-# INLINEABLE int2 #-}-int2 :: Value Int16-int2 = Value (Value.decoder (const A.int))---- |--- Decoder of the @INT4@ values.-{-# INLINEABLE int4 #-}-int4 :: Value Int32-int4 = Value (Value.decoder (const A.int))---- |--- Decoder of the @INT8@ values.-{-# INLINEABLE int8 #-}-int8 :: Value Int64-int8 =-  {-# SCC "int8" #-}-  Value (Value.decoder (const ({-# SCC "int8.int" #-} A.int)))---- |--- Decoder of the @FLOAT4@ values.-{-# INLINEABLE float4 #-}-float4 :: Value Float-float4 = Value (Value.decoder (const A.float4))---- |--- Decoder of the @FLOAT8@ values.-{-# INLINEABLE float8 #-}-float8 :: Value Double-float8 = Value (Value.decoder (const A.float8))---- |--- Decoder of the @NUMERIC@ values.-{-# INLINEABLE numeric #-}-numeric :: Value Scientific-numeric = Value (Value.decoder (const A.numeric))---- |--- Decoder of the @CHAR@ values.--- Note that it supports Unicode values.-{-# INLINEABLE char #-}-char :: Value Char-char = Value (Value.decoder (const A.char))---- |--- Decoder of the @TEXT@ values.-{-# INLINEABLE text #-}-text :: Value Text-text = Value (Value.decoder (const A.text_strict))---- |--- Decoder of the @BYTEA@ values.-{-# INLINEABLE bytea #-}-bytea :: Value ByteString-bytea = Value (Value.decoder (const A.bytea_strict))---- |--- Decoder of the @DATE@ values.-{-# INLINEABLE date #-}-date :: Value Day-date = Value (Value.decoder (const A.date))---- |--- Decoder of the @TIMESTAMP@ values.-{-# INLINEABLE timestamp #-}-timestamp :: Value LocalTime-timestamp = Value (Value.decoder (Prelude.bool A.timestamp_float A.timestamp_int))---- |--- Decoder of the @TIMESTAMPTZ@ values.------ /NOTICE/------ Postgres does not store the timezone information of @TIMESTAMPTZ@.--- Instead it stores a UTC value and performs silent conversions--- to the currently set timezone, when dealt with in the text format.--- However this library bypasses the silent conversions--- and communicates with Postgres using the UTC values directly.-{-# INLINEABLE timestamptz #-}-timestamptz :: Value UTCTime-timestamptz = Value (Value.decoder (Prelude.bool A.timestamptz_float A.timestamptz_int))---- |--- Decoder of the @TIME@ values.-{-# INLINEABLE time #-}-time :: Value TimeOfDay-time = Value (Value.decoder (Prelude.bool A.time_float A.time_int))---- |--- Decoder of the @TIMETZ@ values.------ Unlike in case of @TIMESTAMPTZ@,--- Postgres does store the timezone information for @TIMETZ@.--- However the Haskell's \"time\" library does not contain any composite type,--- that fits the task, so we use a pair of 'TimeOfDay' and 'TimeZone'--- to represent a value on the Haskell's side.-{-# INLINEABLE timetz #-}-timetz :: Value (TimeOfDay, TimeZone)-timetz = Value (Value.decoder (Prelude.bool A.timetz_float A.timetz_int))---- |--- Decoder of the @INTERVAL@ values.-{-# INLINEABLE interval #-}-interval :: Value DiffTime-interval = Value (Value.decoder (Prelude.bool A.interval_float A.interval_int))---- |--- Decoder of the @UUID@ values.-{-# INLINEABLE uuid #-}-uuid :: Value UUID-uuid = Value (Value.decoder (const A.uuid))---- |--- Decoder of the @INET@ values.-{-# INLINEABLE inet #-}-inet :: Value (NetworkIp.NetAddr NetworkIp.IP)-inet = Value (Value.decoder (const A.inet))---- |--- Decoder of the @JSON@ values into a JSON AST.-{-# INLINEABLE json #-}-json :: Value Aeson.Value-json = Value (Value.decoder (const A.json_ast))---- |--- Decoder of the @JSON@ values into a raw JSON 'ByteString'.-{-# INLINEABLE jsonBytes #-}-jsonBytes :: (ByteString -> Either Text a) -> Value a-jsonBytes fn = Value (Value.decoder (const (A.json_bytes fn)))---- |--- Decoder of the @JSONB@ values into a JSON AST.-{-# INLINEABLE jsonb #-}-jsonb :: Value Aeson.Value-jsonb = Value (Value.decoder (const A.jsonb_ast))---- |--- Decoder of the @JSONB@ values into a raw JSON 'ByteString'.-{-# INLINEABLE jsonbBytes #-}-jsonbBytes :: (ByteString -> Either Text a) -> Value a-jsonbBytes fn = Value (Value.decoder (const (A.jsonb_bytes fn)))---- |--- Lift a custom value decoder function to a 'Value' decoder.-{-# INLINEABLE custom #-}-custom :: (Bool -> ByteString -> Either Text a) -> Value a-custom fn = Value (Value.decoderFn fn)---- |--- Refine a value decoder, lifting the possible error to the session level.-{-# INLINEABLE refine #-}-refine :: (a -> Either Text b) -> Value a -> Value b-refine fn (Value v) = Value (Value.Value (\b -> A.refine fn (Value.run v b)))---- |--- A generic decoder of @HSTORE@ values.------ Here's how you can use it to construct a specific value:------ @--- x :: Value [(Text, Maybe Text)]--- x = hstore 'replicateM'--- @-{-# INLINEABLE hstore #-}-hstore :: (forall m. (Monad m) => Int -> m (Text, Maybe Text) -> m a) -> Value a-hstore replicateM = Value (Value.decoder (const (A.hstore replicateM A.text_strict A.text_strict)))---- |--- Given a partial mapping from text to value,--- produces a decoder of that value.-enum :: (Text -> Maybe a) -> Value a-enum mapping = Value (Value.decoder (const (A.enum mapping)))---- |--- Lift an 'Array' decoder to a 'Value' decoder.-{-# INLINEABLE array #-}-array :: Array a -> Value a-array (Array imp) = Value (Value.decoder (Array.run imp))---- |--- Lift a value decoder of element into a unidimensional array decoder producing a list.------ This function is merely a shortcut to the following expression:------ @--- ('array' . 'dimension' Control.Monad.'replicateM' . 'element')--- @------ Please notice that in case of multidimensional arrays nesting 'listArray' decoder--- won't work. You have to explicitly construct the array decoder using 'array'.-{-# INLINE listArray #-}-listArray :: NullableOrNot Value element -> Value [element]-listArray = array . dimension replicateM . element---- |--- Lift a value decoder of element into a unidimensional array decoder producing a generic vector.------ This function is merely a shortcut to the following expression:------ @--- ('array' . 'dimension' Data.Vector.Generic.'GenericVector.replicateM' . 'element')--- @------ Please notice that in case of multidimensional arrays nesting 'vectorArray' decoder--- won't work. You have to explicitly construct the array decoder using 'array'.-{-# INLINE vectorArray #-}-vectorArray :: (GenericVector.Vector vector element) => NullableOrNot Value element -> Value (vector element)-vectorArray = array . dimension GenericVector.replicateM . element---- |--- Lift a 'Composite' decoder to a 'Value' decoder.-{-# INLINEABLE composite #-}-composite :: Composite a -> Value a-composite (Composite imp) = Value (Value.decoder (Composite.run imp))---- * Array decoders---- |--- A generic array decoder.------ Here's how you can use it to produce a specific array value decoder:------ @--- x :: 'Value' [[Text]]--- x = 'array' ('dimension' 'replicateM' ('dimension' 'replicateM' ('element' ('nonNullable' 'text'))))--- @-newtype Array a = Array (Array.Array a)-  deriving (Functor)---- |--- A function for parsing a dimension of an array.--- Provides support for multi-dimensional arrays.------ Accepts:------ * An implementation of the @replicateM@ function--- (@Control.Monad.'Control.Monad.replicateM'@, @Data.Vector.'Data.Vector.replicateM'@),--- which determines the output value.------ * A decoder of its components, which can be either another 'dimension' or 'element'.-{-# INLINEABLE dimension #-}-dimension :: (forall m. (Monad m) => Int -> m a -> m b) -> Array a -> Array b-dimension replicateM (Array imp) = Array (Array.dimension replicateM imp)---- |--- Lift a 'Value' decoder into an 'Array' decoder for parsing of leaf values.-{-# INLINEABLE element #-}-element :: NullableOrNot Value a -> Array a-element = \case-  NonNullable (Value imp) -> Array (Array.nonNullValue (Value.run imp))-  Nullable (Value imp) -> Array (Array.value (Value.run imp))---- * Composite decoders---- |--- Composable decoder of composite values (rows, records).-newtype Composite a = Composite (Composite.Composite a)-  deriving (Functor, Applicative, Monad, MonadFail)---- |--- Lift a 'Value' decoder into a 'Composite' decoder for parsing of component values.-field :: NullableOrNot Value a -> Composite a-field = \case-  NonNullable (Value imp) -> Composite (Composite.nonNullValue (Value.run imp))-  Nullable (Value imp) -> Composite (Composite.value (Value.run imp))
− library/Hasql/Decoders/Array.hs 
@@ -1,28 +0,0 @@-module Hasql.Decoders.Array where--import Hasql.Prelude-import PostgreSQL.Binary.Decoding qualified as A--newtype Array a-  = Array (ReaderT Bool A.Array a)-  deriving (Functor)--{-# INLINE run #-}-run :: Array a -> Bool -> A.Value a-run (Array imp) env =-  A.array (runReaderT imp env)--{-# INLINE dimension #-}-dimension :: (forall m. (Monad m) => Int -> m a -> m b) -> Array a -> Array b-dimension replicateM (Array imp) =-  Array $ ReaderT $ \env -> A.dimensionArray replicateM (runReaderT imp env)--{-# INLINE value #-}-value :: (Bool -> A.Value a) -> Array (Maybe a)-value decoder' =-  Array $ ReaderT $ A.nullableValueArray . decoder'--{-# INLINE nonNullValue #-}-nonNullValue :: (Bool -> A.Value a) -> Array a-nonNullValue decoder' =-  Array $ ReaderT $ A.valueArray . decoder'
− library/Hasql/Decoders/Composite.hs 
@@ -1,23 +0,0 @@-module Hasql.Decoders.Composite where--import Hasql.Prelude-import PostgreSQL.Binary.Decoding qualified as A--newtype Composite a-  = Composite (ReaderT Bool A.Composite a)-  deriving (Functor, Applicative, Monad, MonadFail)--{-# INLINE run #-}-run :: Composite a -> Bool -> A.Value a-run (Composite imp) env =-  A.composite (runReaderT imp env)--{-# INLINE value #-}-value :: (Bool -> A.Value a) -> Composite (Maybe a)-value decoder' =-  Composite $ ReaderT $ A.nullableValueComposite . decoder'--{-# INLINE nonNullValue #-}-nonNullValue :: (Bool -> A.Value a) -> Composite a-nonNullValue decoder' =-  Composite $ ReaderT $ A.valueComposite . decoder'
− library/Hasql/Decoders/Result.hs 
@@ -1,228 +0,0 @@-module Hasql.Decoders.Result 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 Database.PostgreSQL.LibPQ qualified as LibPQ-import Hasql.Decoders.Row qualified as Row-import Hasql.Errors-import Hasql.Prelude hiding (many, maybe)-import Hasql.Prelude qualified as Prelude--newtype Result a-  = Result (ReaderT (Bool, LibPQ.Result) (ExceptT ResultError IO) a)-  deriving (Functor, Applicative, Monad)--{-# INLINE run #-}-run :: Result a -> (Bool, LibPQ.Result) -> IO (Either ResultError a)-run (Result reader) env =-  runExceptT (runReaderT reader env)--{-# INLINE noResult #-}-noResult :: Result ()-noResult =-  checkExecStatus $ \case-    LibPQ.CommandOk -> True-    LibPQ.TuplesOk -> True-    _ -> False--{-# INLINE rowsAffected #-}-rowsAffected :: Result Int64-rowsAffected =-  do-    checkExecStatus $ \case-      LibPQ.CommandOk -> True-      _ -> False-    Result-      $ ReaderT-      $ \(_, result) ->-        ExceptT-          $ LibPQ.cmdTuples result-          & fmap cmdTuplesReader-  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 =-          mapLeft (\m -> UnexpectedResult ("Decimal parsing failure: " <> fromString m))-            $ Attoparsec.parseOnly (Attoparsec.decimal <* Attoparsec.endOfInput) bytes--{-# INLINE checkExecStatus #-}-checkExecStatus :: (LibPQ.ExecStatus -> Bool) -> Result ()-checkExecStatus predicate =-  {-# SCC "checkExecStatus" #-}-  do-    status <- Result $ ReaderT $ \(_, result) -> lift $ LibPQ.resultStatus result-    unless (predicate status) $ do-      case status of-        LibPQ.BadResponse -> serverError-        LibPQ.NonfatalError -> serverError-        LibPQ.FatalError -> serverError-        LibPQ.EmptyQuery -> return ()-        _ -> Result $ lift $ ExceptT $ pure $ Left $ UnexpectedResult $ "Unexpected result status: " <> (fromString $ show status)--{-# INLINE serverError #-}-serverError :: Result ()-serverError =-  Result-    $ ReaderT-    $ \(_, result) -> ExceptT $ do-      code <--        fmap fold-          $ LibPQ.resultErrorField result LibPQ.DiagSqlstate-      message <--        fmap fold-          $ LibPQ.resultErrorField result LibPQ.DiagMessagePrimary-      detail <--        LibPQ.resultErrorField result LibPQ.DiagMessageDetail-      hint <--        LibPQ.resultErrorField result LibPQ.DiagMessageHint-      position <--        parsePosition <$> LibPQ.resultErrorField result LibPQ.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--{-# INLINE maybe #-}-maybe :: Row.Row a -> Result (Maybe a)-maybe rowDec =-  do-    checkExecStatus $ \case-      LibPQ.TuplesOk -> True-      _ -> False-    Result-      $ ReaderT-      $ \(integerDatetimes, result) -> ExceptT $ do-        maxRows <- LibPQ.ntuples result-        case maxRows of-          0 -> return (Right Nothing)-          1 -> do-            maxCols <- LibPQ.nfields result-            let fromRowError (col, err) = RowError 0 col err-            fmap (fmap Just . mapLeft fromRowError) $ Row.run rowDec (result, 0, maxCols, integerDatetimes)-          _ -> return (Left (UnexpectedAmountOfRows (rowToInt maxRows)))-  where-    rowToInt (LibPQ.Row n) =-      fromIntegral n--{-# INLINE single #-}-single :: Row.Row a -> Result a-single rowDec =-  do-    checkExecStatus $ \case-      LibPQ.TuplesOk -> True-      _ -> False-    Result-      $ ReaderT-      $ \(integerDatetimes, result) -> ExceptT $ do-        maxRows <- LibPQ.ntuples result-        case maxRows of-          1 -> do-            maxCols <- LibPQ.nfields result-            let fromRowError (col, err) = RowError 0 col err-            fmap (mapLeft fromRowError) $ Row.run rowDec (result, 0, maxCols, integerDatetimes)-          _ -> return (Left (UnexpectedAmountOfRows (rowToInt maxRows)))-  where-    rowToInt (LibPQ.Row n) =-      fromIntegral n--{-# INLINE vector #-}-vector :: Row.Row a -> Result (Vector a)-vector rowDec =-  do-    checkExecStatus $ \case-      LibPQ.TuplesOk -> True-      _ -> False-    Result-      $ ReaderT-      $ \(integerDatetimes, result) -> ExceptT $ do-        maxRows <- LibPQ.ntuples result-        maxCols <- LibPQ.nfields result-        mvector <- MutableVector.unsafeNew (rowToInt maxRows)-        failureRef <- newIORef Nothing-        forMFromZero_ (rowToInt maxRows) $ \rowIndex -> do-          rowResult <- Row.run rowDec (result, intToRow rowIndex, maxCols, integerDatetimes)-          case rowResult of-            Left !(!colIndex, !x) -> writeIORef failureRef (Just (RowError rowIndex colIndex x))-            Right !x -> MutableVector.unsafeWrite mvector rowIndex x-        readIORef failureRef >>= \case-          Nothing -> Right <$> Vector.unsafeFreeze mvector-          Just x -> pure (Left x)-  where-    rowToInt (LibPQ.Row n) =-      fromIntegral n-    intToRow =-      LibPQ.Row . fromIntegral--{-# INLINE foldl #-}-foldl :: (a -> b -> a) -> a -> Row.Row b -> Result a-foldl step init rowDec =-  {-# SCC "foldl" #-}-  do-    checkExecStatus $ \case-      LibPQ.TuplesOk -> True-      _ -> False-    Result-      $ ReaderT-      $ \(integerDatetimes, result) ->-        ExceptT-          $ {-# SCC "traversal" #-}-          do-            maxRows <- LibPQ.ntuples result-            maxCols <- LibPQ.nfields result-            accRef <- newIORef init-            failureRef <- newIORef Nothing-            forMFromZero_ (rowToInt maxRows) $ \rowIndex -> do-              rowResult <- Row.run rowDec (result, intToRow rowIndex, maxCols, integerDatetimes)-              case rowResult of-                Left !(!colIndex, !x) -> writeIORef failureRef (Just (RowError rowIndex colIndex x))-                Right !x -> modifyIORef' accRef (\acc -> step acc x)-            readIORef failureRef >>= \case-              Nothing -> Right <$> readIORef accRef-              Just x -> pure (Left x)-  where-    rowToInt (LibPQ.Row n) =-      fromIntegral n-    intToRow =-      LibPQ.Row . fromIntegral--{-# INLINE foldr #-}-foldr :: (b -> a -> a) -> a -> Row.Row b -> Result a-foldr step init rowDec =-  {-# SCC "foldr" #-}-  do-    checkExecStatus $ \case-      LibPQ.TuplesOk -> True-      _ -> False-    Result-      $ ReaderT-      $ \(integerDatetimes, result) -> ExceptT $ do-        maxRows <- LibPQ.ntuples result-        maxCols <- LibPQ.nfields result-        accRef <- newIORef init-        failureRef <- newIORef Nothing-        forMToZero_ (rowToInt maxRows) $ \rowIndex -> do-          rowResult <- Row.run rowDec (result, intToRow rowIndex, maxCols, integerDatetimes)-          case rowResult of-            Left !(!colIndex, !x) -> writeIORef failureRef (Just (RowError rowIndex colIndex x))-            Right !x -> modifyIORef accRef (\acc -> step x acc)-        readIORef failureRef >>= \case-          Nothing -> Right <$> readIORef accRef-          Just x -> pure (Left x)-  where-    rowToInt (LibPQ.Row n) =-      fromIntegral n-    intToRow =-      LibPQ.Row . fromIntegral
− library/Hasql/Decoders/Results.hs 
@@ -1,94 +0,0 @@--- |--- An API for retrieval of multiple results.--- Can be used to handle:------ * A single result,------ * Individual results of a multi-statement query--- with the help of "Applicative" and "Monad",------ * Row-by-row fetching.-module Hasql.Decoders.Results where--import Database.PostgreSQL.LibPQ qualified as LibPQ-import Hasql.Decoders.Result qualified as Result-import Hasql.Errors-import Hasql.Prelude hiding (many, maybe)-import Hasql.Prelude qualified as Prelude--newtype Results a-  = Results (ReaderT (Bool, LibPQ.Connection) (ExceptT CommandError IO) a)-  deriving (Functor, Applicative, Monad)--{-# INLINE run #-}-run :: Results a -> (Bool, LibPQ.Connection) -> IO (Either CommandError a)-run (Results stack) env =-  runExceptT (runReaderT stack env)--{-# INLINE clientError #-}-clientError :: Results a-clientError =-  Results-    $ ReaderT-    $ \(_, connection) ->-      ExceptT-        $ fmap (Left . ClientError) (LibPQ.errorMessage connection)---- |--- Parse a single result.-{-# INLINE single #-}-single :: Result.Result a -> Results a-single resultDec =-  Results-    $ ReaderT-    $ \(integerDatetimes, connection) -> ExceptT $ do-      resultMaybe <- LibPQ.getResult connection-      case resultMaybe of-        Just result ->-          mapLeft ResultError <$> Result.run resultDec (integerDatetimes, result)-        Nothing ->-          fmap (Left . ClientError) (LibPQ.errorMessage connection)---- |--- Fetch a single result.-{-# INLINE getResult #-}-getResult :: Results LibPQ.Result-getResult =-  Results-    $ ReaderT-    $ \(_, connection) -> ExceptT $ do-      resultMaybe <- LibPQ.getResult connection-      case resultMaybe of-        Just result -> pure (Right result)-        Nothing -> fmap (Left . ClientError) (LibPQ.errorMessage connection)---- |--- Fetch a single result.-{-# INLINE getResultMaybe #-}-getResultMaybe :: Results (Maybe LibPQ.Result)-getResultMaybe =-  Results $ ReaderT $ \(_, connection) -> lift $ LibPQ.getResult connection--{-# INLINE dropRemainders #-}-dropRemainders :: Results ()-dropRemainders =-  {-# SCC "dropRemainders" #-}-  Results $ ReaderT $ \(integerDatetimes, connection) -> loop integerDatetimes connection-  where-    loop integerDatetimes connection =-      getResultMaybe >>= Prelude.maybe (pure ()) onResult-      where-        getResultMaybe =-          lift $ LibPQ.getResult connection-        onResult result =-          loop integerDatetimes connection <* checkErrors-          where-            checkErrors =-              ExceptT $ fmap (mapLeft ResultError) $ Result.run Result.noResult (integerDatetimes, result)--refine :: (a -> Either Text b) -> Results a -> Results b-refine refiner results = Results-  $ ReaderT-  $ \env -> ExceptT $ do-    resultEither <- run results env-    return $ resultEither >>= mapLeft (ResultError . UnexpectedResult) . refiner
− library/Hasql/Decoders/Row.hs 
@@ -1,68 +0,0 @@-module Hasql.Decoders.Row where--import Database.PostgreSQL.LibPQ qualified as LibPQ-import Hasql.Decoders.Value qualified as Value-import Hasql.Errors-import Hasql.Prelude hiding (error)-import PostgreSQL.Binary.Decoding qualified as A--newtype Row a-  = Row (ReaderT Env (ExceptT RowError IO) a)-  deriving (Functor, Applicative, Monad)--instance MonadFail Row where-  fail = error . ValueError . fromString--data Env-  = Env !LibPQ.Result !LibPQ.Row !LibPQ.Column !Bool !(IORef LibPQ.Column)---- * Functions--{-# INLINE run #-}-run :: Row a -> (LibPQ.Result, LibPQ.Row, LibPQ.Column, Bool) -> IO (Either (Int, RowError) a)-run (Row impl) (result, row, columnsAmount, integerDatetimes) =-  do-    columnRef <- newIORef 0-    runExceptT (runReaderT impl (Env result row columnsAmount integerDatetimes columnRef)) >>= \case-      Left e -> do-        LibPQ.Col col <- readIORef columnRef-        -- -1 because succ is applied before the error is returned-        pure $ Left (fromIntegral col - 1, e)-      Right x -> pure $ Right x--{-# INLINE error #-}-error :: RowError -> Row a-error x =-  Row (ReaderT (const (ExceptT (pure (Left x)))))---- |--- Next value, decoded using the provided value decoder.-{-# INLINE value #-}-value :: Value.Value a -> Row (Maybe a)-value valueDec =-  {-# SCC "value" #-}-  Row-    $ ReaderT-    $ \(Env result row columnsAmount integerDatetimes columnRef) -> ExceptT $ do-      col <- readIORef columnRef-      writeIORef columnRef (succ col)-      if col < columnsAmount-        then do-          valueMaybe <- {-# SCC "getvalue'" #-} LibPQ.getvalue' result row col-          pure-            $ case valueMaybe of-              Nothing ->-                Right Nothing-              Just value ->-                fmap Just-                  $ mapLeft ValueError-                  $ {-# SCC "decode" #-} A.valueParser (Value.run valueDec integerDatetimes) value-        else pure (Left EndOfInput)---- |--- Next value, decoded using the provided value decoder.-{-# INLINE nonNullValue #-}-nonNullValue :: Value.Value a -> Row a-nonNullValue valueDec =-  {-# SCC "nonNullValue" #-}-  value valueDec >>= maybe (error UnexpectedNull) pure
− library/Hasql/Decoders/Value.hs 
@@ -1,24 +0,0 @@-module Hasql.Decoders.Value where--import Hasql.Prelude-import PostgreSQL.Binary.Decoding qualified as A--newtype Value a-  = Value (Bool -> A.Value a)-  deriving (Functor)--{-# INLINE run #-}-run :: Value a -> Bool -> A.Value a-run (Value imp) integerDatetimes =-  imp integerDatetimes--{-# INLINE decoder #-}-decoder :: (Bool -> A.Value a) -> Value a-decoder =-  {-# SCC "decoder" #-}-  Value--{-# INLINE decoderFn #-}-decoderFn :: (Bool -> ByteString -> Either Text a) -> Value a-decoderFn fn =-  Value $ \integerDatetimes -> A.fn $ fn integerDatetimes
− library/Hasql/Encoders.hs 
@@ -1,63 +0,0 @@--- |--- A DSL for declaration of statement parameter encoders.------ For compactness of names all the types defined here imply being an encoder.--- E.g., the `Array` type is an __encoder__ of arrays, not the data-structure itself.-module Hasql.Encoders-  ( -- * Parameters product-    Params,-    noParams,-    param,--    -- * Nullability-    NullableOrNot,-    nonNullable,-    nullable,--    -- * Value-    Value,-    bool,-    int2,-    int4,-    int8,-    float4,-    float8,-    numeric,-    char,-    text,-    bytea,-    date,-    timestamp,-    timestamptz,-    time,-    timetz,-    interval,-    uuid,-    inet,-    json,-    jsonBytes,-    jsonLazyBytes,-    jsonb,-    jsonbBytes,-    jsonbLazyBytes,-    name,-    oid,-    enum,-    unknownEnum,-    unknown,-    array,-    foldableArray,-    composite,--    -- * Array-    Array,-    element,-    dimension,--    -- * Composite-    Composite,-    field,-  )-where--import Hasql.Encoders.All
− library/Hasql/Encoders/All.hs 
@@ -1,423 +0,0 @@--- |--- A DSL for declaration of query parameter encoders.-module Hasql.Encoders.All where--import Data.Aeson qualified as Aeson-import Data.ByteString.Lazy qualified as LazyByteString-import Hasql.Encoders.Array qualified as Array-import Hasql.Encoders.Params qualified as Params-import Hasql.Encoders.Value qualified as Value-import Hasql.PostgresTypeInfo qualified as PTI-import Hasql.Prelude hiding (bool)-import Hasql.Prelude qualified as Prelude-import Network.IP.Addr qualified as NetworkIp-import PostgreSQL.Binary.Encoding qualified as A-import Text.Builder qualified as C---- * Parameters Product Encoder---- |--- Encoder of some representation of a parameters product.------ Has instances of 'Contravariant', 'Divisible' and 'Monoid',--- which you can use to compose multiple parameters together.--- E.g.,------ @--- someParamsEncoder :: 'Params' (Int64, Maybe Text)--- someParamsEncoder =---   ('fst' '>$<' 'param' ('nonNullable' 'int8')) '<>'---   ('snd' '>$<' 'param' ('nullable' 'text'))--- @------ As a general solution for tuples of any arity, instead of 'fst' and 'snd',--- consider the functions of the @contrazip@ family--- from the \"contravariant-extras\" package.--- E.g., here's how you can achieve the same as the above:------ @--- someParamsEncoder :: 'Params' (Int64, Maybe Text)--- someParamsEncoder =---   'contrazip2' ('param' ('nonNullable' 'int8')) ('param' ('nullable' 'text'))--- @------ Here's how you can implement encoders for custom composite types:------ @--- data Person = Person { name :: Text, gender :: Gender, age :: Int }------ data Gender = Male | Female------ personParams :: 'Params' Person--- personParams =---   (name '>$<' 'param' ('nonNullable' 'text')) '<>'---   (gender '>$<' 'param' ('nonNullable' genderValue)) '<>'---   ('fromIntegral' . age '>$<' 'param' ('nonNullable' 'int8'))------ genderValue :: 'Value' Gender--- genderValue = 'enum' genderText 'text' where---   genderText gender = case gender of---     Male -> "male"---     Female -> "female"--- @-newtype Params a = Params (Params.Params a)-  deriving (Contravariant, Divisible, Decidable, Monoid, Semigroup)---- |--- No parameters. Same as `mempty` and `conquered`.-noParams :: Params ()-noParams = mempty---- |--- Lift a single parameter encoder, with its nullability specified,--- associating it with a single placeholder.-param :: NullableOrNot Value a -> Params a-param = \case-  NonNullable (Value valueEnc) -> Params (Params.value valueEnc)-  Nullable (Value valueEnc) -> Params (Params.nullableValue valueEnc)---- * Nullability---- |--- Extensional specification of nullability over a generic encoder.-data NullableOrNot encoder a where-  NonNullable :: encoder a -> NullableOrNot encoder a-  Nullable :: encoder a -> NullableOrNot encoder (Maybe a)---- |--- Specify that an encoder produces a non-nullable value.-nonNullable :: encoder a -> NullableOrNot encoder a-nonNullable = NonNullable---- |--- Specify that an encoder produces a nullable value.-nullable :: encoder a -> NullableOrNot encoder (Maybe a)-nullable = Nullable---- * Value---- |--- Value encoder.-newtype Value a = Value (Value.Value a)-  deriving (Contravariant)---- |--- Encoder of @BOOL@ values.-{-# INLINEABLE bool #-}-bool :: Value Bool-bool = Value (Value.unsafePTIWithShow PTI.bool (const A.bool))---- |--- Encoder of @INT2@ values.-{-# INLINEABLE int2 #-}-int2 :: Value Int16-int2 = Value (Value.unsafePTIWithShow PTI.int2 (const A.int2_int16))---- |--- Encoder of @INT4@ values.-{-# INLINEABLE int4 #-}-int4 :: Value Int32-int4 = Value (Value.unsafePTIWithShow PTI.int4 (const A.int4_int32))---- |--- Encoder of @INT8@ values.-{-# INLINEABLE int8 #-}-int8 :: Value Int64-int8 = Value (Value.unsafePTIWithShow PTI.int8 (const A.int8_int64))---- |--- Encoder of @FLOAT4@ values.-{-# INLINEABLE float4 #-}-float4 :: Value Float-float4 = Value (Value.unsafePTIWithShow PTI.float4 (const A.float4))---- |--- Encoder of @FLOAT8@ values.-{-# INLINEABLE float8 #-}-float8 :: Value Double-float8 = Value (Value.unsafePTIWithShow PTI.float8 (const A.float8))---- |--- Encoder of @NUMERIC@ values.-{-# INLINEABLE numeric #-}-numeric :: Value Scientific-numeric = Value (Value.unsafePTIWithShow PTI.numeric (const A.numeric))---- |--- Encoder of @CHAR@ values.------ Note that it supports Unicode values and--- identifies itself under the @TEXT@ OID because of that.-{-# INLINEABLE char #-}-char :: Value Char-char = Value (Value.unsafePTIWithShow PTI.text (const A.char_utf8))---- |--- Encoder of @TEXT@ values.-{-# INLINEABLE text #-}-text :: Value Text-text = Value (Value.unsafePTIWithShow PTI.text (const A.text_strict))---- |--- Encoder of @BYTEA@ values.-{-# INLINEABLE bytea #-}-bytea :: Value ByteString-bytea = Value (Value.unsafePTIWithShow PTI.bytea (const A.bytea_strict))---- |--- Encoder of @DATE@ values.-{-# INLINEABLE date #-}-date :: Value Day-date = Value (Value.unsafePTIWithShow PTI.date (const A.date))---- |--- Encoder of @TIMESTAMP@ values.-{-# INLINEABLE timestamp #-}-timestamp :: Value LocalTime-timestamp = Value (Value.unsafePTIWithShow PTI.timestamp (Prelude.bool A.timestamp_float A.timestamp_int))---- |--- Encoder of @TIMESTAMPTZ@ values.-{-# INLINEABLE timestamptz #-}-timestamptz :: Value UTCTime-timestamptz = Value (Value.unsafePTIWithShow PTI.timestamptz (Prelude.bool A.timestamptz_float A.timestamptz_int))---- |--- Encoder of @TIME@ values.-{-# INLINEABLE time #-}-time :: Value TimeOfDay-time = Value (Value.unsafePTIWithShow PTI.time (Prelude.bool A.time_float A.time_int))---- |--- Encoder of @TIMETZ@ values.-{-# INLINEABLE timetz #-}-timetz :: Value (TimeOfDay, TimeZone)-timetz = Value (Value.unsafePTIWithShow PTI.timetz (Prelude.bool A.timetz_float A.timetz_int))---- |--- Encoder of @INTERVAL@ values.-{-# INLINEABLE interval #-}-interval :: Value DiffTime-interval = Value (Value.unsafePTIWithShow PTI.interval (Prelude.bool A.interval_float A.interval_int))---- |--- Encoder of @UUID@ values.-{-# INLINEABLE uuid #-}-uuid :: Value UUID-uuid = Value (Value.unsafePTIWithShow PTI.uuid (const A.uuid))---- |--- Encoder of @INET@ values.-{-# INLINEABLE inet #-}-inet :: Value (NetworkIp.NetAddr NetworkIp.IP)-inet = Value (Value.unsafePTIWithShow PTI.inet (const A.inet))---- |--- Encoder of @JSON@ values from JSON AST.-{-# INLINEABLE json #-}-json :: Value Aeson.Value-json = Value (Value.unsafePTIWithShow PTI.json (const A.json_ast))---- |--- Encoder of @JSON@ values from raw JSON.-{-# INLINEABLE jsonBytes #-}-jsonBytes :: Value ByteString-jsonBytes = Value (Value.unsafePTIWithShow PTI.json (const A.json_bytes))---- |--- Encoder of @JSON@ values from raw JSON as lazy ByteString.-{-# INLINEABLE jsonLazyBytes #-}-jsonLazyBytes :: Value LazyByteString.ByteString-jsonLazyBytes = Value (Value.unsafePTIWithShow PTI.json (const A.json_bytes_lazy))---- |--- Encoder of @JSONB@ values from JSON AST.-{-# INLINEABLE jsonb #-}-jsonb :: Value Aeson.Value-jsonb = Value (Value.unsafePTIWithShow PTI.jsonb (const A.jsonb_ast))---- |--- Encoder of @JSONB@ values from raw JSON.-{-# INLINEABLE jsonbBytes #-}-jsonbBytes :: Value ByteString-jsonbBytes = Value (Value.unsafePTIWithShow PTI.jsonb (const A.jsonb_bytes))---- |--- Encoder of @JSONB@ values from raw JSON as lazy ByteString.-{-# INLINEABLE jsonbLazyBytes #-}-jsonbLazyBytes :: Value LazyByteString.ByteString-jsonbLazyBytes = Value (Value.unsafePTIWithShow PTI.jsonb (const A.jsonb_bytes_lazy))---- |--- Encoder of @OID@ values.-{-# INLINEABLE oid #-}-oid :: Value Int32-oid = Value (Value.unsafePTIWithShow PTI.oid (const A.int4_int32))---- |--- Encoder of @NAME@ values.-{-# INLINEABLE name #-}-name :: Value Text-name = Value (Value.unsafePTIWithShow PTI.name (const A.text_strict))---- |--- Given a function,--- which maps a value into a textual enum label used on the DB side,--- produces an encoder of that value.-{-# INLINEABLE enum #-}-enum :: (a -> Text) -> Value a-enum mapping = Value (Value.unsafePTI PTI.text (const (A.text_strict . mapping)) (C.text . mapping))---- |--- Variation of 'enum' with unknown OID.--- This function does not identify the type to Postgres,--- so Postgres must be able to derive the type from context.--- When you find yourself in such situation just provide an explicit type in the query--- using the :: operator.-{-# INLINEABLE unknownEnum #-}-unknownEnum :: (a -> Text) -> Value a-unknownEnum mapping = Value (Value.unsafePTI PTI.binaryUnknown (const (A.text_strict . mapping)) (C.text . mapping))---- |--- Identifies the value with the PostgreSQL's \"unknown\" type,--- thus leaving it up to Postgres to infer the actual type of the value.------ The value transimitted is any value encoded in the Postgres' Text data format.--- For reference, see the--- <https://www.postgresql.org/docs/10/static/protocol-overview.html#PROTOCOL-FORMAT-CODES Formats and Format Codes>--- section of the Postgres' documentation.------ __Warning:__ Do not use this as part of composite encoders like 'array' since--- it is the only encoder that doesn't use the binary format.-{-# INLINEABLE unknown #-}-unknown :: Value ByteString-unknown = Value (Value.unsafePTIWithShow PTI.textUnknown (const A.bytea_strict))---- |--- Lift an array encoder into a value encoder.-array :: Array a -> Value a-array (Array (Array.Array valueOID arrayOID arrayEncoder renderer)) =-  let encoder env input = A.array (PTI.oidWord32 valueOID) (arrayEncoder env input)-   in Value (Value.Value arrayOID arrayOID encoder renderer)---- |--- Lift a composite encoder into a value encoder.-composite :: Composite a -> Value a-composite (Composite encode print) =-  Value (Value.unsafePTI PTI.binaryUnknown encodeValue printValue)-  where-    encodeValue idt val =-      A.composite $ encode val idt-    printValue val =-      "ROW (" <> C.intercalate ", " (print val) <> ")"---- |--- Lift a value encoder of element into a unidimensional array encoder of a foldable value.------ This function is merely a shortcut to the following expression:------ @--- ('array' . 'dimension' 'foldl'' . 'element')--- @------ You can use it like this:------ @--- vectorOfInts :: Value (Vector Int64)--- vectorOfInts = 'foldableArray' ('nonNullable' 'int8')--- @------ Please notice that in case of multidimensional arrays nesting 'foldableArray' encoder--- won't work. You have to explicitly construct the array encoder using 'array'.-{-# INLINE foldableArray #-}-foldableArray :: (Foldable foldable) => NullableOrNot Value element -> Value (foldable element)-foldableArray = array . dimension foldl' . element---- * Array---- |--- Generic array encoder.------ Here's an example of its usage:------ @--- someParamsEncoder :: 'Params' [[Int64]]--- someParamsEncoder = 'param' ('nonNullable' ('array' ('dimension' 'foldl'' ('dimension' 'foldl'' ('element' ('nonNullable' 'int8'))))))--- @------ Please note that the PostgreSQL @IN@ keyword does not accept an array, but rather a syntactical list of--- values, thus this encoder is not suited for that. Use a @value = ANY($1)@ condition instead.-newtype Array a = Array (Array.Array a)-  deriving (Contravariant)---- |--- Lifts a 'Value' encoder into an 'Array' encoder.-element :: NullableOrNot Value a -> Array a-element = \case-  NonNullable (Value (Value.Value elementOID arrayOID encoder renderer)) ->-    Array (Array.value elementOID arrayOID encoder renderer)-  Nullable (Value (Value.Value elementOID arrayOID encoder renderer)) ->-    Array (Array.nullableValue elementOID arrayOID encoder renderer)---- |--- Encoder of an array dimension,--- which thus provides support for multidimensional arrays.------ Accepts:------ * An implementation of the left-fold operation,--- such as @Data.Foldable.'foldl''@,--- which determines the input value.------ * A component encoder, which can be either another 'dimension' or 'element'.-{-# INLINEABLE dimension #-}-dimension :: (forall a. (a -> b -> a) -> a -> c -> a) -> Array b -> Array c-dimension foldl (Array imp) = Array (Array.dimension foldl imp)---- * Composite---- |--- Composite or row-types encoder.-data Composite a-  = Composite-      (a -> Bool -> A.Composite)-      (a -> [C.Builder])--instance Contravariant Composite where-  contramap f (Composite encode print) =-    Composite (encode . f) (print . f)--instance Divisible Composite where-  divide f (Composite encodeL printL) (Composite encodeR printR) =-    Composite-      (\val idt -> case f val of (lVal, rVal) -> encodeL lVal idt <> encodeR rVal idt)-      (\val -> case f val of (lVal, rVal) -> printL lVal <> printR rVal)-  conquer = mempty--instance Semigroup (Composite a) where-  Composite encodeL printL <> Composite encodeR printR =-    Composite-      (\val idt -> encodeL val idt <> encodeR val idt)-      (\val -> printL val <> printR val)--instance Monoid (Composite a) where-  mempty = Composite mempty mempty---- | Single field of a row-type.-field :: NullableOrNot Value a -> Composite a-field = \case-  NonNullable (Value (Value.Value elementOID arrayOID encode print)) ->-    Composite-      (\val idt -> A.field (PTI.oidWord32 elementOID) (encode idt val))-      (\val -> [print val])-  Nullable (Value (Value.Value elementOID arrayOID encode print)) ->-    Composite-      ( \val idt -> case val of-          Nothing -> A.nullField (PTI.oidWord32 elementOID)-          Just val -> A.field (PTI.oidWord32 elementOID) (encode idt val)-      )-      ( \val ->-          case val of-            Nothing -> ["NULL"]-            Just val -> [print val]-      )
− library/Hasql/Encoders/Array.hs 
@@ -1,44 +0,0 @@-module Hasql.Encoders.Array where--import Hasql.PostgresTypeInfo qualified as B-import Hasql.Prelude-import PostgreSQL.Binary.Encoding qualified as A-import Text.Builder qualified as C--data Array a-  = Array B.OID B.OID (Bool -> a -> A.Array) (a -> C.Builder)--instance Contravariant Array where-  contramap fn (Array valueOid arrayOid encoder renderer) =-    Array valueOid arrayOid (\intDateTimes -> encoder intDateTimes . fn) (renderer . fn)--{-# INLINE value #-}-value :: B.OID -> B.OID -> (Bool -> a -> A.Encoding) -> (a -> C.Builder) -> Array a-value valueOID arrayOID encoder =-  Array valueOID arrayOID (\params -> A.encodingArray . encoder params)--{-# INLINE nullableValue #-}-nullableValue :: B.OID -> B.OID -> (Bool -> a -> A.Encoding) -> (a -> C.Builder) -> Array (Maybe a)-nullableValue valueOID arrayOID encoder renderer =-  let maybeEncoder params =-        maybe A.nullArray (A.encodingArray . encoder params)-      maybeRenderer =-        maybe (C.string "null") renderer-   in Array valueOID arrayOID maybeEncoder maybeRenderer--{-# INLINE dimension #-}-dimension :: (forall a. (a -> b -> a) -> a -> c -> a) -> Array b -> Array c-dimension fold (Array valueOID arrayOID elEncoder elRenderer) =-  let encoder el =-        A.dimensionArray fold (elEncoder el)-      renderer els =-        let folded =-              let step builder el =-                    if C.null builder-                      then C.char '[' <> elRenderer el-                      else builder <> C.string ", " <> elRenderer el-               in fold step mempty els-         in if C.null folded-              then C.string "[]"-              else folded <> C.char ']'-   in Array valueOID arrayOID encoder renderer
− library/Hasql/Encoders/Params.hs 
@@ -1,31 +0,0 @@-module Hasql.Encoders.Params where--import Database.PostgreSQL.LibPQ qualified as A-import Hasql.Encoders.Value qualified as C-import Hasql.PostgresTypeInfo qualified as D-import Hasql.Prelude-import PostgreSQL.Binary.Encoding qualified as B-import Text.Builder qualified as E---- |--- Encoder of some representation of a parameters product.-newtype Params a-  = Params (Op (DList (A.Oid, A.Format, Bool -> Maybe ByteString, Text)) a)-  deriving (Contravariant, Divisible, Decidable, Semigroup, Monoid)--value :: C.Value a -> Params a-value =-  contramap Just . nullableValue--nullableValue :: C.Value a -> Params (Maybe a)-nullableValue (C.Value valueOID arrayOID encode render) =-  Params-    $ Op-    $ \input ->-      let D.OID _ pqOid format =-            valueOID-          encoder env =-            fmap (B.encodingBytes . encode env) input-          rendering =-            maybe "null" (E.run . render) input-       in pure (pqOid, format, encoder, rendering)
− library/Hasql/Encoders/Value.hs 
@@ -1,24 +0,0 @@-module Hasql.Encoders.Value where--import Hasql.PostgresTypeInfo qualified as PTI-import Hasql.Prelude-import PostgreSQL.Binary.Encoding qualified as B-import Text.Builder qualified as C--data Value a-  = Value PTI.OID PTI.OID (Bool -> a -> B.Encoding) (a -> C.Builder)--instance Contravariant Value where-  {-# INLINE contramap #-}-  contramap f (Value valueOID arrayOID encode render) =-    Value valueOID arrayOID (\integerDatetimes input -> encode integerDatetimes (f input)) (render . f)--{-# INLINE unsafePTI #-}-unsafePTI :: PTI.PTI -> (Bool -> a -> B.Encoding) -> (a -> C.Builder) -> Value a-unsafePTI pti =-  Value (PTI.ptiOID pti) (fromMaybe (error "No array OID") (PTI.ptiArrayOID pti))--{-# INLINE unsafePTIWithShow #-}-unsafePTIWithShow :: (Show a) => PTI.PTI -> (Bool -> a -> B.Encoding) -> Value a-unsafePTIWithShow pti encode =-  unsafePTI pti encode (C.string . show)
− library/Hasql/Errors.hs 
@@ -1,147 +0,0 @@--- |--- An API for retrieval of multiple results.--- Can be used to handle:------ * A single result,------ * Individual results of a multi-statement query--- with the help of "Applicative" and "Monad",------ * Row-by-row fetching.-module Hasql.Errors where--import Data.ByteString.Char8 qualified as BC-import Hasql.Prelude---- |--- An error during the execution of a query.--- Comes packed with the query template and a textual representation of the provided params.-data QueryError-  = QueryError ByteString [Text] CommandError-  deriving (Show, Eq, Typeable)--instance Exception QueryError where-  displayException (QueryError query params commandError) =-    let queryContext :: Maybe (ByteString, Int)-        queryContext = case commandError of-          ClientError _ -> Nothing-          ResultError resultError -> case resultError of-            ServerError _ message _ _ (Just position) -> Just (message, position)-            _ -> Nothing--        -- find the line number and position of the error-        findLineAndPos :: ByteString -> Int -> (Int, Int)-        findLineAndPos byteString errorPos =-          let (_, line, pos) =-                BC.foldl'-                  ( \(total, line, pos) c ->-                      case total + 1 of-                        0 -> (total, line, pos)-                        cursor-                          | cursor == errorPos -> (-1, line, pos + 1)-                          | c == '\n' -> (total + 1, line + 1, 0)-                          | otherwise -> (total + 1, line, pos + 1)-                  )-                  (0, 1, 0)-                  byteString-           in (line, pos)--        formatErrorContext :: ByteString -> ByteString -> Int -> ByteString-        formatErrorContext query message errorPos =-          let lines = BC.lines query-              (lineNum, linePos) = findLineAndPos query errorPos-           in BC.unlines (take lineNum lines)-                <> BC.replicate (linePos - 1) ' '-                <> "^ "-                <> message--        prettyQuery :: ByteString-        prettyQuery = case queryContext of-          Nothing -> query-          Just (message, pos) -> formatErrorContext query message pos-     in "QueryError!\n"-          <> "\n  Query:\n"-          <> BC.unpack prettyQuery-          <> "\n"-          <> "\n  Params: "-          <> show params-          <> "\n  Error: "-          <> case commandError of-            ClientError (Just message) -> "Client error: " <> show message-            ClientError Nothing -> "Unknown client error"-            ResultError resultError -> case resultError of-              ServerError code message details hint position ->-                "Server error "-                  <> BC.unpack code-                  <> ": "-                  <> BC.unpack message-                  <> maybe "" (\d -> "\n  Details: " <> BC.unpack d) details-                  <> maybe "" (\h -> "\n  Hint: " <> BC.unpack h) hint-              UnexpectedResult message -> "Unexpected result: " <> show message-              RowError row column rowError ->-                "Row error: " <> show row <> ":" <> show column <> " " <> show rowError-              UnexpectedAmountOfRows amount ->-                "Unexpected amount of rows: " <> show amount---- |--- An error of some command in the session.-data CommandError-  = -- |-    -- An error on the client-side,-    -- with a message generated by the \"libpq\" library.-    -- Usually indicates problems with connection.-    ClientError (Maybe ByteString)-  | -- |-    -- Some error with a command result.-    ResultError ResultError-  deriving (Show, Eq)---- |--- An error with a command result.-data ResultError-  = -- | An error reported by the DB.-    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 error of the row reader, preceded by the indexes of the row and column.-    RowError Int Int RowError-  | -- |-    -- An unexpected amount of rows.-    UnexpectedAmountOfRows Int-  deriving (Show, Eq)---- |--- An error during the decoding of a specific row.-data RowError-  = -- |-    -- Appears on the attempt to parse more columns than there are in the result.-    EndOfInput-  | -- |-    -- Appears on the attempt to parse a @NULL@ as some value.-    UnexpectedNull-  | -- |-    -- Appears when a wrong value parser is used.-    -- Comes with the error details.-    ValueError Text-  deriving (Show, Eq)
− library/Hasql/IO.hs 
@@ -1,162 +0,0 @@--- |--- An API of low-level IO operations.-module Hasql.IO where--import Database.PostgreSQL.LibPQ qualified as LibPQ-import Hasql.Commands qualified as Commands-import Hasql.Decoders.Result qualified as ResultDecoders-import Hasql.Decoders.Results qualified as ResultsDecoders-import Hasql.Encoders.Params qualified as ParamsEncoders-import Hasql.Errors-import Hasql.Prelude-import Hasql.PreparedStatementRegistry qualified as PreparedStatementRegistry--{-# INLINE acquireConnection #-}-acquireConnection :: ByteString -> IO LibPQ.Connection-acquireConnection =-  LibPQ.connectdb--{-# INLINE acquirePreparedStatementRegistry #-}-acquirePreparedStatementRegistry :: IO PreparedStatementRegistry.PreparedStatementRegistry-acquirePreparedStatementRegistry =-  PreparedStatementRegistry.new--{-# INLINE releaseConnection #-}-releaseConnection :: LibPQ.Connection -> IO ()-releaseConnection connection =-  LibPQ.finish connection--{-# INLINE checkConnectionStatus #-}-checkConnectionStatus :: LibPQ.Connection -> IO (Maybe (Maybe ByteString))-checkConnectionStatus c =-  do-    s <- LibPQ.status c-    case s of-      LibPQ.ConnectionOk -> return Nothing-      _ -> fmap Just (LibPQ.errorMessage c)--{-# INLINE checkServerVersion #-}-checkServerVersion :: LibPQ.Connection -> IO (Maybe Int)-checkServerVersion c =-  fmap (mfilter (< 80200) . Just) (LibPQ.serverVersion c)--{-# INLINE getIntegerDatetimes #-}-getIntegerDatetimes :: LibPQ.Connection -> IO Bool-getIntegerDatetimes c =-  fmap decodeValue $ LibPQ.parameterStatus c "integer_datetimes"-  where-    decodeValue =-      \case-        Just "on" -> True-        _ -> False--{-# INLINE initConnection #-}-initConnection :: LibPQ.Connection -> IO ()-initConnection c =-  void $ LibPQ.exec c (Commands.asBytes (Commands.setEncodersToUTF8 <> Commands.setMinClientMessagesToWarning))--{-# INLINE getResults #-}-getResults :: LibPQ.Connection -> Bool -> ResultsDecoders.Results a -> IO (Either CommandError a)-getResults connection integerDatetimes decoder =-  {-# SCC "getResults" #-}-  (<*) <$> get <*> dropRemainders-  where-    get =-      ResultsDecoders.run decoder (integerDatetimes, connection)-    dropRemainders =-      ResultsDecoders.run ResultsDecoders.dropRemainders (integerDatetimes, connection)--{-# INLINE getPreparedStatementKey #-}-getPreparedStatementKey ::-  LibPQ.Connection ->-  PreparedStatementRegistry.PreparedStatementRegistry ->-  ByteString ->-  [LibPQ.Oid] ->-  IO (Either CommandError ByteString)-getPreparedStatementKey connection registry template oidList =-  {-# SCC "getPreparedStatementKey" #-}-  PreparedStatementRegistry.update localKey onNewRemoteKey onOldRemoteKey registry-  where-    localKey =-      PreparedStatementRegistry.LocalKey template wordOIDList-      where-        wordOIDList =-          map (\(LibPQ.Oid x) -> fromIntegral x) oidList-    onNewRemoteKey key =-      do-        sent <- LibPQ.sendPrepare connection key template (mfilter (not . null) (Just oidList))-        let resultsDecoder =-              if sent-                then ResultsDecoders.single ResultDecoders.noResult-                else ResultsDecoders.clientError-        fmap resultsMapping $ getResults connection undefined resultsDecoder-      where-        resultsMapping =-          \case-            Left x -> (False, Left x)-            Right _ -> (True, Right key)-    onOldRemoteKey key =-      pure (pure key)--{-# INLINE checkedSend #-}-checkedSend :: LibPQ.Connection -> IO Bool -> IO (Either CommandError ())-checkedSend connection send =-  send >>= \case-    False -> fmap (Left . ClientError) $ LibPQ.errorMessage connection-    True -> pure (Right ())--{-# INLINE sendPreparedParametricStatement #-}-sendPreparedParametricStatement ::-  LibPQ.Connection ->-  PreparedStatementRegistry.PreparedStatementRegistry ->-  Bool ->-  ByteString ->-  ParamsEncoders.Params a ->-  a ->-  IO (Either CommandError ())-sendPreparedParametricStatement connection registry integerDatetimes template (ParamsEncoders.Params (Op encoderOp)) input =-  let (oidList, valueAndFormatList) =-        let step (oid, format, encoder, _) ~(oidList, bytesAndFormatList) =-              (,)-                (oid : oidList)-                (fmap (\bytes -> (bytes, format)) (encoder integerDatetimes) : bytesAndFormatList)-         in foldr step ([], []) (encoderOp input)-   in runExceptT $ do-        key <- ExceptT $ getPreparedStatementKey connection registry template oidList-        ExceptT $ checkedSend connection $ LibPQ.sendQueryPrepared connection key valueAndFormatList LibPQ.Binary--{-# INLINE sendUnpreparedParametricStatement #-}-sendUnpreparedParametricStatement ::-  LibPQ.Connection ->-  Bool ->-  ByteString ->-  ParamsEncoders.Params a ->-  a ->-  IO (Either CommandError ())-sendUnpreparedParametricStatement connection integerDatetimes template (ParamsEncoders.Params (Op encoderOp)) input =-  let params =-        let step (oid, format, encoder, _) acc =-              ((,,) <$> pure oid <*> encoder integerDatetimes <*> pure format) : acc-         in foldr step [] (encoderOp input)-   in checkedSend connection $ LibPQ.sendQueryParams connection template params LibPQ.Binary--{-# INLINE sendParametricStatement #-}-sendParametricStatement ::-  LibPQ.Connection ->-  Bool ->-  PreparedStatementRegistry.PreparedStatementRegistry ->-  ByteString ->-  ParamsEncoders.Params a ->-  Bool ->-  a ->-  IO (Either CommandError ())-sendParametricStatement connection integerDatetimes registry template encoder prepared params =-  {-# SCC "sendParametricStatement" #-}-  if prepared-    then sendPreparedParametricStatement connection registry integerDatetimes template encoder params-    else sendUnpreparedParametricStatement connection integerDatetimes template encoder params--{-# INLINE sendNonparametricStatement #-}-sendNonparametricStatement :: LibPQ.Connection -> ByteString -> IO (Either CommandError ())-sendNonparametricStatement connection sql =-  checkedSend connection $ LibPQ.sendQuery connection sql
− library/Hasql/PostgresTypeInfo.hs 
@@ -1,230 +0,0 @@-module Hasql.PostgresTypeInfo where--import Database.PostgreSQL.LibPQ qualified as LibPQ-import Hasql.Prelude hiding (bool)---- | A Postgresql type info-data PTI = PTI {ptiOID :: !OID, ptiArrayOID :: !(Maybe OID)}---- | A Word32 and a LibPQ representation of an OID-data OID = OID {oidWord32 :: !Word32, oidPQ :: !LibPQ.Oid, oidFormat :: !LibPQ.Format}--mkOID :: LibPQ.Format -> Word32 -> OID-mkOID format x =-  OID x ((LibPQ.Oid . fromIntegral) x) format--mkPTI :: LibPQ.Format -> Word32 -> Maybe Word32 -> PTI-mkPTI format oid arrayOID =-  PTI (mkOID format oid) (fmap (mkOID format) arrayOID)---- * Constants--abstime :: PTI-abstime = mkPTI LibPQ.Binary 702 (Just 1023)--aclitem :: PTI-aclitem = mkPTI LibPQ.Binary 1033 (Just 1034)--bit :: PTI-bit = mkPTI LibPQ.Binary 1560 (Just 1561)--bool :: PTI-bool = mkPTI LibPQ.Binary 16 (Just 1000)--box :: PTI-box = mkPTI LibPQ.Binary 603 (Just 1020)--bpchar :: PTI-bpchar = mkPTI LibPQ.Binary 1042 (Just 1014)--bytea :: PTI-bytea = mkPTI LibPQ.Binary 17 (Just 1001)--char :: PTI-char = mkPTI LibPQ.Binary 18 (Just 1002)--cid :: PTI-cid = mkPTI LibPQ.Binary 29 (Just 1012)--cidr :: PTI-cidr = mkPTI LibPQ.Binary 650 (Just 651)--circle :: PTI-circle = mkPTI LibPQ.Binary 718 (Just 719)--cstring :: PTI-cstring = mkPTI LibPQ.Binary 2275 (Just 1263)--date :: PTI-date = mkPTI LibPQ.Binary 1082 (Just 1182)--daterange :: PTI-daterange = mkPTI LibPQ.Binary 3912 (Just 3913)--float4 :: PTI-float4 = mkPTI LibPQ.Binary 700 (Just 1021)--float8 :: PTI-float8 = mkPTI LibPQ.Binary 701 (Just 1022)--gtsvector :: PTI-gtsvector = mkPTI LibPQ.Binary 3642 (Just 3644)--inet :: PTI-inet = mkPTI LibPQ.Binary 869 (Just 1041)--int2 :: PTI-int2 = mkPTI LibPQ.Binary 21 (Just 1005)--int2vector :: PTI-int2vector = mkPTI LibPQ.Binary 22 (Just 1006)--int4 :: PTI-int4 = mkPTI LibPQ.Binary 23 (Just 1007)--int4range :: PTI-int4range = mkPTI LibPQ.Binary 3904 (Just 3905)--int8 :: PTI-int8 = mkPTI LibPQ.Binary 20 (Just 1016)--int8range :: PTI-int8range = mkPTI LibPQ.Binary 3926 (Just 3927)--interval :: PTI-interval = mkPTI LibPQ.Binary 1186 (Just 1187)--json :: PTI-json = mkPTI LibPQ.Binary 114 (Just 199)--jsonb :: PTI-jsonb = mkPTI LibPQ.Binary 3802 (Just 3807)--line :: PTI-line = mkPTI LibPQ.Binary 628 (Just 629)--lseg :: PTI-lseg = mkPTI LibPQ.Binary 601 (Just 1018)--macaddr :: PTI-macaddr = mkPTI LibPQ.Binary 829 (Just 1040)--money :: PTI-money = mkPTI LibPQ.Binary 790 (Just 791)--name :: PTI-name = mkPTI LibPQ.Binary 19 (Just 1003)--numeric :: PTI-numeric = mkPTI LibPQ.Binary 1700 (Just 1231)--numrange :: PTI-numrange = mkPTI LibPQ.Binary 3906 (Just 3907)--oid :: PTI-oid = mkPTI LibPQ.Binary 26 (Just 1028)--oidvector :: PTI-oidvector = mkPTI LibPQ.Binary 30 (Just 1013)--path :: PTI-path = mkPTI LibPQ.Binary 602 (Just 1019)--point :: PTI-point = mkPTI LibPQ.Binary 600 (Just 1017)--polygon :: PTI-polygon = mkPTI LibPQ.Binary 604 (Just 1027)--record :: PTI-record = mkPTI LibPQ.Binary 2249 (Just 2287)--refcursor :: PTI-refcursor = mkPTI LibPQ.Binary 1790 (Just 2201)--regclass :: PTI-regclass = mkPTI LibPQ.Binary 2205 (Just 2210)--regconfig :: PTI-regconfig = mkPTI LibPQ.Binary 3734 (Just 3735)--regdictionary :: PTI-regdictionary = mkPTI LibPQ.Binary 3769 (Just 3770)--regoper :: PTI-regoper = mkPTI LibPQ.Binary 2203 (Just 2208)--regoperator :: PTI-regoperator = mkPTI LibPQ.Binary 2204 (Just 2209)--regproc :: PTI-regproc = mkPTI LibPQ.Binary 24 (Just 1008)--regprocedure :: PTI-regprocedure = mkPTI LibPQ.Binary 2202 (Just 2207)--regtype :: PTI-regtype = mkPTI LibPQ.Binary 2206 (Just 2211)--reltime :: PTI-reltime = mkPTI LibPQ.Binary 703 (Just 1024)--text :: PTI-text = mkPTI LibPQ.Binary 25 (Just 1009)--tid :: PTI-tid = mkPTI LibPQ.Binary 27 (Just 1010)--time :: PTI-time = mkPTI LibPQ.Binary 1083 (Just 1183)--timestamp :: PTI-timestamp = mkPTI LibPQ.Binary 1114 (Just 1115)--timestamptz :: PTI-timestamptz = mkPTI LibPQ.Binary 1184 (Just 1185)--timetz :: PTI-timetz = mkPTI LibPQ.Binary 1266 (Just 1270)--tinterval :: PTI-tinterval = mkPTI LibPQ.Binary 704 (Just 1025)--tsquery :: PTI-tsquery = mkPTI LibPQ.Binary 3615 (Just 3645)--tsrange :: PTI-tsrange = mkPTI LibPQ.Binary 3908 (Just 3909)--tstzrange :: PTI-tstzrange = mkPTI LibPQ.Binary 3910 (Just 3911)--tsvector :: PTI-tsvector = mkPTI LibPQ.Binary 3614 (Just 3643)--txid_snapshot :: PTI-txid_snapshot = mkPTI LibPQ.Binary 2970 (Just 2949)--textUnknown :: PTI-textUnknown = mkPTI LibPQ.Text 705 (Just 705)--binaryUnknown :: PTI-binaryUnknown = mkPTI LibPQ.Binary 705 (Just 705)--uuid :: PTI-uuid = mkPTI LibPQ.Binary 2950 (Just 2951)--varbit :: PTI-varbit = mkPTI LibPQ.Binary 1562 (Just 1563)--varchar :: PTI-varchar = mkPTI LibPQ.Binary 1043 (Just 1015)--void :: PTI-void = mkPTI LibPQ.Binary 2278 Nothing--xid :: PTI-xid = mkPTI LibPQ.Binary 28 (Just 1011)--xml :: PTI-xml = mkPTI LibPQ.Binary 142 (Just 143)
− library/Hasql/Prelude.hs 
@@ -1,137 +0,0 @@-module Hasql.Prelude-  ( module Exports,-    LazyByteString,-    ByteStringBuilder,-    LazyText,-    TextBuilder,-    forMToZero_,-    forMFromZero_,-    strictCons,-    mapLeft,-  )-where--import Control.Applicative as Exports hiding (WrappedArrow (..))-import Control.Arrow as Exports hiding (first, second)-import Control.Category as Exports-import Control.Concurrent as Exports-import Control.Exception as Exports-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 (MonadReader (..))-import Control.Monad.ST 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), catchE, except, mapExcept, mapExceptT, runExcept, runExceptT, throwE, 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.Builder qualified-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.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, 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-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.Lazy qualified-import Data.Text.Lazy.Builder qualified-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 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 Unsafe.Coerce as Exports-import Prelude as Exports hiding (Read, all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.))--type LazyByteString =-  Data.ByteString.Lazy.ByteString--type ByteStringBuilder =-  Data.ByteString.Builder.Builder--type LazyText =-  Data.Text.Lazy.Text--type TextBuilder =-  Data.Text.Lazy.Builder.Builder--{-# 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--{-# INLINE mapLeft #-}-mapLeft :: (a -> c) -> Either a b -> Either c b-mapLeft f =-  either (Left . f) Right
− library/Hasql/PreparedStatementRegistry.hs 
@@ -1,53 +0,0 @@-module Hasql.PreparedStatementRegistry-  ( PreparedStatementRegistry,-    new,-    update,-    LocalKey (..),-  )-where--import ByteString.StrictBuilder qualified as B-import Data.HashTable.IO qualified as A-import Hasql.Prelude hiding (lookup)--data PreparedStatementRegistry-  = PreparedStatementRegistry !(A.BasicHashTable LocalKey ByteString) !(IORef Word)--{-# INLINEABLE new #-}-new :: IO PreparedStatementRegistry-new =-  PreparedStatementRegistry <$> A.new <*> newIORef 0--{-# INLINEABLE update #-}-update :: LocalKey -> (ByteString -> IO (Bool, a)) -> (ByteString -> IO a) -> PreparedStatementRegistry -> IO a-update localKey onNewRemoteKey onOldRemoteKey (PreparedStatementRegistry table counter) =-  lookup >>= maybe new old-  where-    lookup =-      A.lookup table localKey-    new =-      readIORef counter >>= onN-      where-        onN n =-          do-            (save, result) <- onNewRemoteKey remoteKey-            when save $ do-              A.insert table localKey remoteKey-              writeIORef counter (succ n)-            return result-          where-            remoteKey =-              B.builderBytes . B.asciiIntegral $ n-    old =-      onOldRemoteKey---- |--- Local statement key.-data LocalKey-  = LocalKey !ByteString ![Word32]-  deriving (Show, Eq)--instance Hashable LocalKey where-  {-# INLINE hashWithSalt #-}-  hashWithSalt salt (LocalKey template types) =-    hashWithSalt salt template
− library/Hasql/Session.hs 
@@ -1,15 +0,0 @@-module Hasql.Session-  ( Session,-    sql,-    statement,--    -- * Execution-    run,--    -- * Errors-    module Hasql.Errors,-  )-where--import Hasql.Errors-import Hasql.Session.Core
− library/Hasql/Session/Core.hs 
@@ -1,65 +0,0 @@-module Hasql.Session.Core where--import Hasql.Connection.Core qualified as Connection-import Hasql.Decoders.Result qualified as Decoders.Result-import Hasql.Decoders.Results qualified as Decoders.Results-import Hasql.Encoders.All qualified as Encoders-import Hasql.Encoders.Params qualified as Encoders.Params-import Hasql.Errors-import Hasql.IO qualified as IO-import Hasql.Prelude-import Hasql.Statement qualified as Statement---- |--- A batch of actions to be executed in the context of a database connection.-newtype Session a-  = Session (ReaderT Connection.Connection (ExceptT QueryError IO) a)-  deriving (Functor, Applicative, Monad, MonadError QueryError, MonadIO, MonadReader Connection.Connection)---- |--- Executes a bunch of commands on the provided connection.-run :: Session a -> Connection.Connection -> IO (Either QueryError a)-run (Session impl) connection =-  runExceptT-    $ runReaderT impl connection---- |--- Possibly a multi-statement query,--- which however cannot be parameterized or prepared,--- nor can any results of it be collected.-sql :: ByteString -> Session ()-sql sql =-  Session-    $ ReaderT-    $ \(Connection.Connection pqConnectionRef integerDatetimes registry) ->-      ExceptT-        $ fmap (mapLeft (QueryError sql []))-        $ withMVar pqConnectionRef-        $ \pqConnection -> do-          r1 <- IO.sendNonparametricStatement pqConnection sql-          r2 <- IO.getResults pqConnection integerDatetimes decoder-          return $ r1 *> r2-  where-    decoder =-      Decoders.Results.single Decoders.Result.noResult---- |--- Parameters and a specification of a parametric single-statement query to apply them to.-statement :: params -> Statement.Statement params result -> Session result-statement input (Statement.Statement template (Encoders.Params paramsEncoder) decoder preparable) =-  Session-    $ ReaderT-    $ \(Connection.Connection pqConnectionRef integerDatetimes registry) ->-      ExceptT-        $ fmap (mapLeft (QueryError template inputReps))-        $ withMVar pqConnectionRef-        $ \pqConnection -> do-          r1 <- IO.sendParametricStatement pqConnection integerDatetimes registry template paramsEncoder preparable input-          r2 <- IO.getResults pqConnection integerDatetimes (unsafeCoerce decoder)-          return $ r1 *> r2-  where-    inputReps =-      let Encoders.Params.Params (Op encoderOp) = paramsEncoder-          step (_, _, _, rendering) acc =-            rendering : acc-       in foldr step [] (encoderOp input)
− library/Hasql/Settings.hs 
@@ -1,39 +0,0 @@-module Hasql.Settings where--import Data.ByteString qualified as B-import Data.ByteString.Builder qualified as BB-import Data.ByteString.Lazy qualified as BL-import Hasql.Prelude---- |--- All settings encoded in a single byte-string according to--- <http://www.postgresql.org/docs/9.4/static/libpq-connect.html#LIBPQ-CONNSTRING the PostgreSQL format>.-type Settings =-  ByteString---- |--- Encode a host, a port, a user, a password and a database into the PostgreSQL settings byte-string.-{-# INLINE settings #-}-settings :: ByteString -> Word16 -> ByteString -> ByteString -> ByteString -> Settings-settings host port user password database =-  BL.toStrict-    $ BB.toLazyByteString-    $ mconcat-    $ intersperse (BB.char7 ' ')-    $ catMaybes-    $ [ mappend (BB.string7 "host=")-          . BB.byteString-          <$> mfilter (not . B.null) (pure host),-        mappend (BB.string7 "port=")-          . BB.word16Dec-          <$> mfilter (/= 0) (pure port),-        mappend (BB.string7 "user=")-          . BB.byteString-          <$> mfilter (not . B.null) (pure user),-        mappend (BB.string7 "password=")-          . BB.byteString-          <$> mfilter (not . B.null) (pure password),-        mappend (BB.string7 "dbname=")-          . BB.byteString-          <$> mfilter (not . B.null) (pure database)-      ]
− library/Hasql/Statement.hs 
@@ -1,125 +0,0 @@-module Hasql.Statement-  ( Statement (..),-    refineResult,--    -- * Recipes--    -- ** Insert many-    -- $insertMany--    -- ** IN and NOT IN-    -- $inAndNotIn-  )-where--import Hasql.Decoders qualified as Decoders-import Hasql.Decoders.All qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Prelude---- |--- Specification of a strictly single-statement query, which can be parameterized and prepared.--- It encapsulates the mapping of parameters and results in association with an SQL template.------ Following is an example of a declaration of a prepared statement with its associated codecs.------ @--- selectSum :: 'Statement' (Int64, Int64) Int64--- selectSum =---   'Statement' sql encoder decoder True---   where---     sql =---       \"select ($1 + $2)\"---     encoder =---       ('fst' '>$<' Encoders.'Hasql.Encoders.param' (Encoders.'Hasql.Encoders.nonNullable' Encoders.'Hasql.Encoders.int8')) '<>'---       ('snd' '>$<' Encoders.'Hasql.Encoders.param' (Encoders.'Hasql.Encoders.nonNullable' Encoders.'Hasql.Encoders.int8'))---     decoder =---       Decoders.'Hasql.Decoders.singleRow' (Decoders.'Hasql.Decoders.column' (Decoders.'Hasql.Decoders.nonNullable' Decoders.'Hasql.Decoders.int8'))--- @------ The statement above accepts a product of two parameters of type 'Int64'--- and produces a single result of type 'Int64'.-data Statement params result-  = Statement-      -- | SQL template.-      ---      -- Must be formatted according to the Postgres standard,-      -- with any non-ASCII characters of the template encoded using UTF-8.-      -- The parameters must be referred to using the positional notation, as in the following:-      -- @$1@, @$2@, @$3@ and etc.-      -- These references must be used in accordance with the order in which-      -- the value encoders are specified in the parameters encoder.-      ByteString-      -- | Parameters encoder.-      (Encoders.Params params)-      -- | Decoder of result.-      (Decoders.Result result)-      -- | Flag, determining whether it should be prepared.-      ---      -- Set it to 'True' if your application has a limited amount of queries and doesn't generate the SQL dynamically.-      -- This will boost the performance by allowing Postgres to avoid reconstructing the execution plan each time the query gets executed.-      ---      -- Note that if you're using proxying applications like @pgbouncer@, such tools may be incompatible with prepared statements.-      -- So do consult their docs or just set it to 'False' to stay on the safe side.-      -- It should be noted that starting from version @1.21.0@ @pgbouncer@ now does provide support for prepared statements.-      Bool--instance Functor (Statement params) where-  {-# INLINE fmap #-}-  fmap = rmap--instance Profunctor Statement where-  {-# INLINE dimap #-}-  dimap f1 f2 (Statement template encoder decoder preparable) =-    Statement template (contramap f1 encoder) (fmap f2 decoder) preparable---- |--- Refine the result of a statement,--- causing the running session to fail with the `UnexpectedResult` error in case of a refinement failure.------ This function is especially useful for refining the results of statements produced with--- <http://hackage.haskell.org/package/hasql-th the \"hasql-th\" library>.-refineResult :: (a -> Either Text b) -> Statement params a -> Statement params b-refineResult refiner (Statement template encoder decoder preparable) =-  Statement template encoder (Decoders.refineResult refiner decoder) preparable---- $insertMany------ Starting from PostgreSQL 9.4 there is an @unnest@ function which we can use in an analogous way--- to haskell's `zip` to pass in multiple arrays of values--- to be zipped into the rows to insert as in the following example:------ @--- insertMultipleLocations :: 'Statement' (Vector (UUID, Double, Double)) ()--- insertMultipleLocations =---   'Statement' sql encoder decoder True---   where---     sql =---       "insert into location (id, x, y) select * from unnest ($1, $2, $3)"---     encoder =---       Data.Vector.'Data.Vector.unzip3' '>$<'---         Contravariant.Extras.contrazip3---           (Encoders.'Encoders.param' $ Encoders.'Encoders.nonNullable' $ Encoders.'Encoders.foldableArray' $ Encoders.'Encoders.nonNullable' Encoders.'Encoders.uuid')---           (Encoders.'Encoders.param' $ Encoders.'Encoders.nonNullable' $ Encoders.'Encoders.foldableArray' $ Encoders.'Encoders.nonNullable' Encoders.'Encoders.float8')---           (Encoders.'Encoders.param' $ Encoders.'Encoders.nonNullable' $ Encoders.'Encoders.foldableArray' $ Encoders.'Encoders.nonNullable' Encoders.'Encoders.float8')---     decoder =---       Decoders.'Decoders.noResult'--- @------ This approach is much more efficient than executing a single-row insert-statement multiple times.---- $inAndNotIn------ There is a common misconception that PostgreSQL supports array--- as the parameter for the @IN@ operator.--- However Postgres only supports a syntactical list of values with it,--- i.e., you have to specify each option as an individual parameter.--- E.g., @some_expression IN ($1, $2, $3)@.------ Fortunately, Postgres does provide the expected functionality for arrays with other operators:------ * Use @some_expression = ANY($1)@ instead of @some_expression IN ($1)@--- * Use @some_expression <> ALL($1)@ instead of @some_expression NOT IN ($1)@------ For details refer to--- <https://www.postgresql.org/docs/9.6/static/functions-comparisons.html#AEN20944 the PostgreSQL docs>.
− profiling/Main.hs 
@@ -1,92 +0,0 @@-module Main where--import Data.Vector qualified as F-import Hasql.Connection qualified as A-import Hasql.Decoders qualified as D-import Hasql.Session qualified as B-import Hasql.Statement qualified as C-import Prelude--main :: IO ()-main =-  do-    Right connection <- acquireConnection-    traceEventIO "START Session"-    Right result <- B.run sessionWithManySmallResults connection-    traceEventIO "STOP Session"-    return ()-  where-    acquireConnection =-      A.acquire settings-      where-        settings =-          A.settings host port user password database-          where-            host = "localhost"-            port = 5432-            user = "postgres"-            password = "postgres"-            database = "postgres"---- * Sessions--sessionWithManySmallParameters :: Vector (Int64, Int64) -> B.Session ()-sessionWithManySmallParameters =-  error "TODO: sessionWithManySmallParameters"--sessionWithSingleLargeResultInVector :: B.Session (Vector (Int64, Int64))-sessionWithSingleLargeResultInVector =-  B.statement () statementWithManyRowsInVector--sessionWithSingleLargeResultInList :: B.Session [(Int64, Int64)]-sessionWithSingleLargeResultInList =-  B.statement () statementWithManyRowsInList--sessionWithManySmallResults :: B.Session (Vector (Int64, Int64))-sessionWithManySmallResults =-  F.replicateM 1000 (B.statement () statementWithSingleRow)---- * Statements--statementWithManyParameters :: C.Statement (Vector (Int64, Int64)) ()-statementWithManyParameters =-  error "TODO: statementWithManyParameters"--statementWithSingleRow :: C.Statement () (Int64, Int64)-statementWithSingleRow =-  C.Statement template encoder decoder True-  where-    template =-      "SELECT 1, 2"-    encoder =-      conquer-    decoder =-      D.singleRow row-      where-        row =-          tuple <$> (D.column . D.nonNullable) D.int8 <*> (D.column . D.nonNullable) D.int8-          where-            tuple !a !b =-              (a, b)--statementWithManyRows :: (D.Row (Int64, Int64) -> D.Result result) -> C.Statement () result-statementWithManyRows decoder =-  C.Statement template encoder (decoder rowDecoder) True-  where-    template =-      "SELECT generate_series(0,1000) as a, generate_series(1000,2000) as b"-    encoder =-      conquer-    rowDecoder =-      tuple <$> (D.column . D.nonNullable) D.int8 <*> (D.column . D.nonNullable) D.int8-      where-        tuple !a !b =-          (a, b)--statementWithManyRowsInVector :: C.Statement () (Vector (Int64, Int64))-statementWithManyRowsInVector =-  statementWithManyRows D.rowVector--statementWithManyRowsInList :: C.Statement () [(Int64, Int64)]-statementWithManyRowsInList =-  statementWithManyRows D.rowList
+ src/benchmarks/Main.hs view
@@ -0,0 +1,102 @@+module Main (main) where++import Criterion+import Criterion.Main+import Hasql.Connection qualified as A+import Hasql.Decoders qualified as D+import Hasql.Pipeline qualified as E+import Hasql.Session qualified as B+import Hasql.Statement qualified as C+import Prelude++main :: IO ()+main =+  do+    connection <- acquireConnection+    connection <- case connection of+      Left err -> fail (show err)+      Right connection -> pure connection+    useConnection connection+  where+    acquireConnection =+      A.acquire mempty+    useConnection connection =+      defaultMain+        [ sessionBench "largeResultInVector" sessionWithSingleLargeResultInVector,+          sessionBench "largeResultInList" sessionWithSingleLargeResultInList,+          sessionBench "manyLargeResults" sessionWithManyLargeResults,+          sessionBench "manyLargeResultsViaPipeline" sessionWithManyLargeResultsViaPipeline,+          sessionBench "manySmallResults" sessionWithManySmallResults,+          sessionBench "manySmallResultsViaPipeline" sessionWithManySmallResultsViaPipeline+        ]+      where+        sessionBench :: (NFData a) => String -> B.Session a -> Benchmark+        sessionBench name session =+          bench name (nfIO (A.use connection session >>= either (fail . show) pure))++-- * Sessions++sessionWithSingleLargeResultInVector :: B.Session (Vector (Int32, Int32))+sessionWithSingleLargeResultInVector =+  B.statement () statementWithManyRowsInVector++sessionWithSingleLargeResultInList :: B.Session [(Int32, Int32)]+sessionWithSingleLargeResultInList =+  B.statement () statementWithManyRowsInList++sessionWithManyLargeResults :: B.Session [Vector (Int32, Int32)]+sessionWithManyLargeResults =+  replicateM 100 (B.statement () statementWithManyRowsInVector)++sessionWithManySmallResults :: B.Session [(Int32, Int32)]+sessionWithManySmallResults =+  replicateM 100 (B.statement () statementWithSingleRow)++sessionWithManyLargeResultsViaPipeline :: B.Session [Vector (Int32, Int32)]+sessionWithManyLargeResultsViaPipeline =+  B.pipeline (replicateM 100 (E.statement () statementWithManyRowsInVector))++sessionWithManySmallResultsViaPipeline :: B.Session [(Int32, Int32)]+sessionWithManySmallResultsViaPipeline =+  B.pipeline (replicateM 100 (E.statement () statementWithSingleRow))++-- * Statements++statementWithSingleRow :: C.Statement () (Int32, Int32)+statementWithSingleRow =+  C.preparable template encoder decoder+  where+    template =+      "SELECT 1, 2"+    encoder =+      conquer+    decoder =+      D.singleRow row+      where+        row =+          tuple <$> (D.column . D.nonNullable) D.int4 <*> (D.column . D.nonNullable) D.int4+          where+            tuple !a !b =+              (a, b)++statementWithManyRows :: (D.Row (Int32, Int32) -> D.Result result) -> C.Statement () result+statementWithManyRows decoder =+  C.preparable template encoder (decoder rowDecoder)+  where+    template =+      "SELECT generate_series(0,1000) as a, generate_series(1000,2000) as b"+    encoder =+      conquer+    rowDecoder =+      tuple <$> (D.column . D.nonNullable) D.int4 <*> (D.column . D.nonNullable) D.int4+      where+        tuple !a !b =+          (a, b)++statementWithManyRowsInVector :: C.Statement () (Vector (Int32, Int32))+statementWithManyRowsInVector =+  statementWithManyRows D.rowVector++statementWithManyRowsInList :: C.Statement () [(Int32, Int32)]+statementWithManyRowsInList =+  statementWithManyRows D.rowList
+ src/comms-tests/Hasql/Comms/Session/CleanUpAfterInterruptionSpec.hs view
@@ -0,0 +1,134 @@+module Hasql.Comms.Session.CleanUpAfterInterruptionSpec (spec) where++import Hasql.Comms.Session qualified as Session+import Hasql.Platform.Prelude+import Hasql.Pq qualified as Pq+import Test.Hspec+import TextBuilder qualified++spec :: SpecWith (Text, Word16)+spec = do+  describe "cleanUpAfterInterruption" do+    it "cleans up when in pipeline mode" \config -> do+      withConnection config \connection -> do+        -- Enter pipeline mode+        success <- Pq.enterPipelineMode connection+        success `shouldBe` True++        -- Verify we're in pipeline mode+        status <- Pq.pipelineStatus connection+        status `shouldBe` Pq.PipelineOn++        -- Run cleanup+        result <- Session.toHandler Session.cleanUpAfterInterruption connection+        result `shouldBe` Right ()++        -- Verify we're out of pipeline mode+        status <- Pq.pipelineStatus connection+        status `shouldBe` Pq.PipelineOff++    it "cleans up when in an open transaction" \config -> do+      withConnection config \connection -> do+        -- Start a transaction+        _ <- Pq.exec connection "BEGIN"++        -- Verify we're in a transaction+        transStatus <- Pq.transactionStatus connection+        transStatus `shouldBe` Pq.TransInTrans++        -- Run cleanup+        result <- Session.toHandler Session.cleanUpAfterInterruption connection+        result `shouldBe` Right ()++        -- Verify transaction was aborted (idle state)+        transStatus <- Pq.transactionStatus connection+        transStatus `shouldBe` Pq.TransIdle++    it "cleans up when in error state within transaction" \config -> do+      withConnection config \connection -> do+        -- Start a transaction+        _ <- Pq.exec connection "BEGIN"++        -- Cause an error+        _ <- Pq.exec connection "SELECT * FROM nonexistent_table"++        -- Verify we're in error state+        transStatus <- Pq.transactionStatus connection+        transStatus `shouldBe` Pq.TransInError++        -- Run cleanup+        result <- Session.toHandler Session.cleanUpAfterInterruption connection+        result `shouldBe` Right ()++        -- Verify transaction was aborted (idle state)+        transStatus <- Pq.transactionStatus connection+        transStatus `shouldBe` Pq.TransIdle++    it "cleans up with pending results" \config -> do+      withConnection config \connection -> do+        -- Send a query without retrieving results+        success <- Pq.sendQuery connection "SELECT 1"+        success `shouldBe` True++        -- Run cleanup (should drain results)+        result <- Session.toHandler Session.cleanUpAfterInterruption connection+        result `shouldBe` Right ()++        -- Verify connection is in idle state+        transStatus <- Pq.transactionStatus connection+        transStatus `shouldBe` Pq.TransIdle++    it "cleans up with prepared statements" \config -> do+      withConnection config \connection -> do+        -- Create a prepared statement+        mResult <- Pq.prepare connection "test_stmt" "SELECT $1::int" Nothing+        case mResult of+          Just _ -> pure ()+          Nothing -> expectationFailure "Expected result from prepare"++        -- Consume any remaining results+        _ <- Pq.getResult connection++        -- Verify the prepared statement exists by using it+        _ <- Pq.execPrepared connection "test_stmt" [Just ("42", Pq.Text)] Pq.Text++        -- Run cleanup (should deallocate all statements)+        cleanupResult <- Session.toHandler Session.cleanUpAfterInterruption connection+        cleanupResult `shouldBe` Right ()++        -- Try to execute the prepared statement - it should fail now+        mResult2 <- Pq.execPrepared connection "test_stmt" [Just ("42", Pq.Text)] Pq.Text+        case mResult2 of+          Just result -> do+            status <- Pq.resultStatus result+            -- Should get an error status because the statement was deallocated+            status `shouldBe` Pq.FatalError+          Nothing -> expectationFailure "Expected error result from exec prepared after deallocation"++-- * Helpers++withConnection :: (Text, Word16) -> (Pq.Connection -> IO a) -> IO a+withConnection (host, port) action =+  let connectionString =+        (encodeUtf8 . TextBuilder.toText . mconcat)+          [ "host=",+            TextBuilder.text host,+            " port=",+            TextBuilder.decimal port,+            " user=postgres",+            " password=postgres",+            " dbname=postgres"+          ]+   in bracket+        (Pq.connectdb connectionString)+        ( \connection -> do+            Pq.finish connection+        )+        ( \connection -> do+            status <- Pq.status connection+            case status of+              Pq.ConnectionOk -> action connection+              _ -> do+                errorMessage <- Pq.errorMessage connection+                fail ("Connection failed: " <> show errorMessage)+        )
+ src/comms-tests/Hasql/Comms/SpecHook.hs view
@@ -0,0 +1,25 @@+-- Docs: https://hspec.github.io/hspec-discover.html+module Hasql.Comms.SpecHook where++import Hasql.Platform.Prelude+import Test.Hspec+import TestcontainersPostgresql qualified++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/comms-tests/Main.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ src/engine-tests/Hasql/Engine/Structures/OidCacheSpec.hs view
@@ -0,0 +1,116 @@+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 view
@@ -0,0 +1,94 @@+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 view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ src/library-tests/Helpers/Dsls/Execution.hs view
@@ -0,0 +1,40 @@+module Helpers.Dsls.Execution+  ( Session,+    sessionByParams,+    Pipeline,+    pipelineByParams,+    generateVarname,+  )+where++import Hasql.Pipeline (Pipeline)+import Hasql.Pipeline qualified as Pipeline+import Hasql.Session (Session)+import Hasql.Session qualified as Session+import Helpers.Dsls.Statement qualified as StatementDsl+import System.Random.Stateful qualified as Random+import TextBuilder qualified+import Prelude++sessionByParams ::+  (StatementDsl.StatementModule params result) =>+  params -> Session result+sessionByParams = Session.pipeline . pipelineByParams++pipelineByParams ::+  (StatementDsl.StatementModule params result) =>+  params -> Pipeline result+pipelineByParams params = Pipeline.statement params StatementDsl.statement++generateVarname :: IO Text+generateVarname = do+  uniqueNum1 <- Random.uniformWord64 Random.globalStdGen+  uniqueNum2 <- Random.uniformWord64 Random.globalStdGen+  pure+    $ TextBuilder.toText+    $ mconcat+    $ [ "testing.v",+        TextBuilder.decimal uniqueNum1,+        "v",+        TextBuilder.decimal uniqueNum2+      ]
+ src/library-tests/Helpers/Dsls/Statement.hs view
@@ -0,0 +1,6 @@+module Helpers.Dsls.Statement where++import Hasql.Statement qualified as Statement++class StatementModule params result | params -> result where+  statement :: Statement.Statement params result
+ src/library-tests/Helpers/Scripts.hs view
@@ -0,0 +1,62 @@+module Helpers.Scripts where++import Hasql.Connection qualified as Connection+import Hasql.Connection.Settings qualified as Settings+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)++onPreparableConnection :: ScopeParams -> (Connection.Connection -> IO a) -> IO a+onPreparableConnection = onConnection False++onUnpreparableConnection :: ScopeParams -> (Connection.Connection -> IO a) -> IO a+onUnpreparableConnection = onConnection True++onConnection :: Bool -> ScopeParams -> (Connection.Connection -> IO a) -> IO a+onConnection unpreparable (host, port) =+  bracket+    ( do+        let settings =+              mconcat+                [ Settings.hostAndPort host (fromIntegral port),+                  Settings.user "postgres",+                  Settings.password "postgres",+                  Settings.dbname "postgres",+                  Settings.noPreparedStatements unpreparable+                ]+        res <- Connection.acquire settings+        case res of+          Left err -> fail ("Connection failed: " <> show err)+          Right conn -> pure conn+    )+    Connection.release++-- | Generate a unique name of the following pattern:+--+-- > <prefix><uniqueNum1><infix><uniqueNum2><suffix>+generateName :: Text -> Text -> Text -> IO Text+generateName prefix infix_ suffix = do+  uniqueNum1 <- Random.uniformWord64 Random.globalStdGen+  uniqueNum2 <- Random.uniformWord64 Random.globalStdGen+  pure+    $ TextBuilder.toText+    $ mconcat+    $ [ TextBuilder.text prefix,+        TextBuilder.decimal uniqueNum1,+        TextBuilder.text infix_,+        TextBuilder.decimal uniqueNum2,+        TextBuilder.text suffix+      ]++generateVarname :: IO Text+generateVarname = do+  generateName "testing.v" "v" ""++generateSymname :: IO Text+generateSymname =+  generateName "test_" "_" ""
+ src/library-tests/Helpers/Statements.hs view
@@ -0,0 +1,22 @@+module Helpers.Statements+  ( module Helpers.Statements.BrokenSyntax,+    module Helpers.Statements.CountPreparedStatements,+    module Helpers.Statements.CurrentSetting,+    module Helpers.Statements.GenerateSeries,+    module Helpers.Statements.SelectOne,+    module Helpers.Statements.SelectProvidedInt8,+    module Helpers.Statements.SetConfig,+    module Helpers.Statements.Sleep,+    module Helpers.Statements.WrongDecoder,+  )+where++import Helpers.Statements.BrokenSyntax+import Helpers.Statements.CountPreparedStatements+import Helpers.Statements.CurrentSetting+import Helpers.Statements.GenerateSeries+import Helpers.Statements.SelectOne+import Helpers.Statements.SelectProvidedInt8+import Helpers.Statements.SetConfig+import Helpers.Statements.Sleep+import Helpers.Statements.WrongDecoder
+ src/library-tests/Helpers/Statements/BrokenSyntax.hs view
@@ -0,0 +1,28 @@+module Helpers.Statements.BrokenSyntax where++import Data.Int+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Statement qualified as Statement+import Helpers.Dsls.Statement+import Prelude++data BrokenSyntax = BrokenSyntax+  { start :: Int64,+    end :: Int64+  }++type BrokenSyntaxResult = [Int64]++instance StatementModule BrokenSyntax BrokenSyntaxResult where+  statement =+    Statement.preparable+      "S"+      ( mconcat+          [ start >$< Encoders.param (Encoders.nonNullable Encoders.int8),+            end >$< Encoders.param (Encoders.nonNullable Encoders.int8)+          ]+      )+      ( Decoders.rowList+          (Decoders.column (Decoders.nonNullable Decoders.int8))+      )
+ src/library-tests/Helpers/Statements/CountPreparedStatements.hs view
@@ -0,0 +1,17 @@+module Helpers.Statements.CountPreparedStatements where++import Hasql.Decoders qualified as Decoders+import Hasql.Statement qualified as Statement+import Helpers.Dsls.Statement+import Prelude++data CountPreparedStatements = CountPreparedStatements++type CountPreparedStatementsResult = Int32++instance StatementModule CountPreparedStatements CountPreparedStatementsResult where+  statement =+    Statement.unpreparable+      "select count(*)::int4 from pg_prepared_statements"+      mempty+      (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))
+ src/library-tests/Helpers/Statements/CurrentSetting.hs view
@@ -0,0 +1,31 @@+module Helpers.Statements.CurrentSetting where++import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Statement qualified as Statement+import Helpers.Dsls.Statement+import Prelude++data CurrentSetting = CurrentSetting+  { name :: Text,+    missingOk :: Bool+  }++type CurrentSettingResult = Maybe Text++instance StatementModule CurrentSetting CurrentSettingResult where+  statement =+    Statement.preparable sql encoder decoder+    where+      sql =+        "SELECT current_setting($1, $2)"++      encoder =+        mconcat+          [ name >$< Encoders.param (Encoders.nonNullable Encoders.text),+            missingOk >$< Encoders.param (Encoders.nonNullable Encoders.bool)+          ]++      decoder =+        Decoders.singleRow+          (Decoders.column (Decoders.nullable Decoders.text))
+ src/library-tests/Helpers/Statements/GenerateSeries.hs view
@@ -0,0 +1,26 @@+module Helpers.Statements.GenerateSeries where++import Data.Int+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Statement qualified as Statement+import Helpers.Dsls.Statement+import Prelude++data GenerateSeries = GenerateSeries+  { start :: Int64,+    end :: Int64+  }++type GenerateSeriesResult = [Int64]++instance StatementModule GenerateSeries GenerateSeriesResult where+  statement =+    Statement.preparable+      "SELECT generate_series($1, $2)"+      ( (contramap start (Encoders.param (Encoders.nonNullable Encoders.int8)))+          <> (contramap end (Encoders.param (Encoders.nonNullable Encoders.int8)))+      )+      ( Decoders.rowList+          (Decoders.column (Decoders.nonNullable Decoders.int8))+      )
+ src/library-tests/Helpers/Statements/SelectOne.hs view
@@ -0,0 +1,17 @@+module Helpers.Statements.SelectOne where++import Hasql.Decoders qualified as Decoders+import Hasql.Statement qualified as Statement+import Helpers.Dsls.Statement+import Prelude++data SelectOne = SelectOne++type SelectOneResult = Int32++instance StatementModule SelectOne SelectOneResult where+  statement =+    Statement.preparable+      "select 1"+      mempty+      (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))
+ src/library-tests/Helpers/Statements/SelectProvidedInt8.hs view
@@ -0,0 +1,20 @@+module Helpers.Statements.SelectProvidedInt8 where++import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Statement qualified as Statement+import Helpers.Dsls.Statement+import Prelude++data SelectProvidedInt8 = SelectProvidedInt8+  { value :: Int64+  }++type SelectProvidedInt8Result = Int64++instance StatementModule SelectProvidedInt8 SelectProvidedInt8Result where+  statement =+    Statement.preparable+      "select $1"+      (value >$< Encoders.param (Encoders.nonNullable Encoders.int8))+      (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))
+ src/library-tests/Helpers/Statements/SetConfig.hs view
@@ -0,0 +1,32 @@+module Helpers.Statements.SetConfig where++import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Statement qualified as Statement+import Helpers.Dsls.Statement+import Prelude hiding (local)++data SetConfig = SetConfig+  { name :: Text,+    value :: Text,+    local :: Bool+  }++type SetConfigResult = ()++instance StatementModule SetConfig SetConfigResult where+  statement =+    Statement.preparable sql encoder decoder+    where+      sql =+        "SELECT set_config($1, $2, $3)"++      encoder =+        mconcat+          [ name >$< Encoders.param (Encoders.nonNullable Encoders.text),+            value >$< Encoders.param (Encoders.nonNullable Encoders.text),+            local >$< Encoders.param (Encoders.nonNullable Encoders.bool)+          ]++      decoder =+        Decoders.noResult
+ src/library-tests/Helpers/Statements/Sleep.hs view
@@ -0,0 +1,20 @@+module Helpers.Statements.Sleep where++import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Statement qualified as Statement+import Helpers.Dsls.Statement+import Prelude hiding (local)++data Sleep = Sleep+  { seconds :: Double+  }++type SleepResult = ()++instance StatementModule Sleep SleepResult where+  statement =+    Statement.preparable+      "select pg_sleep($1)"+      (seconds >$< Encoders.param (Encoders.nonNullable Encoders.float8))+      Decoders.noResult
+ src/library-tests/Helpers/Statements/WrongDecoder.hs view
@@ -0,0 +1,29 @@+module Helpers.Statements.WrongDecoder where++import Data.Int+import Data.UUID qualified+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Statement qualified as Statement+import Helpers.Dsls.Statement+import Prelude++data WrongDecoder = WrongDecoder+  { start :: Int64,+    end :: Int64+  }++type WrongDecoderResult = [Data.UUID.UUID]++instance StatementModule WrongDecoder WrongDecoderResult where+  statement =+    Statement.preparable+      "SELECT generate_series($1, $2)"+      ( mconcat+          [ start >$< Encoders.param (Encoders.nonNullable Encoders.int8),+            end >$< Encoders.param (Encoders.nonNullable Encoders.int8)+          ]+      )+      ( Decoders.rowList+          (Decoders.column (Decoders.nonNullable Decoders.uuid))+      )
+ src/library-tests/Isolated/ByUnit/Connection/AcquireSpec.hs view
@@ -0,0 +1,215 @@+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/Main.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ src/library-tests/Pure/ByUnit/ErrorsSpec.hs view
@@ -0,0 +1,247 @@+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/Sharing/ByBug/ExceptionConnectionResetRaceSpec.hs view
@@ -0,0 +1,91 @@+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/ByFeature/ConcurrencySpec.hs view
@@ -0,0 +1,39 @@+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 view
@@ -0,0 +1,57 @@+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 view
@@ -0,0 +1,196 @@+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 view
@@ -0,0 +1,243 @@+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 view
@@ -0,0 +1,58 @@+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 view
@@ -0,0 +1,45 @@+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 view
@@ -0,0 +1,166 @@+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 view
@@ -0,0 +1,85 @@+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 view
@@ -0,0 +1,165 @@+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 view
@@ -0,0 +1,777 @@+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 view
@@ -0,0 +1,286 @@+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 view
@@ -0,0 +1,194 @@+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 view
@@ -0,0 +1,302 @@+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 view
@@ -0,0 +1,27 @@+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 view
@@ -0,0 +1,114 @@+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 view
@@ -0,0 +1,72 @@+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 view
@@ -0,0 +1,23 @@+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 view
@@ -0,0 +1,85 @@+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 view
@@ -0,0 +1,259 @@+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 view
@@ -0,0 +1,36 @@+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 view
@@ -0,0 +1,40 @@+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 view
@@ -0,0 +1,67 @@+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 view
@@ -0,0 +1,193 @@+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 view
@@ -0,0 +1,807 @@+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 view
@@ -0,0 +1,341 @@+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 view
@@ -0,0 +1,151 @@+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 view
@@ -0,0 +1,315 @@+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 view
@@ -0,0 +1,141 @@+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 view
@@ -0,0 +1,74 @@+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 view
@@ -0,0 +1,33 @@+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 view
@@ -0,0 +1,63 @@+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 view
@@ -0,0 +1,33 @@+{-# 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 view
@@ -0,0 +1,50 @@+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 view
@@ -0,0 +1,176 @@+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 view
@@ -0,0 +1,33 @@+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 view
@@ -0,0 +1,59 @@+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 view
@@ -0,0 +1,79 @@+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 view
@@ -0,0 +1,38 @@+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 view
@@ -0,0 +1,111 @@+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 view
@@ -0,0 +1,25 @@+-- 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
@@ -0,0 +1,147 @@+module Hasql.Codecs.Decoders+  ( -- * Nullability+    NullableOrNot.NullableOrNot (..),+    NullableOrNot.nonNullable,+    NullableOrNot.nullable,++    -- * Value+    Value.Value (..),+    Value.bool,+    Value.int2,+    Value.int4,+    Value.int8,+    Value.float4,+    Value.float8,+    Value.numeric,+    Value.char,+    Value.text,+    Value.varchar,+    Value.bpchar,+    Value.bytea,+    Value.date,+    Value.timestamp,+    Value.timestamptz,+    Value.time,+    Value.timetz,+    Value.interval,+    Value.uuid,+    Value.inet,+    Value.macaddr,+    Value.json,+    Value.jsonBytes,+    Value.jsonb,+    Value.jsonbBytes,+    Value.int4range,+    Value.int8range,+    Value.numrange,+    Value.tsrange,+    Value.tstzrange,+    Value.daterange,+    Value.int4multirange,+    Value.int8multirange,+    Value.nummultirange,+    Value.tsmultirange,+    Value.tstzmultirange,+    Value.datemultirange,+    Value.citext,+    array,+    listArray,+    vectorArray,+    composite,+    record,+    Value.hstore,+    Value.enum,+    Value.custom,+    Value.refine,++    -- * Array+    Array.Array,+    Array.dimension,+    Array.element,++    -- * Composite+    Composite.Composite (..),+    Composite.field,+  )+where++import Data.Vector.Generic qualified as GenericVector+import Hasql.Codecs.Decoders.Array qualified as Array+import Hasql.Codecs.Decoders.Composite qualified as Composite+import Hasql.Codecs.Decoders.NullableOrNot qualified as NullableOrNot+import Hasql.Codecs.Decoders.Value qualified as Value+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo+import Hasql.Platform.Prelude++-- * Value++-- |+-- Lift an 'Array.Array' decoder to a 'Value.Value' decoder.+{-# INLINEABLE array #-}+array :: Array.Array a -> Value.Value a+array decoder = Value.Value (Array.toSchema decoder) (Array.toTypeName decoder) (Array.toBaseOid decoder) (Array.toArrayOid decoder) (Array.toDimensionality decoder) (Array.toValueDecoder decoder)++-- |+-- Lift a value decoder of element into a unidimensional array decoder producing a list.+--+-- This function is merely a shortcut to the following expression:+--+-- @+-- ('array' . 'dimension' Control.Monad.'replicateM' . 'element')+-- @+--+-- Please notice that in case of multidimensional arrays nesting 'listArray' decoder+-- won't work. You have to explicitly construct the array decoder using 'array'.+{-# INLINE listArray #-}+listArray :: NullableOrNot.NullableOrNot Value.Value element -> Value.Value [element]+listArray = array . Array.dimension replicateM . Array.element++-- |+-- Lift a value decoder of element into a unidimensional array decoder producing a generic vector.+--+-- This function is merely a shortcut to the following expression:+--+-- @+-- ('array' . 'dimension' Data.Vector.Generic.'GenericVector.replicateM' . 'element')+-- @+--+-- Please notice that in case of multidimensional arrays nesting 'vectorArray' decoder+-- won't work. You have to explicitly construct the array decoder using 'array'.+{-# INLINE vectorArray #-}+vectorArray :: (GenericVector.Vector vector element) => NullableOrNot.NullableOrNot Value.Value element -> Value.Value (vector element)+vectorArray = array . Array.dimension GenericVector.replicateM . Array.element++-- |+-- Lift a 'Composite.Composite' decoder to a 'Value.Value' decoder for named composite types.+--+-- This function is for named composite types where the type name is known.+-- For anonymous composite types (like those created with ROW constructor),+-- use 'record' instead.+{-# INLINEABLE composite #-}+composite :: Maybe Text -> Text -> Composite.Composite a -> Value.Value a+composite schema typeName composite =+  Value.Value+    schema+    typeName+    Nothing+    Nothing+    0+    (Composite.toValueDecoder composite)++-- |+-- Lift a 'Composite.Composite' decoder to a 'Value.Value' decoder for unnamed composite types.+--+-- This is useful for decoding anonymous composites (like those created with ROW constructor)+-- where no type name is required. Postgres will handle the type automatically.+{-# INLINEABLE record #-}+record :: Composite.Composite a -> Value.Value a+record composite =+  Value.Value+    Nothing+    "record"+    (Just (Vocab.TypeInfo.toBaseOid typeInfo))+    (Just (Vocab.TypeInfo.toArrayOid typeInfo))+    0+    (Composite.toValueDecoder composite)+  where+    typeInfo = Vocab.TypeInfo.record
+ src/library/Hasql/Codecs/Decoders/Array.hs view
@@ -0,0 +1,139 @@+module Hasql.Codecs.Decoders.Array+  ( Array,+    toValueDecoder,+    toTypeSig,+    toSchema,+    toTypeName,+    toBaseOid,+    toArrayOid,+    toDimensionality,+    dimension,+    element,+  )+where++import Hasql.Codecs.Decoders.NullableOrNot qualified as NullableOrNot+import Hasql.Codecs.Decoders.Value qualified as Value+import Hasql.Codecs.RequestingOid qualified as RequestingOid+import Hasql.Platform.Prelude+import PostgreSQL.Binary.Decoding qualified as Binary+import TextBuilder qualified++-- |+-- Binary generic array decoder.+--+-- Here's how you can use it to produce a specific array value decoder:+--+-- @+-- x :: 'Value.Value' [[Text]]+-- x = 'array' ('dimension' 'replicateM' ('dimension' 'replicateM' ('element' ('nonNullable' 'text'))))+-- @+data Array a+  = Array+      -- | Schema name.+      (Maybe Text)+      -- | Type name for the array element.+      Text+      -- | Statically known OID for the base (element) type.+      (Maybe Word32)+      -- | Statically known OID for the array type.+      (Maybe Word32)+      -- | Number of dimensions.+      Word+      -- | Decoding function+      (RequestingOid.RequestingOid (Binary.Array a))+  deriving (Functor)++{-# INLINE toValueDecoder #-}+toValueDecoder :: Array a -> RequestingOid.RequestingOid (Binary.Value a)+toValueDecoder (Array _ _ _ _ _ decoder) =+  fmap Binary.array decoder++-- | Get the type signature for the array based on element type name+{-# INLINE toTypeSig #-}+toTypeSig :: Array a -> Text+toTypeSig (Array schemaName elementTypeName _ _ ndims _) =+  TextBuilder.toText+    ( mconcat+        ( mconcat+            [ foldMap+                (\s -> [TextBuilder.text s, TextBuilder.char '.'])+                schemaName,+              [ TextBuilder.text elementTypeName+              ],+              replicate+                (fromIntegral ndims)+                (TextBuilder.text "[]")+            ]+        )+    )++toSchema :: Array a -> Maybe Text+toSchema (Array schema _ _ _ _ _) = schema++-- | Get the type name for the array based on element type name+{-# INLINE toTypeName #-}+toTypeName :: Array a -> Text+toTypeName (Array _ elementTypeName _ _ _ _) =+  elementTypeName++-- | Get the base OID if statically known+{-# INLINE toBaseOid #-}+toBaseOid :: Array a -> Maybe Word32+toBaseOid (Array _ _ baseOid _ _ _) = baseOid++-- | Get the array OID if statically known+{-# INLINE toArrayOid #-}+toArrayOid :: Array a -> Maybe Word32+toArrayOid (Array _ _ _ arrayOid _ _) = arrayOid++-- | Get the dimensionality of the array+{-# INLINE toDimensionality #-}+toDimensionality :: Array a -> Word+toDimensionality (Array _ _ _ _ ndims _) = ndims++-- * Public API++-- |+-- Binary function for parsing a dimension of an array.+-- Provides support for multi-dimensional arrays.+--+-- Accepts:+--+-- * An implementation of the @replicateM@ function+-- (@Control.Monad.'Control.Monad.replicateM'@, @Data.Vector.'Data.Vector.replicateM'@),+-- which determines the output value.+--+-- * Binary decoder of its components, which can be either another 'dimension' or 'element'.+{-# INLINEABLE dimension #-}+dimension :: (forall m. (Monad m) => Int -> m a -> m b) -> Array a -> Array b+dimension replicateM (Array schema typeName baseOid arrayOid ndims decoder) =+  Array+    schema+    typeName+    baseOid+    arrayOid+    (succ ndims)+    (fmap (Binary.dimensionArray replicateM) decoder)++-- |+-- Lift a 'Value.Value' decoder into an 'Array' decoder for parsing of leaf values.+{-# INLINEABLE element #-}+element :: NullableOrNot.NullableOrNot Value.Value a -> Array a+element = \case+  NullableOrNot.NonNullable imp ->+    Array+      (Value.toSchema imp)+      (Value.toTypeName imp)+      (Value.toBaseOid imp)+      (Value.toArrayOid imp)+      1+      (fmap Binary.valueArray (Value.toDecoder imp))+  NullableOrNot.Nullable imp ->+    Array+      (Value.toSchema imp)+      (Value.toTypeName imp)+      (Value.toBaseOid imp)+      (Value.toArrayOid imp)+      1+      (fmap Binary.nullableValueArray (Value.toDecoder imp))
+ src/library/Hasql/Codecs/Decoders/Composite.hs view
@@ -0,0 +1,52 @@+module Hasql.Codecs.Decoders.Composite where++import Hasql.Codecs.Decoders.NullableOrNot qualified as NullableOrNot+import Hasql.Codecs.Decoders.Value qualified as Value+import Hasql.Codecs.RequestingOid qualified as RequestingOid+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo+import Hasql.Platform.Prelude+import PostgreSQL.Binary.Decoding qualified as Binary++-- |+-- Composable decoder of composite values (rows, records).+newtype Composite a+  = Composite (RequestingOid.RequestingOid (Binary.Composite a))+  deriving+    (Functor, Applicative)+    via (Compose RequestingOid.RequestingOid Binary.Composite)++toValueDecoder :: Composite a -> RequestingOid.RequestingOid (Binary.Value a)+toValueDecoder (Composite imp) =+  fmap Binary.composite imp++-- |+-- Lift a 'Value.Value' decoder into a 'Composite' decoder for parsing of component values.+field :: NullableOrNot.NullableOrNot Value.Value a -> Composite a+field = \case+  NullableOrNot.NonNullable imp ->+    let dimensionality = Value.toDimensionality imp+        staticOid = if dimensionality == 0 then Value.toBaseOid imp else Value.toArrayOid imp+     in case staticOid of+          Just oid ->+            Composite (fmap (Binary.typedValueComposite oid) (Value.toDecoder imp))+          Nothing ->+            Composite+              ( RequestingOid.hoistLookingUp+                  (Vocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema imp) (Value.toTypeName imp))+                  (\typeInfo decoder -> Binary.typedValueComposite (if dimensionality == 0 then Vocab.TypeInfo.toBaseOid typeInfo else Vocab.TypeInfo.toArrayOid typeInfo) decoder)+                  (Value.toDecoder imp)+              )+  NullableOrNot.Nullable imp ->+    let dimensionality = Value.toDimensionality imp+        staticOid = if dimensionality == 0 then Value.toBaseOid imp else Value.toArrayOid imp+     in case staticOid of+          Just oid ->+            Composite (fmap (Binary.typedNullableValueComposite oid) (Value.toDecoder imp))+          Nothing ->+            Composite+              ( RequestingOid.hoistLookingUp+                  (Vocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema imp) (Value.toTypeName imp))+                  (\typeInfo decoder -> Binary.typedNullableValueComposite (if dimensionality == 0 then Vocab.TypeInfo.toBaseOid typeInfo else Vocab.TypeInfo.toArrayOid typeInfo) decoder)+                  (Value.toDecoder imp)+              )
+ src/library/Hasql/Codecs/Decoders/NullableOrNot.hs view
@@ -0,0 +1,27 @@+module Hasql.Codecs.Decoders.NullableOrNot+  ( -- * Nullability+    NullableOrNot (..),+    nonNullable,+    nullable,+  )+where++import Hasql.Platform.Prelude++-- * Nullability++-- |+-- Extensional specification of nullability over a generic decoder.+data NullableOrNot decoder a where+  NonNullable :: decoder a -> NullableOrNot decoder a+  Nullable :: decoder a -> NullableOrNot decoder (Maybe a)++-- |+-- Specify that a decoder produces a non-nullable value.+nonNullable :: decoder a -> NullableOrNot decoder a+nonNullable = NonNullable++-- |+-- Specify that a decoder produces a nullable value.+nullable :: decoder a -> NullableOrNot decoder (Maybe a)+nullable = Nullable
+ src/library/Hasql/Codecs/Decoders/Value.hs view
@@ -0,0 +1,461 @@+module Hasql.Codecs.Decoders.Value+  ( Value (..),+    bool,+    int2,+    int4,+    int8,+    float4,+    float8,+    numeric,+    char,+    text,+    varchar,+    bpchar,+    bytea,+    date,+    timestamp,+    timestamptz,+    time,+    timetz,+    interval,+    uuid,+    inet,+    macaddr,+    json,+    jsonBytes,+    jsonb,+    jsonbBytes,+    int4range,+    int8range,+    numrange,+    tsrange,+    tstzrange,+    daterange,+    int4multirange,+    int8multirange,+    nummultirange,+    tsmultirange,+    tstzmultirange,+    datemultirange,+    citext,+    custom,+    refine,+    hstore,+    enum,+    toDimensionality,+    toDecoder,+    toSchema,+    toTypeName,+    toOid,+    toBaseOid,+    toArrayOid,+    toHandler,+    toByteStringParser,+    isArray,+  )+where++import Data.Aeson qualified as Aeson+import Data.IP qualified as Iproute+import Hasql.Codecs.RequestingOid qualified as RequestingOid+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo+import Hasql.Platform.Prelude hiding (bool)+import PostgreSQL.Binary.Decoding qualified as Binary+import PostgreSQL.Binary.Range qualified as R++-- |+-- Value decoder.+data Value a+  = Value+      -- | Schema name.+      (Maybe Text)+      -- | Type name.+      Text+      -- | Statically known OID for the type.+      (Maybe Word32)+      -- | Statically known OID for the array-type with this type as the element.+      (Maybe Word32)+      -- | Dimensionality. If 0 then it is a scalar value, otherwise it is an array with that many dimensions.+      Word+      -- | Decoding function on a registry of OIDs by type name.+      (RequestingOid.RequestingOid (Binary.Value a))+  deriving (Functor)++type role Value representational++instance Filterable Value where+  {-# INLINE mapMaybe #-}+  mapMaybe fn =+    refine (maybe (Left "Invalid value") Right . fn)++-- |+-- Create a decoder from TypeInfo metadata and a decoding function.+{-# INLINE primitive #-}+primitive :: Text -> Vocab.TypeInfo.TypeInfo -> Binary.Value a -> Value a+primitive typeName pti decoder =+  Value Nothing typeName (Just (Vocab.TypeInfo.toBaseOid pti)) (Just (Vocab.TypeInfo.toArrayOid pti)) 0 (RequestingOid.lift decoder)++-- * Static types++-- |+-- Decoder of the @BOOL@ values.+{-# INLINEABLE bool #-}+bool :: Value Bool+bool = primitive "bool" Vocab.TypeInfo.bool Binary.bool++-- |+-- Decoder of the @INT2@ values.+{-# INLINEABLE int2 #-}+int2 :: Value Int16+int2 = primitive "int2" Vocab.TypeInfo.int2 Binary.int++-- |+-- Decoder of the @INT4@ values.+{-# INLINEABLE int4 #-}+int4 :: Value Int32+int4 = primitive "int4" Vocab.TypeInfo.int4 Binary.int++-- |+-- Decoder of the @INT8@ values.+{-# INLINEABLE int8 #-}+int8 :: Value Int64+int8 =+  {-# SCC "int8" #-}+  primitive "int8" Vocab.TypeInfo.int8 ({-# SCC "int8.int" #-} Binary.int)++-- |+-- Decoder of the @FLOAT4@ values.+{-# INLINEABLE float4 #-}+float4 :: Value Float+float4 = primitive "float4" Vocab.TypeInfo.float4 Binary.float4++-- |+-- Decoder of the @FLOAT8@ values.+{-# INLINEABLE float8 #-}+float8 :: Value Double+float8 = primitive "float8" Vocab.TypeInfo.float8 Binary.float8++-- |+-- Decoder of the @NUMERIC@ values.+{-# INLINEABLE numeric #-}+numeric :: Value Scientific+numeric = primitive "numeric" Vocab.TypeInfo.numeric Binary.numeric++-- |+-- Decoder of the @CHAR@ values.+-- Note that it supports Unicode values.+{-# INLINEABLE char #-}+char :: Value Char+char = primitive "char" Vocab.TypeInfo.char Binary.char++-- |+-- Decoder of the @TEXT@ values.+{-# INLINEABLE text #-}+text :: Value Text+text = primitive "text" Vocab.TypeInfo.text Binary.text_strict++-- |+-- Decoder of the @VARCHAR@ values.+{-# INLINEABLE varchar #-}+varchar :: Value Text+varchar = primitive "varchar" Vocab.TypeInfo.varchar Binary.text_strict++-- |+-- Decoder of @BPCHAR@ or @CHAR(n)@, @CHARACTER(n)@ values.+{-# INLINEABLE bpchar #-}+bpchar :: Value Text+bpchar = primitive "bpchar" Vocab.TypeInfo.bpchar Binary.text_strict++-- |+-- Decoder of the @BYTEA@ values.+{-# INLINEABLE bytea #-}+bytea :: Value ByteString+bytea = primitive "bytea" Vocab.TypeInfo.bytea Binary.bytea_strict++-- |+-- Decoder of the @DATE@ values.+{-# INLINEABLE date #-}+date :: Value Day+date = primitive "date" Vocab.TypeInfo.date Binary.date++-- |+-- Decoder of the @TIMESTAMP@ values.+{-# INLINEABLE timestamp #-}+timestamp :: Value LocalTime+timestamp = primitive "timestamp" Vocab.TypeInfo.timestamp Binary.timestamp_int++-- |+-- Decoder of the @TIMESTAMPTZ@ values.+--+-- /NOTICE/+--+-- Postgres does not store the timezone information of @TIMESTAMPTZ@.+-- Instead it stores a UTC value and performs silent conversions+-- to the currently set timezone, when dealt with in the text format.+-- However this library bypasses the silent conversions+-- and communicates with Postgres using the UTC values directly.+{-# INLINEABLE timestamptz #-}+timestamptz :: Value UTCTime+timestamptz = primitive "timestamptz" Vocab.TypeInfo.timestamptz Binary.timestamptz_int++-- |+-- Decoder of the @TIME@ values.+{-# INLINEABLE time #-}+time :: Value TimeOfDay+time = primitive "time" Vocab.TypeInfo.time Binary.time_int++-- |+-- Decoder of the @TIMETZ@ values.+--+-- Unlike in case of @TIMESTAMPTZ@,+-- Postgres does store the timezone information for @TIMETZ@.+-- However the Haskell's \"time\" library does not contain any composite type,+-- that fits the task, so we use a pair of 'TimeOfDay' and 'TimeZone'+-- to represent a value on the Haskell's side.+{-# INLINEABLE timetz #-}+timetz :: Value (TimeOfDay, TimeZone)+timetz = primitive "timetz" Vocab.TypeInfo.timetz Binary.timetz_int++-- |+-- Decoder of the @INTERVAL@ values.+{-# INLINEABLE interval #-}+interval :: Value DiffTime+interval = primitive "interval" Vocab.TypeInfo.interval Binary.interval_int++-- |+-- Decoder of the @UUID@ values.+{-# INLINEABLE uuid #-}+uuid :: Value UUID+uuid = primitive "uuid" Vocab.TypeInfo.uuid Binary.uuid++-- |+-- Decoder of the @INET@ values.+{-# INLINEABLE inet #-}+inet :: Value Iproute.IPRange+inet = primitive "inet" Vocab.TypeInfo.inet Binary.inet++-- |+-- Decoder of the @MACADDR@ values.+--+-- Represented as a 6-tuple of Word8 values in big endian order. If+-- you use `ip` library consider using it with `fromOctets`.+--+-- > (\(a,b,c,d,e,f) -> fromOctets a b c d e f) <$> macaddr+{-# INLINEABLE macaddr #-}+macaddr :: Value (Word8, Word8, Word8, Word8, Word8, Word8)+macaddr = primitive "macaddr" Vocab.TypeInfo.macaddr Binary.macaddr++-- |+-- Decoder of the @JSON@ values into a JSON AST.+{-# INLINEABLE json #-}+json :: Value Aeson.Value+json = primitive "json" Vocab.TypeInfo.json Binary.json_ast++-- |+-- Decoder of the @JSON@ values into a raw JSON 'ByteString'.+{-# INLINEABLE jsonBytes #-}+jsonBytes :: (ByteString -> Either Text a) -> Value a+jsonBytes fn = primitive "json" Vocab.TypeInfo.json (Binary.json_bytes fn)++-- |+-- Decoder of the @JSONB@ values into a JSON AST.+{-# INLINEABLE jsonb #-}+jsonb :: Value Aeson.Value+jsonb = primitive "jsonb" Vocab.TypeInfo.jsonb Binary.jsonb_ast++-- |+-- Decoder of the @JSONB@ values into a raw JSON 'ByteString'.+{-# INLINEABLE jsonbBytes #-}+jsonbBytes :: (ByteString -> Either Text a) -> Value a+jsonbBytes fn = primitive "jsonb" Vocab.TypeInfo.jsonb (Binary.jsonb_bytes fn)++-- |+-- Decoder of the @INT4RANGE@ values.+{-# INLINEABLE int4range #-}+int4range :: Value (R.Range Int32)+int4range = primitive "int4range" Vocab.TypeInfo.int4range Binary.int4range++-- |+-- Decoder of the @INT8RANGE@ values.+{-# INLINEABLE int8range #-}+int8range :: Value (R.Range Int64)+int8range = primitive "int8range" Vocab.TypeInfo.int8range Binary.int8range++-- |+-- Decoder of the @NUMRANGE@ values.+{-# INLINEABLE numrange #-}+numrange :: Value (R.Range Scientific)+numrange = primitive "numrange" Vocab.TypeInfo.numrange Binary.numrange++-- |+-- Decoder of the @TSRANGE@ values.+{-# INLINEABLE tsrange #-}+tsrange :: Value (R.Range LocalTime)+tsrange = primitive "tsrange" Vocab.TypeInfo.tsrange Binary.tsrange_int++-- |+-- Decoder of the @TSTZRANGE@ values.+{-# INLINEABLE tstzrange #-}+tstzrange :: Value (R.Range UTCTime)+tstzrange = primitive "tstzrange" Vocab.TypeInfo.tstzrange Binary.tstzrange_int++-- |+-- Decoder of the @DATERANGE@ values.+{-# INLINEABLE daterange #-}+daterange :: Value (R.Range Day)+daterange = primitive "daterange" Vocab.TypeInfo.daterange Binary.daterange++-- |+-- Decoder of the @INT4MULTIRANGE@ values.+{-# INLINEABLE int4multirange #-}+int4multirange :: Value (R.Multirange Int32)+int4multirange = primitive "int4multirange" Vocab.TypeInfo.int4multirange Binary.int4multirange++-- |+-- Decoder of the @INT8MULTIRANGE@ values.+{-# INLINEABLE int8multirange #-}+int8multirange :: Value (R.Multirange Int64)+int8multirange = primitive "int8multirange" Vocab.TypeInfo.int8multirange Binary.int8multirange++-- |+-- Decoder of the @NUMMULTIRANGE@ values.+{-# INLINEABLE nummultirange #-}+nummultirange :: Value (R.Multirange Scientific)+nummultirange = primitive "nummultirange" Vocab.TypeInfo.nummultirange Binary.nummultirange++-- |+-- Decoder of the @TSMULTIRANGE@ values.+{-# INLINEABLE tsmultirange #-}+tsmultirange :: Value (R.Multirange LocalTime)+tsmultirange = primitive "tsmultirange" Vocab.TypeInfo.tsmultirange Binary.tsmultirange_int++-- |+-- Decoder of the @TSTZMULTIRANGE@ values.+{-# INLINEABLE tstzmultirange #-}+tstzmultirange :: Value (R.Multirange UTCTime)+tstzmultirange = primitive "tstzmultirange" Vocab.TypeInfo.tstzmultirange Binary.tstzmultirange_int++-- |+-- Decoder of the @DATEMULTIRANGE@ values.+{-# INLINEABLE datemultirange #-}+datemultirange :: Value (R.Multirange Day)+datemultirange = primitive "datemultirange" Vocab.TypeInfo.datemultirange Binary.datemultirange++-- |+-- Decoder of the @CITEXT@ values.+--+-- Requires the @citext@ extension to be installed in the database.+{-# INLINEABLE citext #-}+citext :: Value Text+citext = Value Nothing "citext" Nothing Nothing 0 (RequestingOid.lift Binary.text_strict)++-- |+-- Low level API for defining custom value decoders.+{-# INLINEABLE custom #-}+custom ::+  -- | Schema name.+  Maybe Text ->+  -- | Type name.+  Text ->+  -- | Possible static OIDs for the type. The first is for scalar values the second is for arrays.+  --+  -- When unspecified, the OIDs will be automatically determined at runtime by looking up by name.+  Maybe (Word32, Word32) ->+  -- | Other named types whose OIDs are needed for deserializing.+  --+  -- E.g., when decoding composite types you can check the OIDs of its fields against the ones specified by Postgres.+  --+  -- When any of the requested types is missing in the database an error will be raised upon the statement execution.+  [(Maybe Text, Text)] ->+  -- | Deserialization function in the context of resolved OIDs of the types requested in the previous parameter.+  --+  -- It's safe to assume that all of the requested types will be present.+  -- In case you run the provided lookup function with unmentioned type names it will produce OID of 0 for them, standing for unknown type in Postgres.+  ( ((Maybe Text, Text) -> (Word32, Word32)) ->+    ByteString ->+    Either Text a+  ) ->+  Value a+custom schema typeName staticOids requestedTypes fn =+  Value+    schema+    typeName+    (fmap fst staticOids)+    (fmap snd staticOids)+    0+    (RequestingOid.requestAndHandle (fmap Vocab.QualifiedTypeName.fromNameTuple requestedTypes) (\lookup -> Binary.fn (fn (toTuple . lookup . Vocab.QualifiedTypeName.fromNameTuple))))+  where+    toTuple typeInfo = (Vocab.TypeInfo.toBaseOid typeInfo, Vocab.TypeInfo.toArrayOid typeInfo)++-- |+-- Refine a value decoder, lifting the possible error to the session level.+{-# INLINE refine #-}+refine :: (a -> Either Text b) -> Value a -> Value b+refine fn (Value schema typeName typeOid arrayOid dimensionality decoder) =+  Value schema typeName typeOid arrayOid dimensionality (fmap (Binary.refine fn) decoder)++-- |+-- Binary generic decoder of @HSTORE@ values.+--+-- Here's how you can use it to construct a specific value:+--+-- @+-- x :: Value [(Text, Maybe Text)]+-- x = hstore 'replicateM'+-- @+{-# INLINEABLE hstore #-}+hstore :: (forall m. (Monad m) => Int -> m (Text, Maybe Text) -> m a) -> Value a+hstore replicateM =+  Value Nothing "hstore" Nothing Nothing 0 (RequestingOid.lift (Binary.hstore replicateM Binary.text_strict Binary.text_strict))++-- |+-- Given a partial mapping from text to value, produces a decoder of that value for a named enum type.+enum ::+  -- | Schema name.+  Maybe Text ->+  -- | Type name.+  Text ->+  -- | Mapping from text to value.+  (Text -> Maybe a) ->+  Value a+enum schema typeName mapping =+  Value schema typeName Nothing Nothing 0 (RequestingOid.lift (Binary.enum mapping))++-- * Relations++toDimensionality :: Value a -> Word+toDimensionality (Value _ _ _ _ dimensionality _) = dimensionality++toSchema :: Value a -> Maybe Text+toSchema (Value schema _ _ _ _ _) = schema++toTypeName :: Value a -> Text+toTypeName (Value _ typeName _ _ _ _) = typeName++toOid :: Value a -> Maybe Word32+toOid (Value _ _ baseOid arrayOid dimensionality _) =+  if dimensionality > 0+    then arrayOid+    else baseOid++toBaseOid :: Value a -> Maybe Word32+toBaseOid (Value _ _ baseOid _ _ _) = baseOid++toArrayOid :: Value a -> Maybe Word32+toArrayOid (Value _ _ _ oid _ _) = oid++toDecoder :: Value a -> RequestingOid.RequestingOid (Binary.Value a)+toDecoder (Value _ _ _ _ _ decoder) = decoder++{-# INLINE toHandler #-}+toHandler :: Value a -> Vocab.OidCache -> Binary.Value a+toHandler (Value _ _ _ _ _ decoder) = RequestingOid.toBase decoder++{-# INLINE toByteStringParser #-}+toByteStringParser :: Value a -> (Vocab.OidCache -> ByteString -> Either Text a)+toByteStringParser (Value _ _ _ _ _ decoder) oidCache = Binary.valueParser (RequestingOid.toBase decoder oidCache)++isArray :: Value a -> Bool+isArray (Value _ _ _ _ dimensionality _) = dimensionality > 0
+ src/library/Hasql/Codecs/Encoders.hs view
@@ -0,0 +1,152 @@+-- |+-- A DSL for declaration of statement parameter encoders.+--+-- For compactness of names all the types defined here imply being an encoder.+-- E.g., the `Array` type is an __encoder__ of arrays, not the data-structure itself.+module Hasql.Codecs.Encoders+  ( -- * Parameters product+    Params.Params,+    Params.noParams,+    Params.param,++    -- * Nullability+    NullableOrNot.NullableOrNot,+    NullableOrNot.nonNullable,+    NullableOrNot.nullable,++    -- * Value+    Value.Value,+    Value.bool,+    Value.int2,+    Value.int4,+    Value.int8,+    Value.float4,+    Value.float8,+    Value.numeric,+    Value.char,+    Value.text,+    Value.varchar,+    Value.bpchar,+    Value.bytea,+    Value.date,+    Value.timestamp,+    Value.timestamptz,+    Value.time,+    Value.timetz,+    Value.interval,+    Value.uuid,+    Value.inet,+    Value.macaddr,+    Value.json,+    Value.jsonBytes,+    Value.jsonLazyBytes,+    Value.jsonb,+    Value.jsonbBytes,+    Value.jsonbLazyBytes,+    Value.int4range,+    Value.int8range,+    Value.numrange,+    Value.tsrange,+    Value.tstzrange,+    Value.daterange,+    Value.int4multirange,+    Value.int8multirange,+    Value.nummultirange,+    Value.tsmultirange,+    Value.tstzmultirange,+    Value.datemultirange,+    Value.citext,+    Value.name,+    Value.oid,+    foldableArray,+    array,+    Value.hstore,+    Value.enum,+    composite,+    Value.unknown,+    Value.custom,++    -- * Array+    Array.Array,+    Array.element,+    Array.dimension,++    -- * Composite+    Composite.Composite,+    Composite.field,+  )+where++import Data.HashMap.Strict qualified as HashMap+import Hasql.Codecs.Encoders.Array qualified as Array+import Hasql.Codecs.Encoders.Composite qualified as Composite+import Hasql.Codecs.Encoders.NullableOrNot qualified as NullableOrNot+import Hasql.Codecs.Encoders.Params qualified as Params+import Hasql.Codecs.Encoders.Value qualified as Value+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo+import Hasql.Platform.Prelude hiding (bool)+import PostgreSQL.Binary.Encoding qualified as Binary+import TextBuilder qualified++-- * Recursive definitions++-- |+-- Lift a value encoder of element into a unidimensional array encoder of a foldable value.+--+-- This function is merely a shortcut to the following expression:+--+-- @+-- ('array' . 'Array.dimension' 'foldl'' . 'Array.element')+-- @+--+-- You can use it like this:+--+-- @+-- vectorOfInts :: Value (Vector Int64)+-- vectorOfInts = 'foldableArray' ('nonNullable' 'int8')+-- @+--+-- Please notice that in case of multidimensional arrays nesting 'foldableArray' encoder+-- won't work. You have to explicitly construct the array encoder using 'array'.+{-# INLINE foldableArray #-}+foldableArray :: (Foldable foldable) => NullableOrNot.NullableOrNot Value.Value element -> Value.Value (foldable element)+foldableArray = array . Array.dimension foldl' . Array.element++-- |+-- Lift an array encoder into a value encoder.+array :: Array.Array a -> Value.Value a+array (Array.Array baseTypeSchema baseTypeName _isText dimensionality scalarOidIfKnown arrayOidIfKnown unknownTypes arrayEncoder renderer) =+  let encoder oidCache input =+        let resolvedOid =+              asum+                [ scalarOidIfKnown,+                  oidCache+                    & HashMap.lookup (Vocab.QualifiedTypeName.QualifiedTypeName baseTypeSchema baseTypeName)+                    & fmap Vocab.TypeInfo.toBaseOid+                ]+                -- Should only happen on a bug.+                & fromMaybe (Vocab.TypeInfo.toBaseOid Vocab.TypeInfo.unknown)+         in Binary.array resolvedOid (arrayEncoder oidCache input)+   in Value.Value baseTypeSchema baseTypeName scalarOidIfKnown arrayOidIfKnown dimensionality False unknownTypes encoder renderer++-- |+-- Lift a composite encoder into a value encoder for named composite types.+--+-- This function is for named composite types where the type name is known.+-- If you need to encode an anonymous composite type (like those created with the ROW constructor),+-- PostgreSQL itself does not support that.+composite ::+  -- | Schema name where the composite type is defined.+  Maybe Text ->+  -- | Composite type name.+  Text ->+  Composite.Composite a ->+  Value.Value a+composite schema name (Composite.Composite unknownTypes encode print) =+  Value.Value schema name Nothing Nothing 0 False unknownTypes encodeValue printValue+  where+    encodeValue oidCache val =+      Binary.composite (encode oidCache val)+    printValue val =+      "ROW (" <> TextBuilder.intercalate ", " (print val) <> ")"
+ src/library/Hasql/Codecs/Encoders/Array.hs view
@@ -0,0 +1,104 @@+module Hasql.Codecs.Encoders.Array where++import Hasql.Codecs.Encoders.NullableOrNot qualified as NullableOrNot+import Hasql.Codecs.Encoders.Value qualified as Value+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Platform.Prelude+import PostgreSQL.Binary.Encoding qualified as Binary+import TextBuilder qualified as TextBuilder++-- |+-- Generic array encoder.+--+-- Here's an example of its usage:+--+-- @+-- someParamsEncoder :: 'Params' [[Int64]]+-- someParamsEncoder = 'param' ('nonNullable' ('array' ('dimension' 'foldl'' ('dimension' 'foldl'' ('element' ('nonNullable' 'int8'))))))+-- @+--+-- Please note that the PostgreSQL @IN@ keyword does not accept an array, but rather a syntactical list of+-- values, thus this encoder is not suited for that. Use a @value = ANY($1)@ condition instead.+data Array a+  = Array+      -- | Schema name, if any.+      (Maybe Text)+      -- | Type name.+      Text+      -- | Text format?+      Bool+      -- | Dimensionality. If 0 then it is not an array, but a scalar value.+      Word+      -- | OID of the element type.+      (Maybe Word32)+      -- | OID of the array type.+      (Maybe Word32)+      -- | Names of types that are not known statically and must be looked up at runtime collected from the nested composite and array encoders.+      (HashSet Vocab.QualifiedTypeName)+      -- | Serialization function given the dictionary of resolved OIDs.+      (HashMap Vocab.QualifiedTypeName Vocab.TypeInfo -> a -> Binary.Array)+      -- | Render function for error messages.+      (a -> TextBuilder.TextBuilder)++instance Contravariant Array where+  contramap fn (Array schemaName typeName textFormat dimensionality valueOid arrayOid unknownTypes elEncoder elRenderer) =+    Array schemaName typeName textFormat dimensionality valueOid arrayOid unknownTypes (\oidCache -> elEncoder oidCache . fn) (elRenderer . fn)++-- |+-- Lifts a 'Value.Value' encoder into an 'Array' encoder.+element :: NullableOrNot.NullableOrNot Value.Value a -> Array a+element = \case+  NullableOrNot.NonNullable (Value.Value schemaName typeName scalarOid arrayOid dimensionality textFormat unknownTypes serialize print) ->+    Array+      schemaName+      typeName+      textFormat+      dimensionality+      scalarOid+      arrayOid+      unknownTypes+      (\oidCache -> Binary.encodingArray . serialize oidCache)+      print+  NullableOrNot.Nullable (Value.Value schemaName typeName scalarOid arrayOid dimensionality textFormat unknownTypes serialize print) ->+    let maybeSerialize oidCache =+          maybe Binary.nullArray (Binary.encodingArray . serialize oidCache)+        maybePrint =+          maybe (TextBuilder.string "null") print+     in Array+          schemaName+          typeName+          textFormat+          dimensionality+          scalarOid+          arrayOid+          unknownTypes+          maybeSerialize+          maybePrint++-- |+-- Encoder of an array dimension,+-- which thus provides support for multidimensional arrays.+--+-- Accepts:+--+-- * An implementation of the left-fold operation,+-- such as @Data.Foldable.'foldl''@,+-- which determines the input value.+--+-- * A component encoder, which can be either another 'dimension' or 'element'.+{-# INLINE dimension #-}+dimension :: (forall a. (a -> b -> a) -> a -> c -> a) -> Array b -> Array c+dimension fold (Array schemaName typeName textFormat dimensionality valueOid arrayOid unknownTypes elEncoder elRenderer) =+  let encoder oidCache =+        Binary.dimensionArray fold (elEncoder oidCache)+      renderer els =+        let folded =+              let step builder el =+                    if TextBuilder.isEmpty builder+                      then TextBuilder.char '[' <> elRenderer el+                      else builder <> TextBuilder.string ", " <> elRenderer el+               in fold step mempty els+         in if TextBuilder.isEmpty folded+              then TextBuilder.string "[]"+              else folded <> TextBuilder.char ']'+   in Array schemaName typeName textFormat (succ dimensionality) valueOid arrayOid unknownTypes encoder renderer
+ src/library/Hasql/Codecs/Encoders/Composite.hs view
@@ -0,0 +1,97 @@+module Hasql.Codecs.Encoders.Composite where++import Data.HashMap.Strict qualified as HashMap+import Data.HashSet qualified as HashSet+import Hasql.Codecs.Encoders.NullableOrNot qualified as NullableOrNot+import Hasql.Codecs.Encoders.Value qualified as Value+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo+import Hasql.Platform.Prelude hiding (bool)+import PostgreSQL.Binary.Encoding qualified as Binary+import TextBuilder qualified++-- |+-- Composite or row-types encoder.+data Composite a+  = Composite+      -- | Names of types that are not known statically and must be looked up at runtime collected from the nested composite and array encoders.+      (HashSet Vocab.QualifiedTypeName)+      -- | Serialization function given the dictionary of resolved OIDs.+      (HashMap Vocab.QualifiedTypeName Vocab.TypeInfo -> a -> Binary.Composite)+      -- | Render function for error messages.+      (a -> [TextBuilder.TextBuilder])++instance Contravariant Composite where+  contramap f (Composite unknownTypes encode print) =+    Composite unknownTypes (\oidCache -> encode oidCache . f) (print . f)++instance Divisible Composite where+  divide f (Composite unknownTypesL encodeL printL) (Composite unknownTypesR encodeR printR) =+    Composite+      (unknownTypesL <> unknownTypesR)+      (\oidCache val -> case f val of (lVal, rVal) -> encodeL oidCache lVal <> encodeR oidCache rVal)+      (\val -> case f val of (lVal, rVal) -> printL lVal <> printR rVal)+  conquer = mempty++instance Semigroup (Composite a) where+  Composite unknownTypesL encodeL printL <> Composite unknownTypesR encodeR printR =+    Composite+      (unknownTypesL <> unknownTypesR)+      (\oidCache val -> encodeL oidCache val <> encodeR oidCache val)+      (\val -> printL val <> printR val)++instance Monoid (Composite a) where+  mempty = Composite mempty mempty mempty++-- | Single field of a row-type.+field :: NullableOrNot.NullableOrNot Value.Value a -> Composite a+field = \case+  NullableOrNot.NonNullable (Value.Value schemaName typeName scalarOid arrayOid dimensionality _ unknownTypes encode print) ->+    let staticOid = if dimensionality == 0 then scalarOid else arrayOid+     in case staticOid of+          Just oid ->+            Composite+              unknownTypes+              (\oidCache val -> Binary.field oid (encode oidCache val))+              (\val -> [print val])+          Nothing ->+            Composite+              (HashSet.insert (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes)+              ( \oidCache val ->+                  let typeInfo = HashMap.lookup (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) oidCache+                      oid = if dimensionality == 0 then maybe 0 Vocab.TypeInfo.toBaseOid typeInfo else maybe 0 Vocab.TypeInfo.toArrayOid typeInfo+                   in Binary.field oid (encode oidCache val)+              )+              (\val -> [print val])+  NullableOrNot.Nullable (Value.Value schemaName typeName scalarOid arrayOid dimensionality _ unknownTypes encode print) ->+    let staticOid = if dimensionality == 0 then scalarOid else arrayOid+     in case staticOid of+          Just oid ->+            Composite+              unknownTypes+              ( \oidCache -> \case+                  Nothing -> Binary.nullField oid+                  Just val -> Binary.field oid (encode oidCache val)+              )+              ( \case+                  Nothing -> ["NULL"]+                  Just val -> [print val]+              )+          Nothing ->+            Composite+              (HashSet.insert (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes)+              ( \oidCache -> \case+                  Nothing ->+                    let typeInfo = HashMap.lookup (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) oidCache+                        oid = if dimensionality == 0 then maybe 0 Vocab.TypeInfo.toBaseOid typeInfo else maybe 0 Vocab.TypeInfo.toArrayOid typeInfo+                     in Binary.nullField oid+                  Just val ->+                    let typeInfo = HashMap.lookup (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) oidCache+                        oid = if dimensionality == 0 then maybe 0 Vocab.TypeInfo.toBaseOid typeInfo else maybe 0 Vocab.TypeInfo.toArrayOid typeInfo+                     in Binary.field oid (encode oidCache val)+              )+              ( \case+                  Nothing -> ["NULL"]+                  Just val -> [print val]+              )
+ src/library/Hasql/Codecs/Encoders/NullableOrNot.hs view
@@ -0,0 +1,19 @@+module Hasql.Codecs.Encoders.NullableOrNot where++import Hasql.Platform.Prelude++-- |+-- Extensional specification of nullability over a generic encoder.+data NullableOrNot encoder a where+  NonNullable :: encoder a -> NullableOrNot encoder a+  Nullable :: encoder a -> NullableOrNot encoder (Maybe a)++-- |+-- Specify that an encoder produces a non-nullable value.+nonNullable :: encoder a -> NullableOrNot encoder a+nonNullable = NonNullable++-- |+-- Specify that an encoder produces a nullable value.+nullable :: encoder a -> NullableOrNot encoder (Maybe a)+nullable = Nullable
+ src/library/Hasql/Codecs/Encoders/Params.hs view
@@ -0,0 +1,198 @@+module Hasql.Codecs.Encoders.Params+  ( Params,+    noParams,+    param,+    toColumnsMetadata,+    toUnknownTypes,+    toSerializer,+    toPrinter,+  )+where++import Data.HashSet qualified as HashSet+import Data.Vector qualified as Vector+import Hasql.Codecs.Encoders.NullableOrNot qualified as NullableOrNot+import Hasql.Codecs.Encoders.Value qualified as Value+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.OidCache qualified as Vocab.OidCache+import Hasql.Codecs.Vocab.ParamMeta (ParamMeta (..))+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeRef qualified as Vocab.TypeRef+import Hasql.Platform.Prelude+import PostgreSQL.Binary.Encoding qualified as Binary+import TextBuilder qualified++-- | Frozen per-parameter metadata: type reference, dimensionality, text-format flag.+toColumnsMetadata :: Params a -> Vector ParamMeta+toColumnsMetadata (Params _ _ columnsMetadata _ _) = freezeColumnsMetadata columnsMetadata+  where+    freezeColumnsMetadata =+      Vector.fromList . toList++toUnknownTypes :: Params a -> HashSet Vocab.QualifiedTypeName+toUnknownTypes (Params _ unknownTypes _ _ _) =+  unknownTypes++-- | Serialise params to encoded wire values given a resolved OID cache.+toSerializer :: Params a -> Vocab.OidCache -> a -> [Maybe ByteString]+toSerializer (Params _ _ _ serializer _) = serializer++-- | Render params in human-readable form (for error reporting).+toPrinter :: Params a -> a -> [Text]+toPrinter (Params _ _ _ _ printer) = toList . printer++-- |+-- Encoder of some representation of a parameters product.+--+-- Has instances of 'Contravariant', 'Divisible' and 'Monoid',+-- which you can use to compose multiple parameters together.+-- E.g.,+--+-- @+-- someParamsEncoder :: 'Params' (Int64, Maybe Text)+-- someParamsEncoder =+--   ('fst' '>$<' 'param' ('nonNullable' 'int8')) '<>'+--   ('snd' '>$<' 'param' ('nullable' 'text'))+-- @+--+-- As a general solution for tuples of any arity, instead of 'fst' and 'snd',+-- consider the functions of the @contrazip@ family+-- from the "contravariant-extras" package.+-- E.g., here's how you can achieve the same as the above:+--+-- @+-- someParamsEncoder :: 'Params' (Int64, Maybe Text)+-- someParamsEncoder =+--   'contrazip2' ('param' ('nonNullable' 'int8')) ('param' ('nullable' 'text'))+-- @+--+-- Here's how you can implement encoders for custom composite types:+--+-- @+-- data Person = Person { name :: Text, gender :: Gender, age :: Int }+--+-- data Gender = Male | Female+--+-- personParams :: 'Params' Person+-- personParams =+--   (name '>$<' 'param' ('nonNullable' 'text')) '<>'+--   (gender '>$<' 'param' ('nonNullable' genderValue)) '<>'+--   ('fromIntegral' . age '>$<' 'param' ('nonNullable' 'int8'))+--+-- genderValue :: 'Value.Value' Gender+-- genderValue = 'enum' Nothing (Just "gender") genderText where+--   genderText gender = case gender of+--     Male -> "male"+--     Female -> "female"+-- @+data Params a = Params+  { size :: Int,+    unknownTypes :: HashSet Vocab.QualifiedTypeName,+    -- | (Type reference, dimensionality, Text Format) for each parameter.+    columnsMetadata :: DList ParamMeta,+    serializer :: Vocab.OidCache -> a -> [Maybe ByteString],+    printer :: a -> DList Text+  }++instance Contravariant Params where+  contramap fn (Params size unknownTypes columnsMetadata oldSerializer oldPrinter) = Params {..}+    where+      serializer oidCache = oldSerializer oidCache . fn+      printer = oldPrinter . fn++instance Divisible Params where+  divide+    divisor+    (Params leftSize leftUnknownTypes leftColumnsMetadata leftSerializer leftPrinter)+    (Params rightSize rightUnknownTypes rightColumnsMetadata rightSerializer rightPrinter) =+      Params+        { size = leftSize + rightSize,+          unknownTypes = leftUnknownTypes <> rightUnknownTypes,+          columnsMetadata = leftColumnsMetadata <> rightColumnsMetadata,+          serializer = \oidCache input -> case divisor input of+            (leftInput, rightInput) -> leftSerializer oidCache leftInput <> rightSerializer oidCache rightInput,+          printer = \input -> case divisor input of+            (leftInput, rightInput) -> leftPrinter leftInput <> rightPrinter rightInput+        }+  conquer =+    Params+      { size = 0,+        unknownTypes = mempty,+        columnsMetadata = mempty,+        serializer = mempty,+        printer = mempty+      }++instance Semigroup (Params a) where+  Params leftSize leftUnknownTypes leftColumnsMetadata leftSerializer leftPrinter <> Params rightSize rightUnknownTypes rightColumnsMetadata rightSerializer rightPrinter =+    Params+      { size = leftSize + rightSize,+        unknownTypes = leftUnknownTypes <> rightUnknownTypes,+        columnsMetadata = leftColumnsMetadata <> rightColumnsMetadata,+        serializer = \oidCache input -> leftSerializer oidCache input <> rightSerializer oidCache input,+        printer = \input -> leftPrinter input <> rightPrinter input+      }++instance Monoid (Params a) where+  mempty = conquer++value :: Value.Value a -> Params a+value (Value.Value schemaName typeName scalarOid arrayOid dimensionality textFormat unknownTypes serialize print) =+  let staticOid = if dimensionality == 0 then scalarOid else arrayOid+      serializer oidCache = pure . Just . Binary.encodingBytes . serialize (Vocab.OidCache.toHashMap oidCache)+      printer = pure . TextBuilder.toText . print+      size = 1+   in case staticOid of+        Just oid ->+          Params+            { size,+              unknownTypes,+              columnsMetadata = pure (ParamMeta (Vocab.TypeRef.KnownOid oid) dimensionality textFormat),+              serializer,+              printer+            }+        Nothing ->+          Params+            { size,+              unknownTypes = HashSet.insert (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes,+              columnsMetadata = pure (ParamMeta (Vocab.TypeRef.NamedType (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName)) dimensionality textFormat),+              serializer,+              printer+            }++nullableValue :: Value.Value a -> Params (Maybe a)+nullableValue (Value.Value schemaName typeName scalarOid arrayOid dimensionality textFormat unknownTypes serialize print) =+  let staticOid = if dimensionality == 0 then scalarOid else arrayOid+      serializer oidCache = pure . fmap (Binary.encodingBytes . serialize (Vocab.OidCache.toHashMap oidCache))+      printer = pure . maybe "null" (TextBuilder.toText . print)+      size = 1+   in case staticOid of+        Just oid ->+          Params+            { size,+              unknownTypes,+              columnsMetadata = pure (ParamMeta (Vocab.TypeRef.KnownOid oid) dimensionality textFormat),+              serializer,+              printer+            }+        Nothing ->+          Params+            { size,+              unknownTypes = HashSet.insert (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) unknownTypes,+              columnsMetadata = pure (ParamMeta (Vocab.TypeRef.NamedType (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName)) dimensionality textFormat),+              serializer,+              printer+            }++-- |+-- No parameters. Same as `mempty` and `conquered`.+noParams :: Params ()+noParams = mempty++-- |+-- Lift a single parameter encoder, with its nullability specified,+-- associating it with a single placeholder.+param :: NullableOrNot.NullableOrNot Value.Value a -> Params a+param = \case+  NullableOrNot.NonNullable valueEnc -> value valueEnc+  NullableOrNot.Nullable valueEnc -> nullableValue valueEnc
+ src/library/Hasql/Codecs/Encoders/Value.hs view
@@ -0,0 +1,456 @@+module Hasql.Codecs.Encoders.Value where++import ByteString.StrictBuilder qualified+import Data.Aeson qualified as Aeson+import Data.ByteString.Lazy qualified as LazyByteString+import Data.HashMap.Strict qualified as HashMap+import Data.HashSet qualified as HashSet+import Data.IP qualified as Iproute+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo+import Hasql.Platform.Prelude+import PostgreSQL.Binary.Encoding qualified as Binary+import PostgreSQL.Binary.Range qualified as Range+import TextBuilder qualified as TextBuilder++-- |+-- Value encoder.+data Value a+  = Value+      -- | Schema name, if any.+      (Maybe Text)+      -- | Type name.+      Text+      -- | Statically known OID for the type.+      -- When unspecified, the OID may be determined at runtime by looking up by name.+      (Maybe Word32)+      -- | Statically known OID for the array-type with this type as the element.+      -- When unspecified, the OID may be determined at runtime by looking up by name.+      -- It may also mean that there may be no array type containing this type, which is the case in attempts to double-nest arrays.+      (Maybe Word32)+      -- | Dimensionality. If 0 then it is not an array, but a scalar value.+      Word+      -- | Text format?+      Bool+      -- | Names of types that are not known statically and must be looked up at runtime collected from the nested composite and array encoders.+      (HashSet Vocab.QualifiedTypeName)+      -- | Serialization function on the resolved OIDs.+      (HashMap Vocab.QualifiedTypeName Vocab.TypeInfo.TypeInfo -> a -> Binary.Encoding)+      -- | Render function for error messages.+      (a -> TextBuilder.TextBuilder)++instance Contravariant Value where+  {-# INLINE contramap #-}+  contramap f (Value schemaName typeName valueOid arrayOid dimensionality textFormat unknownTypes encode render) =+    Value schemaName typeName valueOid arrayOid dimensionality textFormat unknownTypes (\hashMap -> encode hashMap . f) (render . f)++{-# INLINE primitive #-}+primitive :: Text -> Bool -> Vocab.TypeInfo.TypeInfo -> (a -> Binary.Encoding) -> (a -> TextBuilder.TextBuilder) -> Value a+primitive typeName isText typeInfo encode render =+  Value+    Nothing+    typeName+    (Just (Vocab.TypeInfo.toBaseOid typeInfo))+    (Just (Vocab.TypeInfo.toArrayOid typeInfo))+    0+    isText+    HashSet.empty+    (const encode)+    render++-- |+-- Encoder of @BOOL@ values.+{-# INLINEABLE bool #-}+bool :: Value Bool+bool = primitive "bool" False Vocab.TypeInfo.bool Binary.bool (TextBuilder.string . show)++-- |+-- Encoder of @INT2@ values.+{-# INLINEABLE int2 #-}+int2 :: Value Int16+int2 = primitive "int2" False Vocab.TypeInfo.int2 Binary.int2_int16 (TextBuilder.string . show)++-- |+-- Encoder of @INT4@ values.+{-# INLINEABLE int4 #-}+int4 :: Value Int32+int4 = primitive "int4" False Vocab.TypeInfo.int4 Binary.int4_int32 (TextBuilder.string . show)++-- |+-- Encoder of @INT8@ values.+{-# INLINEABLE int8 #-}+int8 :: Value Int64+int8 = primitive "int8" False Vocab.TypeInfo.int8 Binary.int8_int64 (TextBuilder.string . show)++-- |+-- Encoder of @FLOAT4@ values.+{-# INLINEABLE float4 #-}+float4 :: Value Float+float4 = primitive "float4" False Vocab.TypeInfo.float4 Binary.float4 (TextBuilder.string . show)++-- |+-- Encoder of @FLOAT8@ values.+{-# INLINEABLE float8 #-}+float8 :: Value Double+float8 = primitive "float8" False Vocab.TypeInfo.float8 Binary.float8 (TextBuilder.string . show)++-- |+-- Encoder of @NUMERIC@ values.+{-# INLINEABLE numeric #-}+numeric :: Value Scientific+numeric = primitive "numeric" False Vocab.TypeInfo.numeric Binary.numeric (TextBuilder.string . show)++-- |+-- Encoder of @CHAR@ values.+--+-- Note that it supports Unicode values and+-- identifies itself under the @TEXT@ OID because of that.+{-# INLINEABLE char #-}+char :: Value Char+char = primitive "char" False Vocab.TypeInfo.text Binary.char_utf8 (TextBuilder.string . show)++-- |+-- Encoder of @TEXT@ values.+{-# INLINEABLE text #-}+text :: Value Text+text = primitive "text" False Vocab.TypeInfo.text Binary.text_strict (TextBuilder.string . show)++-- |+-- Encoder of @VARCHAR@ values.+{-# INLINEABLE varchar #-}+varchar :: Value Text+varchar = primitive "varchar" False Vocab.TypeInfo.varchar Binary.text_strict (TextBuilder.string . show)++-- |+-- Encoder of @BPCHAR@ or @CHAR(n)@, @CHARACTER(n)@ values.+{-# INLINEABLE bpchar #-}+bpchar :: Value Text+bpchar = primitive "bpchar" False Vocab.TypeInfo.bpchar Binary.text_strict (TextBuilder.string . show)++-- |+-- Encoder of @BYTEA@ values.+{-# INLINEABLE bytea #-}+bytea :: Value ByteString+bytea = primitive "bytea" False Vocab.TypeInfo.bytea Binary.bytea_strict (TextBuilder.string . show)++-- |+-- Encoder of @DATE@ values.+{-# INLINEABLE date #-}+date :: Value Day+date = primitive "date" False Vocab.TypeInfo.date Binary.date (TextBuilder.string . show)++-- |+-- Encoder of @TIMESTAMP@ values.+{-# INLINEABLE timestamp #-}+timestamp :: Value LocalTime+timestamp = primitive "timestamp" False Vocab.TypeInfo.timestamp Binary.timestamp_int (TextBuilder.string . show)++-- |+-- Encoder of @TIMESTAMPTZ@ values.+{-# INLINEABLE timestamptz #-}+timestamptz :: Value UTCTime+timestamptz = primitive "timestamptz" False Vocab.TypeInfo.timestamptz Binary.timestamptz_int (TextBuilder.string . show)++-- |+-- Encoder of @TIME@ values.+{-# INLINEABLE time #-}+time :: Value TimeOfDay+time = primitive "time" False Vocab.TypeInfo.time Binary.time_int (TextBuilder.string . show)++-- |+-- Encoder of @TIMETZ@ values.+{-# INLINEABLE timetz #-}+timetz :: Value (TimeOfDay, TimeZone)+timetz = primitive "timetz" False Vocab.TypeInfo.timetz Binary.timetz_int (TextBuilder.string . show)++-- |+-- Encoder of @INTERVAL@ values.+{-# INLINEABLE interval #-}+interval :: Value DiffTime+interval = primitive "interval" False Vocab.TypeInfo.interval Binary.interval_int (TextBuilder.string . show)++-- |+-- Encoder of @UUID@ values.+{-# INLINEABLE uuid #-}+uuid :: Value UUID+uuid = primitive "uuid" False Vocab.TypeInfo.uuid Binary.uuid (TextBuilder.string . show)++-- |+-- Encoder of @INET@ values.+{-# INLINEABLE inet #-}+inet :: Value Iproute.IPRange+inet = primitive "inet" False Vocab.TypeInfo.inet Binary.inet (TextBuilder.string . show)++-- |+-- Encoder of @MACADDR@ values.+--+-- Represented as a 6-tuple of Word8 values in big endian order. If+-- you use `ip` library you can convert using its `toOctets`.+--+-- > toOctets >$< macaddr+{-# INLINEABLE macaddr #-}+macaddr :: Value (Word8, Word8, Word8, Word8, Word8, Word8)+macaddr = primitive "macaddr" False Vocab.TypeInfo.macaddr Binary.macaddr (TextBuilder.string . show)++-- |+-- Encoder of @JSON@ values from JSON AST.+{-# INLINEABLE json #-}+json :: Value Aeson.Value+json = primitive "json" False Vocab.TypeInfo.json Binary.json_ast (TextBuilder.string . show)++-- |+-- Encoder of @JSON@ values from raw JSON.+{-# INLINEABLE jsonBytes #-}+jsonBytes :: Value ByteString+jsonBytes = primitive "json" False Vocab.TypeInfo.json Binary.json_bytes (TextBuilder.string . show)++-- |+-- Encoder of @JSON@ values from raw JSON as lazy ByteString.+{-# INLINEABLE jsonLazyBytes #-}+jsonLazyBytes :: Value LazyByteString.ByteString+jsonLazyBytes = primitive "json" False Vocab.TypeInfo.json Binary.json_bytes_lazy (TextBuilder.string . show)++-- |+-- Encoder of @JSONB@ values from JSON AST.+{-# INLINEABLE jsonb #-}+jsonb :: Value Aeson.Value+jsonb = primitive "jsonb" False Vocab.TypeInfo.jsonb Binary.jsonb_ast (TextBuilder.string . show)++-- |+-- Encoder of @JSONB@ values from raw JSON.+{-# INLINEABLE jsonbBytes #-}+jsonbBytes :: Value ByteString+jsonbBytes = primitive "jsonb" False Vocab.TypeInfo.jsonb Binary.jsonb_bytes (TextBuilder.string . show)++-- |+-- Encoder of @JSONB@ values from raw JSON as lazy ByteString.+{-# INLINEABLE jsonbLazyBytes #-}+jsonbLazyBytes :: Value LazyByteString.ByteString+jsonbLazyBytes = primitive "jsonb" False Vocab.TypeInfo.jsonb Binary.jsonb_bytes_lazy (TextBuilder.string . show)++-- |+-- Encoder of @OID@ values.+{-# INLINEABLE oid #-}+oid :: Value Int32+oid = primitive "oid" False Vocab.TypeInfo.oid Binary.int4_int32 (TextBuilder.string . show)++-- |+-- Encoder of @NAME@ values.+{-# INLINEABLE name #-}+name :: Value Text+name = primitive "name" False Vocab.TypeInfo.name Binary.text_strict (TextBuilder.string . show)++-- |+-- Encoder of @INT4RANGE@ values.+{-# INLINEABLE int4range #-}+int4range :: Value (Range.Range Int32)+int4range = primitive "int4range" False Vocab.TypeInfo.int4range Binary.int4range (TextBuilder.string . show)++-- |+-- Encoder of @INT8RANGE@ values.+{-# INLINEABLE int8range #-}+int8range :: Value (Range.Range Int64)+int8range = primitive "int8range" False Vocab.TypeInfo.int8range Binary.int8range (TextBuilder.string . show)++-- |+-- Encoder of @NUMRANGE@ values.+{-# INLINEABLE numrange #-}+numrange :: Value (Range.Range Scientific)+numrange = primitive "numrange" False Vocab.TypeInfo.numrange Binary.numrange (TextBuilder.string . show)++-- |+-- Encoder of @TSRANGE@ values.+{-# INLINEABLE tsrange #-}+tsrange :: Value (Range.Range LocalTime)+tsrange = primitive "tsrange" False Vocab.TypeInfo.tsrange Binary.tsrange_int (TextBuilder.string . show)++-- |+-- Encoder of @TSTZRANGE@ values.+{-# INLINEABLE tstzrange #-}+tstzrange :: Value (Range.Range UTCTime)+tstzrange = primitive "tstzrange" False Vocab.TypeInfo.tstzrange Binary.tstzrange_int (TextBuilder.string . show)++-- |+-- Encoder of @DATERANGE@ values.+{-# INLINEABLE daterange #-}+daterange :: Value (Range.Range Day)+daterange = primitive "daterange" False Vocab.TypeInfo.daterange Binary.daterange (TextBuilder.string . show)++-- |+-- Encoder of @INT4MULTIRANGE@ values.+{-# INLINEABLE int4multirange #-}+int4multirange :: Value (Range.Multirange Int32)+int4multirange = primitive "int4multirange" False Vocab.TypeInfo.int4multirange Binary.int4multirange (TextBuilder.string . show)++-- |+-- Encoder of @INT8MULTIRANGE@ values.+{-# INLINEABLE int8multirange #-}+int8multirange :: Value (Range.Multirange Int64)+int8multirange = primitive "int8multirange" False Vocab.TypeInfo.int8multirange Binary.int8multirange (TextBuilder.string . show)++-- |+-- Encoder of @NUMMULTIRANGE@ values.+{-# INLINEABLE nummultirange #-}+nummultirange :: Value (Range.Multirange Scientific)+nummultirange = primitive "nummultirange" False Vocab.TypeInfo.nummultirange Binary.nummultirange (TextBuilder.string . show)++-- |+-- Encoder of @TSMULTIRANGE@ values.+{-# INLINEABLE tsmultirange #-}+tsmultirange :: Value (Range.Multirange LocalTime)+tsmultirange = primitive "tsmultirange" False Vocab.TypeInfo.tsmultirange Binary.tsmultirange_int (TextBuilder.string . show)++-- |+-- Encoder of @TSTZMULTIRANGE@ values.+{-# INLINEABLE tstzmultirange #-}+tstzmultirange :: Value (Range.Multirange UTCTime)+tstzmultirange = primitive "tstzmultirange" False Vocab.TypeInfo.tstzmultirange Binary.tstzmultirange_int (TextBuilder.string . show)++-- |+-- Encoder of @DATEMULTIRANGE@ values.+{-# INLINEABLE datemultirange #-}+datemultirange :: Value (Range.Multirange Day)+datemultirange = primitive "datemultirange" False Vocab.TypeInfo.datemultirange Binary.datemultirange (TextBuilder.string . show)++-- |+-- Encoder of @CITEXT@ values.+--+-- Requires the @citext@ extension to be installed in the database.+{-# INLINEABLE citext #-}+citext :: Value Text+citext =+  Value+    Nothing+    "citext"+    Nothing+    Nothing+    0+    False+    HashSet.empty+    (const Binary.text_strict)+    (TextBuilder.string . show)++-- |+-- Given a function which maps a value into a textual enum label used on the DB side,+-- produces an encoder of that value for a named enum type.+{-# INLINEABLE enum #-}+enum ::+  -- | Schema name where the enum type is defined.+  Maybe Text ->+  -- | Enum type name.+  Text ->+  -- | Mapping function from value to enum label.+  (a -> Text) ->+  Value a+enum schemaName typeName mapping =+  Value+    schemaName+    typeName+    Nothing+    Nothing+    0+    False+    (HashSet.singleton (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName))+    (const (Binary.text_strict . mapping))+    (TextBuilder.text . mapping)++-- |+-- Identifies the value with the PostgreSQL's \"unknown\" type,+-- thus leaving it up to Postgres to infer the actual type of the value.+--+-- The value transmitted is any value encoded in the Postgres' Text data format.+-- For reference, see the+-- <https://www.postgresql.org/docs/10/static/protocol-overview.html#PROTOCOL-FORMAT-CODES Formats and Format Codes>+-- section of the Postgres' documentation.+--+-- __Warning:__ Do not use this as part of composite encoders like 'array' since+-- it is the only encoder that doesn't use the binary format.+{-# DEPRECATED unknown "Use 'custom' instead." #-}+{-# INLINEABLE unknown #-}+unknown :: Value ByteString+unknown = primitive "unknown" True Vocab.TypeInfo.unknown Binary.bytea_strict (TextBuilder.string . show)++-- |+-- Low level API for defining custom value encoders.+{-# INLINEABLE custom #-}+custom ::+  -- | Schema name where the type is defined.+  Maybe Text ->+  -- | Type name.+  Text ->+  -- | Possible static OIDs for the type. The first is for scalar values the second is for arrays.+  --+  -- When unspecified, the OIDs will be automatically determined at runtime by looking up by name.+  Maybe (Word32, Word32) ->+  -- | Other named types whose OIDs are needed for serializing.+  --+  -- E.g., when encoding composite types Postgres requires specifying OIDs of all of its fields.+  --+  -- When any of the requested types is missing in the database an error will be raised upon the statement execution.+  [(Maybe Text, Text)] ->+  -- | Serialization function in the context of resolved OIDs of the types requested in the previous parameter.+  --+  -- It's safe to assume that all of the requested types will be present.+  -- In case you run the provided lookup function with unmentioned type names it will produce OID of 0 for them, standing for unknown type in Postgres.+  ( ((Maybe Text, Text) -> (Word32, Word32)) ->+    a ->+    ByteString+  ) ->+  -- | Render function for error messages.+  (a -> Text) ->+  Value a+custom schemaName typeName staticOids requiredTypes encode render =+  Value+    schemaName+    typeName+    (fmap fst staticOids)+    (fmap snd staticOids)+    0+    False+    (HashSet.fromList (fmap Vocab.QualifiedTypeName.fromNameTuple requiredTypes))+    ( \hashMap ->+        ByteString.StrictBuilder.bytes+          . encode+            ( \name ->+                fromMaybe (0, 0)+                  $ HashMap.lookup (Vocab.QualifiedTypeName.fromNameTuple name) hashMap+                  <&> \typeInfo -> (Vocab.TypeInfo.toBaseOid typeInfo, Vocab.TypeInfo.toArrayOid typeInfo)+            )+    )+    (TextBuilder.text . render)++-- |+-- Encoder of @HSTORE@ values from a foldable container of key-value pairs.+--+-- The value part can be @Nothing@ to represent a NULL value in the hstore.+{-# INLINEABLE hstore #-}+hstore :: (Foldable foldable) => Value (foldable (Text, Maybe Text))+hstore =+  Value+    Nothing+    "hstore"+    Nothing+    Nothing+    0+    False+    HashSet.empty+    (const Binary.hStore_foldable)+    renderHstore+  where+    renderHstore items =+      mconcat+        [ TextBuilder.text "hstore(",+          TextBuilder.intercalate ", " (foldMap (\pair -> [renderPair pair]) items),+          TextBuilder.text ")"+        ]+    renderPair (key, maybeValue) =+      mconcat+        [ TextBuilder.text "(",+          TextBuilder.string (show key),+          TextBuilder.text ", ",+          case maybeValue of+            Nothing -> TextBuilder.text "NULL"+            Just value -> TextBuilder.string (show value),+          TextBuilder.text ")"+        ]
+ src/library/Hasql/Codecs/RequestingOid.hs view
@@ -0,0 +1,67 @@+module Hasql.Codecs.RequestingOid+  ( RequestingOid,+    toUnknownTypes,+    toBase,+    requestAndHandle,+    lift,+    hoist,+    lookup,+    lookingUp,+    hoistLookingUp,+  )+where++import Hasql.Codecs.RequestingOid.LookingUp qualified as LookingUp+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.OidCache qualified as Vocab.OidCache+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo+import Hasql.Platform.Prelude hiding (lift, lookup)++type RequestingOid =+  LookingUp.LookingUp+    Vocab.QualifiedTypeName+    Vocab.TypeInfo.TypeInfo++{-# INLINE toUnknownTypes #-}+toUnknownTypes ::+  RequestingOid a ->+  HashSet Vocab.QualifiedTypeName+toUnknownTypes (LookingUp.LookingUp unknownTypes _) =+  fromList unknownTypes++{-# INLINE toBase #-}+toBase ::+  RequestingOid a ->+  Vocab.OidCache ->+  a+toBase (LookingUp.LookingUp _unknownTypes decoder) oidCache =+  decoder \key ->+    Vocab.OidCache.lookupTypeInfo key oidCache+      & fromMaybe (Vocab.TypeInfo.TypeInfo 0 0)++{-# INLINE requestAndHandle #-}+requestAndHandle ::+  [Vocab.QualifiedTypeName] ->+  ((Vocab.QualifiedTypeName -> Vocab.TypeInfo.TypeInfo) -> a) ->+  RequestingOid a+requestAndHandle keys fn = LookingUp.LookingUp keys fn++{-# INLINE lift #-}+lift :: a -> RequestingOid a+lift = LookingUp.lift++{-# INLINE hoist #-}+hoist :: (a -> b) -> RequestingOid a -> RequestingOid b+hoist fn (LookingUp.LookingUp keys use) = LookingUp.LookingUp keys (fn . use)++{-# INLINE lookup #-}+lookup :: Vocab.QualifiedTypeName -> RequestingOid Vocab.TypeInfo.TypeInfo+lookup = LookingUp.lookup++{-# INLINE lookingUp #-}+lookingUp :: Vocab.QualifiedTypeName -> (Vocab.TypeInfo.TypeInfo -> a) -> RequestingOid a+lookingUp = LookingUp.lookingUp++{-# INLINE hoistLookingUp #-}+hoistLookingUp :: Vocab.QualifiedTypeName -> (Vocab.TypeInfo.TypeInfo -> a -> b) -> RequestingOid a -> RequestingOid b+hoistLookingUp = LookingUp.hoistLookingUp
+ src/library/Hasql/Codecs/RequestingOid/LookingUp.hs view
@@ -0,0 +1,45 @@+module Hasql.Codecs.RequestingOid.LookingUp where++import Control.Applicative+import Prelude++data LookingUp k v a+  = LookingUp+      -- | Keys requested to be available for lookup.+      [k]+      -- | Continuation that looks up values by keys.+      ((k -> v) -> a)++type role LookingUp _ _ representational++deriving stock instance Functor (LookingUp k v)++instance Applicative (LookingUp k v) where+  {-# INLINE pure #-}+  pure a =+    LookingUp [] (\_ -> a)+  {-# INLINE (<*>) #-}+  LookingUp lKeys lUse <*> LookingUp rKeys rUse =+    LookingUp+      (lKeys <> rKeys)+      (\lookup -> lUse lookup (rUse lookup))++{-# INLINE lookup #-}+lookup :: k -> LookingUp k v v+lookup key =+  LookingUp [key] (\lookupFn -> lookupFn key)++{-# INLINE lift #-}+lift :: a -> LookingUp k v a+lift fa =+  LookingUp [] (const fa)++{-# INLINE lookingUp #-}+lookingUp :: k -> (v -> a) -> LookingUp k v a+lookingUp key cont =+  LookingUp [key] (\lookupFn -> cont (lookupFn key))++{-# INLINE hoistLookingUp #-}+hoistLookingUp :: k -> (v -> a -> b) -> LookingUp k v a -> LookingUp k v b+hoistLookingUp k tx (LookingUp keys use) =+  LookingUp (k : keys) (\lookupFn -> tx (lookupFn k) (use lookupFn))
+ src/library/Hasql/Codecs/Vocab.hs view
@@ -0,0 +1,14 @@+module Hasql.Codecs.Vocab+  ( QualifiedTypeName,+    TypeInfo,+    TypeRef,+    ParamMeta,+    OidCache,+  )+where++import Hasql.Codecs.Vocab.OidCache (OidCache)+import Hasql.Codecs.Vocab.ParamMeta (ParamMeta)+import Hasql.Codecs.Vocab.QualifiedTypeName (QualifiedTypeName)+import Hasql.Codecs.Vocab.TypeInfo (TypeInfo)+import Hasql.Codecs.Vocab.TypeRef (TypeRef)
+ src/library/Hasql/Codecs/Vocab/OidCache.hs view
@@ -0,0 +1,91 @@+module Hasql.Codecs.Vocab.OidCache+  ( OidCache,++    -- * Accessors+    toHashMap,+    lookupScalar,+    lookupArray,+    lookupTypeNameScalar,+    lookupTypeNameArray,+    lookupTypeInfo,++    -- * Constructors+    fromHashMap,+    empty,+    selectUnknownNames,+    insertScalar,+  )+where++import Data.HashMap.Strict qualified as HashMap+import Data.HashSet qualified as HashSet+import Hasql.Codecs.Vocab.QualifiedTypeName (QualifiedTypeName)+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as TypeInfo+import Hasql.Platform.Prelude hiding (empty, insert, lookup, reset)++-- | Pure registry state containing the hash map and counter+newtype OidCache+  = OidCache+      -- | By name of the type.+      --+      -- > scalar name -> TypeInfo (scalar OID, array OID)+      (HashMap QualifiedTypeName TypeInfo.TypeInfo)+  deriving stock (Show, Eq)++instance Semigroup OidCache where+  OidCache byNameL <> OidCache byNameR =+    OidCache (HashMap.union byNameR byNameL)++instance Monoid OidCache where+  mempty = OidCache mempty++{-# INLINEABLE empty #-}+empty :: OidCache+empty =+  OidCache HashMap.empty++-- | Having a set of required type names, select those that are not present in the cache.+{-# INLINE selectUnknownNames #-}+selectUnknownNames :: HashSet QualifiedTypeName -> OidCache -> HashSet QualifiedTypeName+selectUnknownNames keys (OidCache byName) =+  HashSet.filter (\key -> not (HashMap.member key byName)) keys++insertScalar :: Maybe Text -> Text -> Word32 -> Word32 -> OidCache -> OidCache+insertScalar schema name scalar array (OidCache byName) =+  OidCache (HashMap.insert (QualifiedTypeName.QualifiedTypeName schema name) (TypeInfo.TypeInfo scalar array) byName)++{-# INLINE fromHashMap #-}+fromHashMap :: HashMap QualifiedTypeName TypeInfo.TypeInfo -> OidCache+fromHashMap byName = OidCache byName++-- * Accessors++{-# INLINE lookupScalar #-}+lookupScalar :: Maybe Text -> Text -> OidCache -> Maybe Word32+lookupScalar schema name (OidCache byName) =+  HashMap.lookup (QualifiedTypeName.QualifiedTypeName schema name) byName <&> \info -> TypeInfo.toBaseOid info++{-# INLINE lookupArray #-}+lookupArray :: Maybe Text -> Text -> OidCache -> Maybe Word32+lookupArray schema name (OidCache byName) =+  HashMap.lookup (QualifiedTypeName.QualifiedTypeName schema name) byName <&> \info -> TypeInfo.toArrayOid info++{-# INLINE lookupTypeNameScalar #-}+lookupTypeNameScalar :: QualifiedTypeName -> OidCache -> Maybe Word32+lookupTypeNameScalar name (OidCache byName) =+  HashMap.lookup name byName <&> TypeInfo.toBaseOid++{-# INLINE lookupTypeNameArray #-}+lookupTypeNameArray :: QualifiedTypeName -> OidCache -> Maybe Word32+lookupTypeNameArray name (OidCache byName) =+  HashMap.lookup name byName <&> TypeInfo.toArrayOid++{-# INLINE lookupTypeInfo #-}+lookupTypeInfo :: QualifiedTypeName -> OidCache -> Maybe TypeInfo.TypeInfo+lookupTypeInfo name (OidCache byName) =+  HashMap.lookup name byName++{-# INLINE toHashMap #-}+toHashMap :: OidCache -> HashMap QualifiedTypeName TypeInfo.TypeInfo+toHashMap (OidCache byName) = byName
+ src/library/Hasql/Codecs/Vocab/ParamMeta.hs view
@@ -0,0 +1,13 @@+module Hasql.Codecs.Vocab.ParamMeta+  ( ParamMeta (..),+  )+where++import Hasql.Codecs.Vocab.TypeRef (TypeRef)+import Hasql.Platform.Prelude++-- | Per-parameter metadata: type reference, array dimensionality, text-format flag.+data ParamMeta = ParamMeta TypeRef Word Bool+  deriving stock (Eq, Ord, Show, Generic)++instance Hashable ParamMeta
+ src/library/Hasql/Codecs/Vocab/QualifiedTypeName.hs view
@@ -0,0 +1,43 @@+module Hasql.Codecs.Vocab.QualifiedTypeName+  ( QualifiedTypeName (..),+    fromNameTuple,+    toNameTuple,+  )+where++import Hasql.Platform.Prelude++-- |+-- A Postgres type identified by name: an optional schema together with a+-- required type name.+--+-- A 'Nothing' schema means the name is unqualified and is resolved via the+-- server's search path.+--+-- Used as the key under which a type's OIDs are resolved and cached.+data QualifiedTypeName = QualifiedTypeName+  { schema :: Maybe Text,+    name :: Text+  }+  deriving stock (Eq, Ord, Show, Generic)++instance Hashable QualifiedTypeName++-- | An unqualified name constructor for convenience.+instance IsString QualifiedTypeName where+  fromString = QualifiedTypeName Nothing . fromString++-- |+-- Convert from the legacy @(schema, name)@ tuple representation.+--+-- Used at public-API boundaries (e.g. the @custom@ codecs and error types)+-- where the tuple is still exposed but internals operate on 'QualifiedTypeName'.+fromNameTuple :: (Maybe Text, Text) -> QualifiedTypeName+fromNameTuple (schema, name) = QualifiedTypeName schema name++-- |+-- Convert to the legacy @(schema, name)@ tuple representation.+--+-- See 'fromNameTuple'.+toNameTuple :: QualifiedTypeName -> (Maybe Text, Text)+toNameTuple (QualifiedTypeName schema name) = (schema, name)
+ src/library/Hasql/Codecs/Vocab/TypeInfo.hs view
@@ -0,0 +1,230 @@+module Hasql.Codecs.Vocab.TypeInfo where++import Hasql.Platform.Prelude hiding (bool)++-- | A Postgresql type info+data TypeInfo+  = TypeInfo {toBaseOid :: Word32, toArrayOid :: Word32}+  deriving (Eq, Ord, Show)++abstime :: TypeInfo+abstime = TypeInfo 702 1023++aclitem :: TypeInfo+aclitem = TypeInfo 1033 1034++bit :: TypeInfo+bit = TypeInfo 1560 1561++bool :: TypeInfo+bool = TypeInfo 16 1000++box :: TypeInfo+box = TypeInfo 603 1020++bpchar :: TypeInfo+bpchar = TypeInfo 1042 1014++bytea :: TypeInfo+bytea = TypeInfo 17 1001++char :: TypeInfo+char = TypeInfo 18 1002++cid :: TypeInfo+cid = TypeInfo 29 1012++cidr :: TypeInfo+cidr = TypeInfo 650 651++circle :: TypeInfo+circle = TypeInfo 718 719++cstring :: TypeInfo+cstring = TypeInfo 2275 1263++date :: TypeInfo+date = TypeInfo 1082 1182++daterange :: TypeInfo+daterange = TypeInfo 3912 3913++datemultirange :: TypeInfo+datemultirange = TypeInfo 4535 6155++float4 :: TypeInfo+float4 = TypeInfo 700 1021++float8 :: TypeInfo+float8 = TypeInfo 701 1022++gtsvector :: TypeInfo+gtsvector = TypeInfo 3642 3644++inet :: TypeInfo+inet = TypeInfo 869 1041++int2 :: TypeInfo+int2 = TypeInfo 21 1005++int2vector :: TypeInfo+int2vector = TypeInfo 22 1006++int4 :: TypeInfo+int4 = TypeInfo 23 1007++int4range :: TypeInfo+int4range = TypeInfo 3904 3905++int4multirange :: TypeInfo+int4multirange = TypeInfo 4451 6150++int8 :: TypeInfo+int8 = TypeInfo 20 1016++int8range :: TypeInfo+int8range = TypeInfo 3926 3927++int8multirange :: TypeInfo+int8multirange = TypeInfo 4536 6157++interval :: TypeInfo+interval = TypeInfo 1186 1187++json :: TypeInfo+json = TypeInfo 114 199++jsonb :: TypeInfo+jsonb = TypeInfo 3802 3807++line :: TypeInfo+line = TypeInfo 628 629++lseg :: TypeInfo+lseg = TypeInfo 601 1018++macaddr :: TypeInfo+macaddr = TypeInfo 829 1040++money :: TypeInfo+money = TypeInfo 790 791++name :: TypeInfo+name = TypeInfo 19 1003++numeric :: TypeInfo+numeric = TypeInfo 1700 1231++numrange :: TypeInfo+numrange = TypeInfo 3906 3907++nummultirange :: TypeInfo+nummultirange = TypeInfo 4532 6151++oid :: TypeInfo+oid = TypeInfo 26 1028++oidvector :: TypeInfo+oidvector = TypeInfo 30 1013++path :: TypeInfo+path = TypeInfo 602 1019++point :: TypeInfo+point = TypeInfo 600 1017++polygon :: TypeInfo+polygon = TypeInfo 604 1027++record :: TypeInfo+record = TypeInfo 2249 2287++refcursor :: TypeInfo+refcursor = TypeInfo 1790 2201++regclass :: TypeInfo+regclass = TypeInfo 2205 2210++regconfig :: TypeInfo+regconfig = TypeInfo 3734 3735++regdictionary :: TypeInfo+regdictionary = TypeInfo 3769 3770++regoper :: TypeInfo+regoper = TypeInfo 2203 2208++regoperator :: TypeInfo+regoperator = TypeInfo 2204 2209++regproc :: TypeInfo+regproc = TypeInfo 24 1008++regprocedure :: TypeInfo+regprocedure = TypeInfo 2202 2207++regtype :: TypeInfo+regtype = TypeInfo 2206 2211++reltime :: TypeInfo+reltime = TypeInfo 703 1024++text :: TypeInfo+text = TypeInfo 25 1009++tid :: TypeInfo+tid = TypeInfo 27 1010++time :: TypeInfo+time = TypeInfo 1083 1183++timestamp :: TypeInfo+timestamp = TypeInfo 1114 1115++timestamptz :: TypeInfo+timestamptz = TypeInfo 1184 1185++timetz :: TypeInfo+timetz = TypeInfo 1266 1270++tinterval :: TypeInfo+tinterval = TypeInfo 704 1025++tsquery :: TypeInfo+tsquery = TypeInfo 3615 3645++tsrange :: TypeInfo+tsrange = TypeInfo 3908 3909++tsmultirange :: TypeInfo+tsmultirange = TypeInfo 4533 6152++tstzrange :: TypeInfo+tstzrange = TypeInfo 3910 3911++tstzmultirange :: TypeInfo+tstzmultirange = TypeInfo 4534 6153++tsvector :: TypeInfo+tsvector = TypeInfo 3614 3643++txid_snapshot :: TypeInfo+txid_snapshot = TypeInfo 2970 2949++unknown :: TypeInfo+unknown = TypeInfo 705 705++uuid :: TypeInfo+uuid = TypeInfo 2950 2951++varbit :: TypeInfo+varbit = TypeInfo 1562 1563++varchar :: TypeInfo+varchar = TypeInfo 1043 1015++xid :: TypeInfo+xid = TypeInfo 28 1011++xml :: TypeInfo+xml = TypeInfo 142 143
+ src/library/Hasql/Codecs/Vocab/TypeRef.hs view
@@ -0,0 +1,20 @@+module Hasql.Codecs.Vocab.TypeRef+  ( TypeRef (..),+  )+where++import Hasql.Codecs.Vocab.QualifiedTypeName (QualifiedTypeName)+import Hasql.Platform.Prelude++-- |+-- How a parameter's Postgres type is identified within parameter metadata:+-- either an already-known OID, or a 'QualifiedTypeName' still pending OID+-- resolution against the server.+data TypeRef+  = -- | The type's OID is statically known.+    KnownOid Word32+  | -- | The type is named and its OID must be resolved before execution.+    NamedType QualifiedTypeName+  deriving stock (Eq, Ord, Show, Generic)++instance Hashable TypeRef
+ src/library/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 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 view
@@ -0,0 +1,365 @@+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 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 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 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 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 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 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 view
@@ -0,0 +1,67 @@+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 view
@@ -0,0 +1,174 @@+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+  when (pipelineStatus == Pq.PipelineOn) 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
@@ -0,0 +1,142 @@+-- |+-- This module provides a low-level effectful API dealing with the connections to the database.+module Hasql.Connection+  ( Connection,+    acquire,+    release,+    use,+  )+where++import Data.Text qualified as Text+import Hasql.Comms.Session qualified as Comms.Session+import Hasql.Connection.Config qualified as Config+import Hasql.Connection.ServerVersion qualified as ServerVersion+import Hasql.Connection.Settings qualified as Settings+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++-- |+-- A single connection to the database.+newtype Connection+  = Connection (MVar ConnectionState.ConnectionState)++-- |+-- Establish a connection according to the provided settings.+acquire ::+  Settings.Settings ->+  IO (Either ConnectionError Connection)+acquire settings =+  {-# SCC "acquire" #-}+  runExceptT do+    let config = Config.construct settings++    -- Connect:+    pqConnection <- lift (Pq.connectdb (Config.connectionString config))++    -- Check status:+    status <- lift (Pq.status pqConnection)+    case status of+      Pq.ConnectionOk -> pure ()+      _ -> do+        errorMessage <- lift (Pq.errorMessage pqConnection)+        throwError (interpretConnectionError errorMessage)++    -- Check version:+    version <- lift (ServerVersion.load pqConnection)+    when (version < ServerVersion.minimum) do+      throwError (CompatibilityConnectionError ("Server version is lower than 9: " <> ServerVersion.toText version))++    -- Initialize:+    lift do+      Pq.exec pqConnection do+        "SET client_encoding = 'UTF8';\n\+        \SET client_min_messages TO WARNING;"++    let connectionState =+          ConnectionState.ConnectionState+            { ConnectionState.preparedStatements = not (Config.noPreparedStatements config),+              ConnectionState.statementCache = StatementCache.empty,+              ConnectionState.oidCache = mempty,+              ConnectionState.connection = pqConnection+            }+    connectionRef <- lift (newMVar connectionState)+    pure (Connection connectionRef)+  where+    interpretConnectionError :: Maybe ByteString -> ConnectionError+    interpretConnectionError errorMessage =+      case errorMessage of+        Nothing -> OtherConnectionError "Unknown connection error"+        Just msg ->+          let msgText = decodeUtf8Lenient msg+              msgLower = Text.toLower msgText+           in if+                | any (`Text.isInfixOf` msgLower) networkingErrors -> NetworkingConnectionError msgText+                | any (`Text.isInfixOf` msgLower) authenticationErrors -> AuthenticationConnectionError msgText+                | otherwise -> OtherConnectionError (decodeUtf8Lenient msg)++    networkingErrors :: [Text]+    networkingErrors =+      [ "could not connect to server",+        "no such file or directory",+        "connection refused",+        "timeout expired",+        "host not found",+        "could not translate host name"+      ]++    authenticationErrors :: [Text]+    authenticationErrors =+      [ "authentication failed",+        "password authentication failed",+        "no password supplied",+        "peer authentication failed"+      ]++-- |+-- Release the connection.+release :: Connection -> IO ()+release (Connection connectionRef) =+  mask_ do+    connectionState <- readMVar connectionRef+    Pq.finish (ConnectionState.connection connectionState)++-- |+-- Execute a sequence of operations with exclusive access to the connection.+--+-- Blocks until the connection is available when there is another session running upon the connection on a different thread.+use :: Connection -> Session.Session a -> IO (Either SessionError a)+use (Connection var) session =+  mask \restore -> do+    connectionState@ConnectionState.ConnectionState {..} <- takeMVar var+    result <- try @SomeException (restore (Session.run session connectionState))+    case result of+      Left exception -> do+        -- If an exception happened, we need to bring the connection back to idle+        -- without resetting (to preserve session state).+        result <- Comms.Session.toHandler Comms.Session.cleanUpAfterInterruption connection+        case result of+          Left err -> do+            -- If cleanup failed, we have to close the connection.+            -- There's not much else we can do.+            Pq.finish connection+            putMVar var (ConnectionState.resetPreparedStatementsCache connectionState)+            let message =+                  mconcat+                    [ "Failed to clean up after interruption.\n",+                      err,+                      "\n",+                      "The following exception was raised during the operation:\n",+                      Text.pack (displayException exception)+                    ]+            pure (Left (DriverSessionError message))+          Right () -> do+            putMVar var (ConnectionState.resetPreparedStatementsCache connectionState)+            throwIO exception+      Right (result, !newState) -> do+        putMVar var newState+        pure result
+ src/library/Hasql/Connection/Config.hs view
@@ -0,0 +1,15 @@+module Hasql.Connection.Config where++import Hasql.Platform.Prelude++data Config+  = Config+  { -- | Pre-rendered connection string.+    connectionString :: ByteString,+    noPreparedStatements :: Bool+  }+  deriving stock (Eq)++-- | For values that can be compiled to 'Config'.+class Constructs a where+  construct :: a -> Config
+ src/library/Hasql/Connection/ServerVersion.hs view
@@ -0,0 +1,71 @@+module Hasql.Connection.ServerVersion+  ( ServerVersion (..),+    toText,+    fromInt,+    minimum,++    -- * PQ operations+    load,+  )+where++import Hasql.Platform.Prelude hiding (minimum)+import Hasql.Pq qualified as Pq+import TextBuilder qualified++data ServerVersion = ServerVersion Int Int Int+  deriving stock (Eq, Ord, Show)++-- |+-- >>> fromInt 10000+-- ServerVersion 1 0 0+--+-- >>> fromInt 100001+-- ServerVersion 10 1 0+--+-- >>> fromInt 110000+-- ServerVersion 11 0 0+--+-- >>> fromInt 90105+-- ServerVersion 9 1 5+--+-- >>> fromInt 90200+-- ServerVersion 9 2 0+--+-- Ref: https://www.postgresql.org/docs/18/libpq-status.html#LIBPQ-PQSERVERVERSION+fromInt :: Int -> ServerVersion+fromInt x =+  if x < 100_000+    then fromPre10Int x+    else fromPost10Int x++fromPost10Int :: Int -> ServerVersion+fromPost10Int x =+  let (major, minor) = divMod x 10_000+   in ServerVersion major minor 0++fromPre10Int :: Int -> ServerVersion+fromPre10Int = evalState do+  patch <- state (swap . flip divMod 100)+  minor <- state (swap . flip divMod 100)+  major <- get+  pure (ServerVersion major minor patch)++toText :: ServerVersion -> Text+toText (ServerVersion major minor patch) =+  (TextBuilder.toText . mconcat)+    [ TextBuilder.decimal major,+      ".",+      TextBuilder.decimal minor,+      ".",+      TextBuilder.decimal patch+    ]++-- | Minimum supported version.+minimum :: ServerVersion+minimum = ServerVersion 9 0 0++-- | Load from PQ connection.+load :: Pq.Connection -> IO ServerVersion+load connection =+  fromInt <$> Pq.serverVersion connection
+ src/library/Hasql/Connection/Settings.hs view
@@ -0,0 +1,136 @@+module Hasql.Connection.Settings+  ( -- * Settings+    Settings,++    -- * Constructors+    host,+    hostAndPort,+    user,+    password,+    dbname,+    applicationName,+    other,+    noPreparedStatements,+    connectionString,+  )+where++import Data.Text qualified as Text+import Hasql.Connection.Config qualified as Config+import Hasql.Platform.Prelude+import PostgresqlConnectionString qualified as ConnectionString++-- | Connection settings.+--+-- This is a monoid, so you can combine multiple settings using 'mappend' ('<>').+-- The rightmost setting takes precedence in case of conflicts.+--+-- With OverloadedStrings, you can declare settings using connection strings directly.+--+-- For example, using a key-value format:+--+-- >>> "host=localhost port=5432 user=myuser dbname=mydb" :: Settings+-- "postgresql://myuser@localhost:5432/mydb"+--+-- Or using a URI format:+--+-- >>> "postgresql://myuser@localhost:5432/mydb" :: Settings+-- "postgresql://myuser@localhost:5432/mydb"+--+-- You can achieve the same effect by constructing from a 'Text' value:+--+-- >>> connectionString "host=localhost port=5432 user=myuser dbname=mydb"+-- "postgresql://myuser@localhost:5432/mydb"+--+-- Or use the provided constructors for better type safety and clarity:+--+-- >>> hostAndPort "localhost" 5432 <> user "myuser" <> dbname "mydb"+-- "postgresql://myuser@localhost:5432/mydb"+newtype Settings+  = Settings ConnectionString.ConnectionString+  deriving newtype (Eq, IsString, Show, Semigroup, Monoid)++-- | This instance allows interfacing with the internal Config.Config type without affecting the public API or requiring complex module hierarchies.+instance Config.Constructs Settings where+  construct (Settings connectionString) =+    case ConnectionString.interceptParam "no_prepared_statements" connectionString of+      Just (value, connectionString) ->+        let noPreparedStatements = interpretTextAsBool value+         in pack connectionString noPreparedStatements+      Nothing -> pack connectionString False+    where+      interpretTextAsBool value = case Text.toLower value of+        "1" -> True+        "true" -> True+        "t" -> True+        "yes" -> True+        "y" -> True+        "on" -> True+        _ -> False++      pack connectionString noPreparedStatements =+        Config.Config+          { connectionString =+              let textUrl = ConnectionString.toUrl connectionString+               in encodeUtf8 textUrl,+            noPreparedStatements+          }++-- * Constructors++-- | Whether prepared statements are disabled.+--+-- 'False' by default.+--+-- When 'True', even the statements marked as preparable will be executed without preparation at the cost of reduced performance.+--+-- This is useful when dealing with proxying applications like @pgbouncer@, which may be incompatible with prepared statements.+-- Consult their docs or just provide this setting to stay on the safe side.+-- It should be noted that starting from version @1.21.0@ @pgbouncer@ now does provide support for prepared statements.+noPreparedStatements :: Bool -> Settings+noPreparedStatements =+  Settings . ConnectionString.param "no_prepared_statements" . bool "false" "true"++-- | Host domain name or IP-address.+--+-- To specify multiple alternate hosts, combine the produced settings via 'Monoid'.+host :: Text -> Settings+host host =+  Settings (ConnectionString.host host)++-- | Host domain name or IP-address and port.+--+-- Specifying a port without a host is not allowed due to how PostgreSQL handles connection strings.+--+-- This function creates a single host-port pair. To specify multiple alternate hosts, combine the results of multiple 'hostAndPort' calls using the 'Monoid' instance.+hostAndPort :: Text -> Word16 -> Settings+hostAndPort host port =+  Settings (ConnectionString.hostAndPort host port)++-- | User name.+user :: Text -> Settings+user = Settings . ConnectionString.user++-- | Password.+password :: Text -> Settings+password = Settings . ConnectionString.password++-- | Database name.+dbname :: Text -> Settings+dbname = Settings . ConnectionString.dbname++-- | Application name.+applicationName :: Text -> Settings+applicationName = Settings . ConnectionString.param "application_name"++-- | Other param.+other :: Text -> Text -> Settings+other key = Settings . ConnectionString.param key++-- | Construct from a connection string in either URI or key-value format.+--+-- See the [PostgreSQL documentation](https://www.postgresql.org/docs/current/libpq-connect.html#LIBPQ-CONNSTRING) for details on the format.+--+-- If the connection string is invalid, it will be treated as empty.+connectionString :: Text -> Settings+connectionString = Settings . either (const mempty) id . ConnectionString.parse
+ src/library/Hasql/Decoders.hs view
@@ -0,0 +1,91 @@+-- |+-- A DSL for declaration of result decoders.+module Hasql.Decoders+  ( -- * Result+    Result,+    noResult,+    rowsAffected,+    singleRow,++    -- ** Specialized multi-row results+    rowMaybe,+    rowVector,+    rowList,++    -- ** Multi-row traversers+    foldlRows,+    foldrRows,++    -- * Row+    Row,+    column,++    -- * Nullability+    NullableOrNot,+    nonNullable,+    nullable,++    -- * Value+    Value,+    bool,+    int2,+    int4,+    int8,+    float4,+    float8,+    numeric,+    char,+    text,+    varchar,+    bpchar,+    bytea,+    date,+    timestamp,+    timestamptz,+    time,+    timetz,+    interval,+    uuid,+    inet,+    macaddr,+    json,+    jsonBytes,+    jsonb,+    jsonbBytes,+    int4range,+    int8range,+    numrange,+    tsrange,+    tstzrange,+    daterange,+    int4multirange,+    int8multirange,+    nummultirange,+    tsmultirange,+    tstzmultirange,+    datemultirange,+    citext,+    array,+    listArray,+    vectorArray,+    composite,+    record,+    hstore,+    enum,+    custom,+    refine,++    -- * Array+    Array,+    dimension,+    element,++    -- * Composite+    Composite,+    field,+  )+where++import Hasql.Codecs.Decoders+import Hasql.Engine.Decoders.Result+import Hasql.Engine.Decoders.Row
+ src/library/Hasql/Encoders.hs view
@@ -0,0 +1,80 @@+-- |+-- A DSL for declaration of statement parameter encoders.+--+-- For compactness of names all the types defined here imply being an encoder.+-- E.g., the `Array` type is an __encoder__ of arrays, not the data-structure itself.+module Hasql.Encoders+  ( -- * Parameters product+    Params,+    noParams,+    param,++    -- * Nullability+    NullableOrNot,+    nonNullable,+    nullable,++    -- * Value+    Value,+    bool,+    int2,+    int4,+    int8,+    float4,+    float8,+    numeric,+    char,+    text,+    varchar,+    bpchar,+    bytea,+    date,+    timestamp,+    timestamptz,+    time,+    timetz,+    interval,+    uuid,+    inet,+    macaddr,+    json,+    jsonBytes,+    jsonLazyBytes,+    jsonb,+    jsonbBytes,+    jsonbLazyBytes,+    int4range,+    int8range,+    numrange,+    tsrange,+    tstzrange,+    daterange,+    int4multirange,+    int8multirange,+    nummultirange,+    tsmultirange,+    tstzmultirange,+    datemultirange,+    citext,+    name,+    oid,+    foldableArray,+    array,+    hstore,+    enum,+    composite,+    custom,+    unknown,++    -- * Array+    Array,+    element,+    dimension,++    -- * Composite+    Composite,+    field,+  )+where++import Hasql.Codecs.Encoders
+ src/library/Hasql/Engine/Contexts/Pipeline.hs view
@@ -0,0 +1,268 @@+module Hasql.Engine.Contexts.Pipeline+  ( Pipeline,+    run,+    statement,+  )+where++import Data.HashMap.Strict qualified as HashMap+import Data.HashSet qualified as HashSet+import Hasql.Codecs.RequestingOid qualified as RequestingOid+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.OidCache qualified as OidCache+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Comms.Roundtrip qualified as Comms.Roundtrip+import Hasql.Engine.Errors qualified as Errors+import Hasql.Engine.PqProcedures.SelectTypeInfo qualified as PqProcedures.SelectTypeInfo+import Hasql.Engine.Statement qualified as Statement+import Hasql.Engine.Structures.StatementCache qualified as StatementCache+import Hasql.Platform.Prelude+import Hasql.Pq qualified as Pq++run ::+  Pipeline a ->+  Bool ->+  Pq.Connection ->+  OidCache.OidCache ->+  StatementCache.StatementCache ->+  IO+    ( Either Errors.SessionError a,+      OidCache.OidCache,+      StatementCache.StatementCache+    )+run (Pipeline totalStatements unknownTypes runPipeline) usePreparedStatements connection oidCache statementCache = do+  let missingTypes = OidCache.selectUnknownNames unknownTypes oidCache+  resolvedOidCache <-+    if HashSet.null missingTypes+      then pure (Right oidCache)+      else do+        oidCacheUpdates <-+          PqProcedures.SelectTypeInfo.run connection (PqProcedures.SelectTypeInfo.SelectTypeInfo missingTypes)+        pure $ case oidCacheUpdates of+          Left err -> Left err+          Right oidCacheUpdates ->+            let foundTypes = HashMap.keysSet oidCacheUpdates+                notFoundTypes = HashSet.difference missingTypes foundTypes+             in if not (HashSet.null notFoundTypes)+                  then Left (Errors.MissingTypesSessionError (HashSet.map Vocab.QualifiedTypeName.toNameTuple notFoundTypes))+                  else Right (oidCache <> OidCache.fromHashMap oidCacheUpdates)+  case resolvedOidCache of+    Left err -> pure (Left err, oidCache, statementCache)+    Right newOidCache -> do+      let (roundtrip, newStatementCache) =+            runPipeline 0 usePreparedStatements newOidCache statementCache+          contextualRoundtrip = first Just roundtrip++      executionResult <- Comms.Roundtrip.toPipelineIO contextualRoundtrip Nothing connection++      let result =+            first+              ( \case+                  Comms.Roundtrip.ClientError _context details ->+                    Errors.ConnectionSessionError (maybe "" decodeUtf8Lenient details)+                  Comms.Roundtrip.ServerError recvError ->+                    Errors.fromRecvError (fmap (fmap (\(Context index sql params prepared _) -> (totalStatements, index, sql, params, prepared))) recvError)+              )+              executionResult+          finalStatementCache =+            case executionResult of+              Right _ -> newStatementCache+              Left executionError ->+                maybe+                  statementCache+                  (\(Context _ _ _ _ statementCache) -> statementCache)+                  (extract executionError)++      pure (result, newOidCache, finalStatementCache)++-- |+-- Composable abstraction over the execution of queries in [the pipeline mode](https://www.postgresql.org/docs/current/libpq-pipeline-mode.html).+--+-- It allows you to issue multiple queries to the server in much fewer network transactions.+-- If the amounts of sent and received data do not surpass the buffer sizes in the driver and on the server it will be just a single roundtrip.+-- Typically the buffer size is 8KB.+--+-- This execution mode is much more efficient than running queries directly from 'Hasql.Session.Session', because in session every statement execution involves a dedicated network roundtrip.+--+-- An obvious question rises then: why not execute all queries like that?+-- In situations where the parameters depend on the result of another query it is impossible to execute them in parallel, because the client needs to receive the results of one query before sending the request to execute the next.+-- This reasoning is essentially the same as the one for the difference between 'Applicative' and 'Monad'.+-- That's why 'Pipeline' does not have the 'Monad' instance.+--+-- To execute 'Pipeline' lift it into 'Hasql.Session.Session' via 'Hasql.Session.pipeline'.+--+-- == Examples+--+-- === Insert-Many or Batch-Insert+--+-- You can use pipeline to turn a single-row insert query into an efficient multi-row insertion session.+-- In effect this should be comparable in performance to issuing a single multi-row insert statement.+--+-- Given the following definition in a Statements module:+--+-- @+-- insertOrder :: 'Hasql.Statement.Statement' OrderDetails OrderId+-- @+--+-- You can lift it into the following session+--+-- @+-- insertOrders :: [OrderDetails] -> 'Hasql.Session.Session' [OrderId]+-- insertOrders orders =+--   'Hasql.Session.pipeline' $+--     for orders $ \order ->+--       'Hasql.Pipeline.statement' order Statements.insertOrder+-- @+--+-- === Combining Queries+--+-- Given the following definitions in a Statements module:+--+-- @+-- selectOrderDetails :: 'Hasql.Statement.Statement' OrderId (Maybe OrderDetails)+-- selectOrderProducts :: 'Hasql.Statement.Statement' OrderId [OrderProduct]+-- selectOrderFinancialTransactions :: 'Hasql.Statement.Statement' OrderId [FinancialTransaction]+-- @+--+-- You can combine them into a session using the `ApplicativeDo` extension as follows:+--+-- @+-- selectEverythingAboutOrder :: OrderId -> 'Hasql.Session.Session' (Maybe OrderDetails, [OrderProduct], [FinancialTransaction])+-- selectEverythingAboutOrder orderId =+--   'Hasql.Session.pipeline' $ do+--     details <- 'Hasql.Pipeline.statement' orderId Statements.selectOrderDetails+--     products <- 'Hasql.Pipeline.statement' orderId Statements.selectOrderProducts+--     transactions <- 'Hasql.Pipeline.statement' orderId Statements.selectOrderFinancialTransactions+--     pure (details, products, transactions)+-- @+data Pipeline a+  = Pipeline+      -- | Amount of statements in this pipeline.+      Int+      -- | Names of types that are used in this pipeline.+      --+      -- They will be used to pre-resolve type OIDs before running the pipeline providing them in OidCache.+      -- It can be assumed in the execution function that these types are always present in the cache.+      -- To achieve that property we will be validating the presence of all requested types in the database or failing before running the pipeline.+      -- In the execution function we will be defaulting to 'Pq.Oid 0' for unknown types as a fallback in case of bugs.+      (HashSet Vocab.QualifiedTypeName)+      -- | Function that runs the pipeline.+      --+      -- The integer parameter indicates the current offset of the statement in the pipeline (0-based).+      --+      -- The boolean parameter indicates whether preparable statements should be prepared.+      --+      -- OidCache is provided in which the names of types used in this pipeline are already resolved.+      --+      -- The function takes the current statement cache and returns a tuple of:+      -- 1. The actual roundtrip action to be executed in the pipeline.+      -- 2. The updated statement cache after composing this part of the pipeline.+      --+      -- The resulting cache is optimistic: on failure we recover the last known+      -- committed cache from statement contexts carried by roundtrip errors.+      ( Int ->+        Bool ->+        OidCache.OidCache ->+        StatementCache.StatementCache ->+        (Comms.Roundtrip.Roundtrip Context a, StatementCache.StatementCache)+      )++data Context+  = Context+      -- | Offset of the statement in the pipeline (0-based).+      Int+      -- | SQL.+      ByteString+      -- | Parameters in a human-readable form.+      [Text]+      -- | Whether the statement is prepared.+      Bool+      -- | The so far successfully updated statement cache.+      StatementCache.StatementCache+  deriving stock (Show, Eq)++-- * Instances++instance Functor Pipeline where+  fmap f (Pipeline count unknownTypes run) = Pipeline count unknownTypes \offset usePreparedStatements oidCache cache ->+    let (roundtrip, newStatementCache) = run offset usePreparedStatements oidCache cache+     in (fmap f roundtrip, newStatementCache)++instance Applicative Pipeline where+  pure a =+    Pipeline 0 mempty (\_ _ _ cache -> (pure a, cache))++  Pipeline lCount leftUnknownTypes lRun <*> Pipeline rCount rightUnknownTypes rRun =+    let unknownTypes = leftUnknownTypes <> rightUnknownTypes+     in Pipeline (lCount + rCount) unknownTypes \offset usePreparedStatements oidCache statementCache ->+          let (lRoundtrip, statementCache1) = lRun offset usePreparedStatements oidCache statementCache+              offset1 = offset + lCount+              (rRoundtrip, statementCache2) = rRun offset1 usePreparedStatements oidCache statementCache1+           in (lRoundtrip <*> rRoundtrip, statementCache2)++-- * Construction++-- |+-- Execute a statement in pipelining mode.+statement ::+  Statement.Statement params result ->+  params ->+  Pipeline result+statement stmt params =+  Pipeline 1 (Statement.unknownTypes stmt) run+  where+    sql = Statement.sql stmt+    run offset usePreparedStatements oidCache =+      if prepare+        then runPrepared+        else runUnprepared+      where+        (oidList, valueAndFormatList) =+          Statement.compilePreparedStatementData stmt oidCache params++        pqOidList =+          fmap (Pq.Oid . fromIntegral) oidList++        prepare =+          usePreparedStatements && Statement.isPrepared stmt++        context soFarStatementCache =+          Context+            offset+            sql+            (Statement.printer stmt params)+            prepare+            soFarStatementCache++        runPrepared statementCache =+          (roundtrip, newStatementCache)+          where+            (isNew, remoteKey, newStatementCache) =+              case StatementCache.lookup sql pqOidList statementCache of+                Just remoteKey -> (False, remoteKey, statementCache)+                Nothing ->+                  let (remoteKey, newStatementCache) = StatementCache.insert sql pqOidList statementCache+                   in (True, remoteKey, newStatementCache)++            roundtrip =+              when+                isNew+                (Comms.Roundtrip.prepare (context statementCache) remoteKey sql pqOidList)+                *> Comms.Roundtrip.queryPrepared (context newStatementCache) remoteKey encodedParams Pq.Binary decoder'+              where+                encodedParams =+                  valueAndFormatList+                    & fmap (fmap (\(bytes, format) -> (bytes, bool Pq.Binary Pq.Text format)))++        runUnprepared statementCache =+          (roundtrip, statementCache)+          where+            roundtrip =+              Comms.Roundtrip.queryParams (context statementCache) sql encodedParams Pq.Binary decoder'+              where+                encodedParams =+                  Statement.compileUnpreparedStatementData stmt oidCache params+                    & fmap (fmap (\(oid, bytes, format) -> (Pq.Oid (fromIntegral oid), bytes, bool Pq.Binary Pq.Text format)))++        decoder' =+          RequestingOid.toBase (Statement.decoder stmt) oidCache
+ src/library/Hasql/Engine/Contexts/Session.hs view
@@ -0,0 +1,208 @@+module Hasql.Engine.Contexts.Session where++import Data.HashMap.Strict qualified as HashMap+import Data.HashSet qualified as HashSet+import Hasql.Codecs.RequestingOid qualified as RequestingOid+import Hasql.Codecs.Vocab.OidCache qualified as OidCache+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Comms.Roundtrip qualified as Comms.Roundtrip+import Hasql.Engine.Contexts.Pipeline qualified as Pipeline+import Hasql.Engine.Errors qualified as Errors+import Hasql.Engine.PqProcedures.SelectTypeInfo qualified as PqProcedures.SelectTypeInfo+import Hasql.Engine.Statement qualified as Statement+import Hasql.Engine.Structures.ConnectionState qualified as ConnectionState+import Hasql.Engine.Structures.StatementCache qualified as StatementCache+import Hasql.Platform.Prelude+import Hasql.Pq qualified as Pq++-- |+-- A sequence of operations to be executed in the context of a single database connection with exclusive access to it.+--+-- Construct sessions using helpers in this module such as+-- 'statement', 'pipeline' and 'script', or use 'onLibpqConnection' for a low-level+-- escape hatch.+--+-- To actually execute a 'Session' use 'Hasql.Connection.use', which manages+-- concurrent access to the shared connection state and returns either a+-- 'Errors.SessionError' or the result:+--+-- > result <- Hasql.Connection.use connection mySession+--+-- Note: while most session errors are returned as values, user code executed+-- inside a session may still throw exceptions; in that case the driver will+-- reset the connection to a clean state.+newtype Session a+  = Session (ConnectionState.ConnectionState -> IO (Either Errors.SessionError a, ConnectionState.ConnectionState))+  deriving+    (Functor, Applicative, Monad, MonadError Errors.SessionError, MonadIO)+    via (ExceptT Errors.SessionError (StateT ConnectionState.ConnectionState IO))++run :: Session a -> ConnectionState.ConnectionState -> IO (Either Errors.SessionError a, ConnectionState.ConnectionState)+run (Session session) connectionState = session connectionState++-- |+-- Possibly a multi-statement query,+-- which however cannot be parameterized or prepared,+-- nor can any results of it be collected.+script :: ByteString -> Session ()+script sql =+  Session \connectionState -> do+    let connection = ConnectionState.connection connectionState+    result <- Comms.Roundtrip.toSerialIO (Comms.Roundtrip.script (Just sql) sql) connection+    case result of+      Left err -> case err of+        Comms.Roundtrip.ClientError _ details -> do+          pure+            ( Left (Errors.ConnectionSessionError (maybe "" decodeUtf8Lenient details)),+              connectionState+            )+        Comms.Roundtrip.ServerError recvError ->+          pure+            ( Left (Errors.fromRecvErrorInScript sql recvError),+              connectionState+            )+      Right () ->+        pure+          ( Right (),+            connectionState+          )++-- |+-- Execute a single statement by providing parameters to it,+-- running it directly in serial mode.+--+-- Each execution is a dedicated network roundtrip. The first execution of a+-- preparable statement costs an extra roundtrip (a separate @PARSE@), after+-- which steady-state execution is a single roundtrip.+--+-- To batch multiple statements into fewer roundtrips, use 'pipeline' instead.+statement ::+  Statement.Statement params result ->+  params ->+  Session result+statement stmt params =+  Session \connectionState -> do+    let usePreparedStatements = ConnectionState.preparedStatements connectionState+        statementCache = ConnectionState.statementCache connectionState+        oidCache = ConnectionState.oidCache connectionState+        connection = ConnectionState.connection connectionState+        sql = Statement.sql stmt+        missingTypes = OidCache.selectUnknownNames (Statement.unknownTypes stmt) oidCache+    resolvedOidCache <-+      if HashSet.null missingTypes+        then pure (Right oidCache)+        else do+          oidCacheUpdates <-+            PqProcedures.SelectTypeInfo.run connection (PqProcedures.SelectTypeInfo.SelectTypeInfo missingTypes)+          pure $ case oidCacheUpdates of+            Left err -> Left err+            Right oidCacheUpdates ->+              let foundTypes = HashMap.keysSet oidCacheUpdates+                  notFoundTypes = HashSet.difference missingTypes foundTypes+               in if not (HashSet.null notFoundTypes)+                    then Left (Errors.MissingTypesSessionError (HashSet.map Vocab.QualifiedTypeName.toNameTuple notFoundTypes))+                    else Right (oidCache <> OidCache.fromHashMap oidCacheUpdates)+    case resolvedOidCache of+      Left err -> pure (Left err, connectionState)+      Right newOidCache -> do+        let decoder' = RequestingOid.toBase (Statement.decoder stmt) newOidCache+            prepared = usePreparedStatements && Statement.isPrepared stmt+            -- Single-statement context for error reporting:+            -- total statements 1, index 0.+            context = Just (1, 0, sql, Statement.printer stmt params, prepared)+            mapError = \case+              Comms.Roundtrip.ClientError _ details ->+                Errors.ConnectionSessionError (maybe "" decodeUtf8Lenient details)+              Comms.Roundtrip.ServerError recvError ->+                Errors.fromRecvError recvError+            withState (result, newStatementCache) =+              ( first mapError result,+                connectionState+                  { ConnectionState.oidCache = newOidCache,+                    ConnectionState.statementCache = newStatementCache+                  }+              )+        fmap withState+          $ if prepared+            then do+              let (oidList, valueAndFormatList) =+                    Statement.compilePreparedStatementData stmt newOidCache params+                  pqOidList = fmap (Pq.Oid . fromIntegral) oidList+                  encodedParams =+                    valueAndFormatList+                      & fmap (fmap (\(bytes, format) -> (bytes, bool Pq.Binary Pq.Text format)))+                  execute remoteKey =+                    Comms.Roundtrip.toSerialIO+                      (Comms.Roundtrip.queryPrepared context remoteKey encodedParams Pq.Binary decoder')+                      connection+              case StatementCache.lookup sql pqOidList statementCache of+                Just remoteKey -> do+                  result <- execute remoteKey+                  pure (result, statementCache)+                Nothing -> do+                  let (remoteKey, newStatementCache) = StatementCache.insert sql pqOidList statementCache+                  -- In non-pipeline mode PARSE and EXECUTE cannot be sent+                  -- back-to-back, so prepare in a dedicated roundtrip first.+                  prepareResult <-+                    Comms.Roundtrip.toSerialIO+                      (Comms.Roundtrip.prepare context remoteKey sql pqOidList)+                      connection+                  case prepareResult of+                    -- PARSE failed: the statement is not on the server, so+                    -- keep the old cache (no entry committed).+                    Left err -> pure (Left err, statementCache)+                    Right () -> do+                      -- PARSE succeeded, so the statement is on the server+                      -- under remoteKey regardless of whether EXECUTE then+                      -- fails. Commit the cache so a later use hits it instead+                      -- of re-issuing PARSE for an already-existing name.+                      result <- execute remoteKey+                      pure (result, newStatementCache)+            else do+              let encodedParams =+                    Statement.compileUnpreparedStatementData stmt newOidCache params+                      & fmap (fmap (\(oid, bytes, format) -> (Pq.Oid (fromIntegral oid), bytes, bool Pq.Binary Pq.Text format)))+              result <-+                Comms.Roundtrip.toSerialIO+                  (Comms.Roundtrip.queryParams context sql encodedParams Pq.Binary decoder')+                  connection+              pure (result, statementCache)++-- |+-- Execute a pipeline.+pipeline :: Pipeline.Pipeline result -> Session result+pipeline pipeline = Session \connectionState -> do+  let usePreparedStatements = ConnectionState.preparedStatements connectionState+      statementCache = ConnectionState.statementCache connectionState+      oidCache = ConnectionState.oidCache connectionState+      pqConnection = ConnectionState.connection connectionState+   in do+        (result, newOidCache, newStatementCache) <- Pipeline.run pipeline usePreparedStatements pqConnection oidCache statementCache+        let newConnectionState =+              connectionState+                { ConnectionState.oidCache = newOidCache,+                  ConnectionState.statementCache = newStatementCache+                }++        pure (result, newConnectionState)++-- |+-- Execute an operation on the raw libpq connection possibly producing an error and updating the connection.+-- This is a low-level escape hatch for custom integrations.+--+-- You can supply a new connection in the result to replace it in the running Hasql connection.+-- The responsibility to close the old libpq connection is on you.+-- Otherwise, just return the same connection you've received.+--+-- Producing a 'Left' value will cause the session to fail with the given error.+-- Regardless of success or failure, the connection will be replaced with the one you return.+--+-- Throwing exceptions is okay. It will lead to the connection getting reset.+onLibpqConnection ::+  (Pq.Connection -> IO (Either Errors.SessionError a, Pq.Connection)) ->+  Session a+onLibpqConnection f = Session \connectionState -> do+  let pqConnection = ConnectionState.connection connectionState+  (result, newConnection) <- f pqConnection+  let newState = ConnectionState.setConnection newConnection connectionState+  pure (result, newState)
+ src/library/Hasql/Engine/Decoders/Result.hs view
@@ -0,0 +1,95 @@+module Hasql.Engine.Decoders.Result where++import Hasql.Codecs.RequestingOid qualified as RequestingOid+import Hasql.Comms.ResultDecoder qualified as ResultDecoder+import Hasql.Engine.Decoders.Row (Row (..))+import Hasql.Engine.Decoders.Row qualified as Row+import Hasql.Platform.Prelude++-- |+-- Decoder of a query result.+newtype Result a+  = Result (RequestingOid.RequestingOid (ResultDecoder.ResultDecoder a))+  deriving+    (Functor, Applicative, Filterable)+    via (Compose RequestingOid.RequestingOid ResultDecoder.ResultDecoder)++unwrap :: Result a -> RequestingOid.RequestingOid (ResultDecoder.ResultDecoder a)+unwrap (Result decoder) = decoder++-- * Construction++-- |+-- Decode no value from the result.+--+-- Useful for statements like @INSERT@ or @CREATE@.+{-# INLINE noResult #-}+noResult :: Result ()+noResult =+  Result (RequestingOid.lift ResultDecoder.ok)++-- |+-- Get the amount of rows affected by such statements as+-- @UPDATE@ or @DELETE@.+{-# INLINE rowsAffected #-}+rowsAffected :: Result Int64+rowsAffected =+  Result (RequestingOid.lift ResultDecoder.rowsAffected)++-- |+-- Exactly one row.+-- Will raise the 'Hasql.Errors.UnexpectedRowCountStatementError' error if it's any other.+{-# INLINE singleRow #-}+singleRow :: Row a -> Result a+singleRow decoder =+  Result (fmap ResultDecoder.single (Row.toDecoder decoder))++refineResult :: (a -> Either Text b) -> Result a -> Result b+refineResult refiner (Result decoder) =+  Result (fmap (ResultDecoder.refine refiner) decoder)++-- ** Multi-row traversers++-- |+-- Foldl multiple rows.+{-# INLINE foldlRows #-}+foldlRows :: (a -> b -> a) -> a -> Row b -> Result a+foldlRows step init decoder =+  Result+    (fmap (ResultDecoder.foldl step init) (Row.toDecoder decoder))++-- |+-- Foldr multiple rows.+{-# INLINE foldrRows #-}+foldrRows :: (b -> a -> a) -> a -> Row b -> Result a+foldrRows step init decoder =+  Result+    (fmap (ResultDecoder.foldr step init) (Row.toDecoder decoder))++-- ** Specialized multi-row results++-- |+-- Maybe one row or none.+{-# INLINE rowMaybe #-}+rowMaybe :: Row a -> Result (Maybe a)+rowMaybe decoder =+  Result+    (fmap ResultDecoder.maybe (Row.toDecoder decoder))++-- |+-- Zero or more rows packed into the vector.+--+-- It's recommended to prefer this function to 'rowList',+-- since it performs notably better.+{-# INLINE rowVector #-}+rowVector :: Row a -> Result (Vector a)+rowVector decoder =+  Result+    (fmap ResultDecoder.vector (Row.toDecoder decoder))++-- |+-- Zero or more rows packed into the list.+{-# INLINE rowList #-}+rowList :: Row a -> Result [a]+rowList =+  foldrRows strictCons []
+ src/library/Hasql/Engine/Decoders/Row.hs view
@@ -0,0 +1,65 @@+module Hasql.Engine.Decoders.Row where++import Hasql.Codecs.Decoders+import Hasql.Codecs.Decoders.Value qualified as Value+import Hasql.Codecs.RequestingOid qualified as RequestingOid+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo+import Hasql.Comms.RowDecoder qualified+import Hasql.Platform.Prelude+import PostgreSQL.Binary.Decoding qualified as Binary++-- |+-- Decoder of an individual row,+-- which gets composed of column value decoders.+-- E.g.:+--+-- @+-- x :: 'Row' (Maybe Int64, Text, TimeOfDay)+-- x = (,,) '<$>' ('column' . 'nullable') 'int8' '<*>' ('column' . 'nonNullable') 'text' '<*>' ('column' . 'nonNullable') 'time'+-- @+newtype Row a+  = Row (RequestingOid.RequestingOid (Hasql.Comms.RowDecoder.RowDecoder a))+  deriving+    (Functor, Applicative, Filterable)+    via (Compose RequestingOid.RequestingOid Hasql.Comms.RowDecoder.RowDecoder)++toDecoder ::+  Row a ->+  RequestingOid.RequestingOid (Hasql.Comms.RowDecoder.RowDecoder a)+toDecoder (Row f) = f++-- |+-- Lift an individual value decoder to a composable row decoder.+{-# INLINE column #-}+column :: NullableOrNot Value a -> Row a+column = \case+  Nullable valueDecoder ->+    Row case Value.toOid valueDecoder of+      Just oid ->+        fmap+          (Hasql.Comms.RowDecoder.nullableColumn (Just oid) . Binary.valueParser)+          (Value.toDecoder valueDecoder)+      Nothing -> do+        RequestingOid.hoistLookingUp+          (Vocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema valueDecoder) (Value.toTypeName valueDecoder))+          ( \lookupResult decoder ->+              Hasql.Comms.RowDecoder.nullableColumn (Just (chooseLookedUpOid valueDecoder lookupResult)) (Binary.valueParser decoder)+          )+          (Value.toDecoder valueDecoder)+  NonNullable valueDecoder ->+    Row case Value.toOid valueDecoder of+      Just oid ->+        fmap+          (Hasql.Comms.RowDecoder.nonNullableColumn (Just oid) . Binary.valueParser)+          (Value.toDecoder valueDecoder)+      Nothing -> do+        RequestingOid.hoistLookingUp+          (Vocab.QualifiedTypeName.QualifiedTypeName (Value.toSchema valueDecoder) (Value.toTypeName valueDecoder))+          (\lookupResult decoder -> Hasql.Comms.RowDecoder.nonNullableColumn (Just (chooseLookedUpOid valueDecoder lookupResult)) (Binary.valueParser decoder))+          (Value.toDecoder valueDecoder)+  where+    chooseLookedUpOid valueDecoder typeInfo =+      if Value.toDimensionality valueDecoder > 0+        then Vocab.TypeInfo.toArrayOid typeInfo+        else Vocab.TypeInfo.toBaseOid typeInfo
+ src/library/Hasql/Engine/Errors.hs view
@@ -0,0 +1,473 @@+module Hasql.Engine.Errors where++import Hasql.Comms.Recv qualified+import Hasql.Comms.ResultDecoder qualified+import Hasql.Comms.Roundtrip qualified+import Hasql.Comms.RowReader qualified+import Hasql.Platform.Prelude+import TextBuilder qualified++-- * Error types++-- |+-- Error that occurs when attempting to establish a database connection.+--+-- These errors can occur when calling 'Hasql.Connection.acquire'.+-- Connection errors are categorized into several types to help with+-- error handling and logging.+data ConnectionError+  = -- | Network-level error while connecting to the database server.+    --+    -- This typically indicates issues like:+    --+    -- * Server is not reachable (wrong host\/port or server is down)+    -- * Network connectivity problems+    -- * Firewall blocking the connection+    -- * Connection timeout+    --+    -- These errors are transient and the operation can be retried.+    NetworkingConnectionError+      -- | Human readable details intended for logging.+      Text+  | -- | Authentication failed when connecting to the database.+    --+    -- This typically indicates issues like:+    --+    -- * Invalid username or password+    -- * User does not have permission to access the database+    -- * Authentication method mismatch (e.g., server requires SSL but client doesn't use it)+    --+    -- These errors are not transient and require fixing the credentials or permissions.+    AuthenticationConnectionError+      -- | Human readable details intended for logging.+      Text+  | -- | Compatibility issue between client and server.+    --+    -- This typically indicates issues like:+    --+    -- * Server version is too old or too new+    -- * Required PostgreSQL features are not available+    -- * Protocol version mismatch+    --+    -- These errors are not transient and require upgrading/downgrading+    -- the server or client.+    CompatibilityConnectionError+      -- | Human readable details intended for logging.+      Text+  | -- | Uncategorized error coming from @libpq@.+    --+    -- This is a catch-all for connection errors that don't fit into other categories.+    -- The error message may be empty if @libpq@ doesn't provide details.+    --+    -- These errors are not transient by default.+    OtherConnectionError+      -- | Human readable details intended for logging. May be empty.+      Text+  deriving stock (Show, Eq)++-- |+-- Error that occurs during session execution.+--+-- A session is a batch of actions executed in a database connection context.+-- Session errors can occur due to statement failures, connection issues,+-- missing types, or internal driver errors.+--+-- Session errors provide detailed context to help diagnose problems,+-- including SQL text, parameters, and the location of the error within+-- a pipeline of statements.+data SessionError+  = -- | An error occurred while executing a statement in the session.+    --+    -- This wraps statement-level errors and provides additional context about:+    --+    -- * Which statement in the pipeline failed (when multiple statements are batched)+    -- * The SQL text and parameters of the failing statement+    -- * Whether the statement was prepared or unprepared+    --+    -- The error message includes formatted output showing all this context,+    -- making it easier to diagnose issues in production.+    StatementSessionError+      -- | Total number of statements in the running pipeline. 1 if it's executed alone.+      Int+      -- | 0-based index of the statement that failed. 0 if it's executed alone.+      Int+      -- | SQL template of the failing statement.+      Text+      -- | Parameter values as text (for logging purposes).+      [Text]+      -- | Whether the statement was executed as a prepared one.+      Bool+      -- | The underlying statement error.+      StatementError+  | -- | An error occurred while executing a script.+    --+    -- Scripts are multi-statement SQL texts executed via 'Hasql.Session.script'.+    -- Unlike regular statements, scripts don't support parameters or result decoding,+    -- and errors are limited to server-reported issues.+    ScriptSessionError+      -- | The SQL text of the script.+      Text+      -- | The server error that occurred.+      ServerError+  | -- | A connection-level error occurred during session execution.+    --+    -- This indicates that the connection to the database was lost or+    -- became unusable during the session. These errors are transient+    -- and the operation can be retried with a new connection.+    --+    -- Note: As of version 1.10, connections recover from async exceptions+    -- without resetting, preserving connection-local state.+    ConnectionSessionError+      -- | Human-readable details about the connection error.+      Text+  | -- | One or more types referenced in the statement could not be found in the database.+    --+    -- This occurs when using custom types (enums, composite types, domains) that+    -- are resolved by name at runtime, but the types don't exist in the database.+    --+    -- To fix this error:+    --+    -- * Ensure the types are defined in the database+    -- * Check that schema search paths are configured correctly+    -- * Verify that the type names in your code match those in the database+    MissingTypesSessionError+      -- | Set of (schema name, type name) pairs that could not be found.+      --+      -- Schema name is 'Nothing' when the type was looked up without a schema qualifier.+      (HashSet (Maybe Text, Text))+  | -- | An internal driver error occurred.+    --+    -- This indicates either:+    --+    -- * A bug in Hasql+    -- * The PostgreSQL server misbehaving+    -- * An unexpected response from the server+    --+    -- If you encounter this error, please report it as a bug.+    DriverSessionError+      -- | Human-readable details about what went wrong.+      Text+  deriving stock (Show, Eq)++-- |+-- Error that occurs when executing a single statement.+--+-- Statement errors can be caused by server-side issues (SQL errors, constraint violations)+-- or by mismatches between the decoder specification and the actual result structure+-- (wrong number of rows/columns, type mismatches, or cell-level decoding failures).+data StatementError+  = -- | The server rejected the statement and returned an error.+    --+    -- This includes SQL syntax errors, constraint violations, permission errors,+    -- and any other error reported by PostgreSQL during statement execution.+    ServerStatementError ServerError+  | -- | The statement returned a different number of rows than expected.+    --+    -- This occurs when using result decoders like @Decoders.singleRow@ or+    -- @Decoders.rowsAffectedAtLeast@ that have specific row count expectations.+    UnexpectedRowCountStatementError+      -- | Expected minimum number of rows.+      Int+      -- | Expected maximum number of rows.+      Int+      -- | Actual number of rows returned.+      Int+  | -- | The statement returned a different number of columns than expected.+    --+    -- This indicates a mismatch between the decoder specification and the+    -- actual result structure, possibly due to:+    --+    -- * Schema changes (columns added or removed)+    -- * Wrong query (selecting different columns than expected)+    -- * Decoder configuration error+    UnexpectedColumnCountStatementError+      -- | Expected number of columns.+      Int+      -- | Actual number of columns returned.+      Int+  | -- | A column has a different type than expected.+    --+    -- This occurs when the decoder expects a specific PostgreSQL type (by OID)+    -- but the actual column has a different type. This can happen due to:+    --+    -- * Schema changes (column type changed)+    -- * Wrong query (selecting wrong column or using a cast)+    -- * Decoder configuration error+    --+    -- Note: As of version 1.10, Hasql performs strict type checking and will+    -- report this error instead of attempting automatic type coercion.+    UnexpectedColumnTypeStatementError+      -- | 0-based column index where the type mismatch occurred.+      Int+      -- | Expected PostgreSQL type OID.+      Word32+      -- | Actual PostgreSQL type OID of the column.+      Word32+  | -- | An error occurred while decoding a specific row.+    --+    -- This wraps errors that occur at the row or cell level, providing+    -- context about which row failed.+    RowStatementError+      -- | 0-based index of the row that failed to decode.+      Int+      -- | The underlying row-level error.+      RowError+  | -- | The database returned an unexpected result structure.+    --+    -- This is a catch-all error that indicates either:+    --+    -- * An improper statement (e.g., executing a query that doesn't match expectations)+    -- * A schema mismatch between the code and database+    -- * A bug in Hasql or server misbehavior+    UnexpectedResultStatementError+      -- | Human-readable details about what went wrong.+      Text+  deriving stock (Show, Eq)++-- |+-- Error reported by the PostgreSQL server when executing a statement.+--+-- The server provides structured error information including error codes+-- (SQL state), messages, and optional context like hints and position information.+--+-- For a complete list of PostgreSQL error codes, see:+-- <https://www.postgresql.org/docs/current/errcodes-appendix.html>+data ServerError+  = ServerError+      -- | SQL State Code (SQLSTATE).+      --+      -- A five-character code that identifies the error class and condition.+      -- Examples: @\"23505\"@ (unique violation), @\"42P01\"@ (undefined table).+      Text+      -- | Primary error message.+      --+      -- A human-readable description of the error.+      Text+      -- | Optional detailed error information.+      --+      -- Additional context about the error, if available.+      (Maybe Text)+      -- | Optional hint for resolving the error.+      --+      -- A suggestion for how to fix the problem, if available.+      (Maybe Text)+      -- | Optional position in the SQL string where the error occurred.+      --+      -- A 1-based character index into the SQL string, if the error+      -- relates to a specific location in the query.+      (Maybe Int)+  deriving stock (Show, Eq)++-- |+-- Error that occurs when decoding a result row.+--+-- Row errors indicate problems when processing an individual row from the result set,+-- either at the cell level or during row refinement/validation.+data RowError+  = -- | An error occurred while decoding a specific cell in the row.+    --+    -- This wraps cell-level errors (null handling, deserialization failures)+    -- and provides context about which column failed and its type.+    CellRowError+      -- | 0-based index of the column where the error occurred.+      Int+      -- | PostgreSQL type OID of the column, as reported by the server.+      Word32+      -- | The underlying cell-level error.+      CellError+  | -- | A refinement or validation error when processing the row.+    --+    -- This occurs when using refinement functions in row decoders+    -- (e.g., with 'Decoders.refineRow') to validate or transform+    -- decoded values. The refinement function rejected the row data.+    RefinementRowError+      -- | Human-readable details about why the refinement failed.+      Text+  deriving stock (Show, Eq)++-- |+-- Error that occurs when decoding a single cell (column value) in a result row.+--+-- Cell errors indicate problems with individual values returned by the database,+-- such as unexpected nulls or failures in binary deserialization.+data CellError+  = -- | A NULL value was encountered when a non-NULL value was expected.+    --+    -- This occurs when using non-nullable decoders (e.g., @Decoders.nonNullable@)+    -- on a column that contains a NULL value.+    UnexpectedNullCellError+  | -- | Failed to deserialize the cell value from its binary representation.+    --+    -- This can occur when:+    --+    -- * The binary data is corrupted+    -- * The decoder doesn't match the actual data type+    -- * The data format is invalid for the expected type+    DeserializationCellError+      -- | Human-readable error message describing what went wrong.+      Text+  deriving stock (Show, Eq)++fromRoundtripError :: Hasql.Comms.Roundtrip.Error context -> SessionError+fromRoundtripError = \case+  Hasql.Comms.Roundtrip.ClientError _context details ->+    ConnectionSessionError (maybe "" decodeUtf8Lenient details)+  Hasql.Comms.Roundtrip.ServerError recvError ->+    fromRecvError (Nothing <$ recvError)++fromRecvError :: Hasql.Comms.Recv.Error (Maybe (Int, Int, ByteString, [Text], Bool)) -> SessionError+fromRecvError = \case+  Hasql.Comms.Recv.ResultError location _resultOffset resultError ->+    case location of+      Nothing ->+        (DriverSessionError . TextBuilder.toText . mconcat)+          [ "Unexpected error outside of statement context. ",+            "This indicates a bug in Hasql or the server misbehaving. ",+            "Error: ",+            TextBuilder.string (show resultError)+          ]+      Just (totalStatements, statementIndex, sql, parameters, prepared) ->+        StatementSessionError+          totalStatements+          statementIndex+          (decodeUtf8Lenient sql)+          parameters+          prepared+          (fromStatementResultError resultError)+  Hasql.Comms.Recv.NoResultsError location details ->+    case location of+      Nothing ->+        (DriverSessionError . TextBuilder.toText . mconcat)+          [ "Unexpectedly got no results outside of statement context. ",+            "This indicates a bug in Hasql or the server misbehaving. ",+            "Details: ",+            TextBuilder.string (show details)+          ]+      Just (totalStatements, statementIndex, sql, parameters, prepared) ->+        StatementSessionError+          totalStatements+          statementIndex+          (decodeUtf8Lenient sql)+          parameters+          prepared+          (UnexpectedRowCountStatementError 1 1 0)+  Hasql.Comms.Recv.TooManyResultsError location actual ->+    case location of+      Nothing ->+        (DriverSessionError . TextBuilder.toText . mconcat)+          [ "Unexpectedly got too many results outside of statement context. ",+            "This indicates a bug in Hasql or the server misbehaving. ",+            "Amount: ",+            TextBuilder.decimal actual+          ]+      Just (totalStatements, statementIndex, sql, parameters, prepared) ->+        StatementSessionError+          totalStatements+          statementIndex+          (decodeUtf8Lenient sql)+          parameters+          prepared+          (UnexpectedRowCountStatementError 1 1 actual)++fromStatementResultError :: Hasql.Comms.ResultDecoder.Error -> StatementError+fromStatementResultError = \case+  Hasql.Comms.ResultDecoder.ServerError code message detail hint position ->+    ServerStatementError+      ( ServerError+          (decodeUtf8Lenient code)+          (decodeUtf8Lenient message)+          (fmap decodeUtf8Lenient detail)+          (fmap decodeUtf8Lenient hint)+          position+      )+  Hasql.Comms.ResultDecoder.UnexpectedResult msg ->+    UnexpectedResultStatementError msg+  Hasql.Comms.ResultDecoder.UnexpectedRowCount actual ->+    UnexpectedRowCountStatementError 1 1 actual+  Hasql.Comms.ResultDecoder.UnexpectedColumnCount expected actual ->+    UnexpectedColumnCountStatementError expected actual+  Hasql.Comms.ResultDecoder.DecoderTypeMismatch colIdx expectedOid actualOid ->+    UnexpectedColumnTypeStatementError+      colIdx+      expectedOid+      actualOid+  Hasql.Comms.ResultDecoder.RowError rowIndex rowError ->+    case rowError of+      Hasql.Comms.RowReader.CellError column oid cellErr ->+        RowStatementError+          rowIndex+          ( CellRowError+              column+              oid+              ( case cellErr of+                  Hasql.Comms.RowReader.DecodingCellError msg -> DeserializationCellError msg+                  Hasql.Comms.RowReader.UnexpectedNullCellError -> UnexpectedNullCellError+              )+          )+      Hasql.Comms.RowReader.RefinementError msg ->+        RowStatementError+          rowIndex+          (RefinementRowError msg)++fromRecvErrorInScript :: ByteString -> Hasql.Comms.Recv.Error (Maybe ByteString) -> SessionError+fromRecvErrorInScript scriptSql = \case+  Hasql.Comms.Recv.ResultError _ _ resultError ->+    case resultError of+      Hasql.Comms.ResultDecoder.ServerError code message detail hint position ->+        ScriptSessionError+          (decodeUtf8Lenient scriptSql)+          ( ServerError+              (decodeUtf8Lenient code)+              (decodeUtf8Lenient message)+              (fmap decodeUtf8Lenient detail)+              (fmap decodeUtf8Lenient hint)+              position+          )+      Hasql.Comms.ResultDecoder.UnexpectedResult msg ->+        (DriverSessionError . TextBuilder.toText . mconcat)+          [ "Unexpected result in script: ",+            TextBuilder.text msg+          ]+      Hasql.Comms.ResultDecoder.UnexpectedRowCount actual ->+        (DriverSessionError . TextBuilder.toText . mconcat)+          [ "Unexpected amount of rows in script: ",+            TextBuilder.decimal actual+          ]+      Hasql.Comms.ResultDecoder.UnexpectedColumnCount expected actual ->+        (DriverSessionError . TextBuilder.toText . mconcat)+          [ "Unexpected amount of columns in script: expected ",+            TextBuilder.decimal expected,+            ", got ",+            TextBuilder.decimal actual+          ]+      Hasql.Comms.ResultDecoder.DecoderTypeMismatch colIdx expectedOid actualOid ->+        (DriverSessionError . TextBuilder.toText . mconcat)+          [ "Decoder type mismatch in script: expected OID ",+            TextBuilder.string (show expectedOid),+            " at column ",+            TextBuilder.decimal colIdx,+            ", got ",+            TextBuilder.string (show actualOid)+          ]+      Hasql.Comms.ResultDecoder.RowError rowIndex rowError ->+        (DriverSessionError . TextBuilder.toText . mconcat)+          [ "Row error in script at row ",+            TextBuilder.decimal rowIndex,+            ": ",+            TextBuilder.string (show rowError)+          ]+  Hasql.Comms.Recv.NoResultsError _ details ->+    (DriverSessionError . TextBuilder.toText . mconcat)+      [ "Got no results in script.",+        " This indicates a bug in Hasql or the server misbehaving.",+        details+          & filter (/= "")+          & foldMap (mappend " Details: " . TextBuilder.text . decodeUtf8Lenient)+      ]+  Hasql.Comms.Recv.TooManyResultsError _ actual ->+    (DriverSessionError . TextBuilder.toText . mconcat)+      [ "Got too many results in script. ",+        "This indicates a bug in Hasql or the server misbehaving. ",+        "Amount: ",+        TextBuilder.decimal actual+      ]
+ src/library/Hasql/Engine/PqProcedures/SelectTypeInfo.hs view
@@ -0,0 +1,118 @@+module Hasql.Engine.PqProcedures.SelectTypeInfo+  ( SelectTypeInfo (..),+    SelectTypeInfoResult,+    run,+  )+where++import Data.HashMap.Strict qualified as HashMap+import Data.HashSet qualified as HashSet+import Hasql.Codecs.Decoders.Value qualified as Decoders.Value+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName+import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo+import Hasql.Comms.ResultDecoder qualified+import Hasql.Comms.Roundtrip qualified+import Hasql.Comms.RowDecoder qualified+import Hasql.Engine.Errors qualified as Errors+import Hasql.Platform.Prelude+import Hasql.Pq qualified as Pq+import PostgreSQL.Binary.Encoding qualified as Binary++newtype SelectTypeInfo = SelectTypeInfo+  { -- | Set of (schema name, type name) pairs to look up.+    keys :: HashSet Vocab.QualifiedTypeName+  }++-- | Result maps (schema name, type name) pairs to TypeInfo (scalar OID, array OID).+type SelectTypeInfoResult =+  HashMap Vocab.QualifiedTypeName Vocab.TypeInfo.TypeInfo++run :: Pq.Connection -> SelectTypeInfo -> IO (Either Errors.SessionError SelectTypeInfoResult)+run connection (SelectTypeInfo keys) =+  if HashSet.null keys+    then pure (Right HashMap.empty)+    else+      first Errors.fromRoundtripError+        <$> Hasql.Comms.Roundtrip.toSerialIO (roundtrip (SelectTypeInfo keys)) connection++sql :: ByteString+sql =+  "with\n\+  \  inputs as (\n\+  \    select *\n\+  \    from unnest($1, $2) as x(schema_name, type_name)\n\+  \  ),\n\+  \  unnamespaced_results as (\n\+  \    select\n\+  \      null :: text as schema_name,\n\+  \      pg_type.typname :: text as type_name,\n\+  \      pg_type.oid :: int4 as type_oid,\n\+  \      pg_type.typarray :: int4 as array_oid\n\+  \    from inputs\n\+  \    join pg_type on pg_type.oid = to_regtype(inputs.type_name)\n\+  \    where inputs.schema_name is null\n\+  \  ),\n\+  \  namespaced_results as (\n\+  \    select\n\+  \      pg_namespace.nspname :: text as schema_name,\n\+  \      pg_type.typname :: text as type_name,\n\+  \      pg_type.oid :: int4 as type_oid,\n\+  \      pg_type.typarray :: int4 as array_oid\n\+  \    from inputs\n\+  \    join pg_namespace on pg_namespace.nspname = inputs.schema_name\n\+  \    join pg_type\n\+  \      on pg_type.typname = inputs.type_name\n\+  \      and pg_type.typnamespace = pg_namespace.oid\n\+  \    where inputs.schema_name is not null\n\+  \  )\n\+  \select * from unnamespaced_results\n\+  \union\n\+  \select * from namespaced_results"++roundtrip :: SelectTypeInfo -> Hasql.Comms.Roundtrip.Roundtrip () SelectTypeInfoResult+roundtrip params =+  Hasql.Comms.Roundtrip.queryParams () sql (encodeParams params) Pq.Binary decoder++-- | Encode the two text-array parameters directly.+-- Text OID is 25; text-array OID is 1009.+encodeParams :: SelectTypeInfo -> [Maybe (Pq.Oid, ByteString, Pq.Format)]+encodeParams (SelectTypeInfo keys) =+  let (schemaNames, typeNames) = unzip (fmap Vocab.QualifiedTypeName.toNameTuple (HashSet.toList keys))+      schemaArray = Binary.encodingBytes (Binary.array 25 (encodeTextArray (encodeMaybeText schemaNames)))+      typeArray = Binary.encodingBytes (Binary.array 25 (encodeTextArray (fmap (Binary.encodingArray . Binary.text_strict) typeNames)))+   in [ Just (Pq.Oid 1009, schemaArray, Pq.Binary),+        Just (Pq.Oid 1009, typeArray, Pq.Binary)+      ]+  where+    encodeTextArray elements =+      Binary.dimensionArray foldl' id elements+    encodeMaybeText =+      fmap \case+        Nothing -> Binary.nullArray+        Just text -> Binary.encodingArray (Binary.text_strict text)++decoder :: Hasql.Comms.ResultDecoder.ResultDecoder SelectTypeInfoResult+decoder =+  Hasql.Comms.ResultDecoder.foldl step HashMap.empty rowDecoder+  where+    step acc (schemaName, typeName, typeOid, arrayOid) =+      HashMap.insert (Vocab.QualifiedTypeName.QualifiedTypeName schemaName typeName) (Vocab.TypeInfo.TypeInfo typeOid arrayOid) acc++rowDecoder :: Hasql.Comms.RowDecoder.RowDecoder (Maybe Text, Text, Word32, Word32)+rowDecoder =+  (,,,)+    <$> nullableColumn Decoders.Value.text+    <*> nonNullableColumn Decoders.Value.text+    <*> nonNullableColumn (fromIntegral <$> Decoders.Value.int4)+    <*> nonNullableColumn (fromIntegral <$> Decoders.Value.int4)+  where+    nullableColumn valueDecoder =+      Hasql.Comms.RowDecoder.nullableColumn+        (Decoders.Value.toBaseOid valueDecoder)+        (Decoders.Value.toByteStringParser valueDecoder mempty)++    nonNullableColumn valueDecoder =+      Hasql.Comms.RowDecoder.nonNullableColumn+        (Decoders.Value.toBaseOid valueDecoder)+        (Decoders.Value.toByteStringParser valueDecoder mempty)
+ src/library/Hasql/Engine/Statement.hs view
@@ -0,0 +1,188 @@+module Hasql.Engine.Statement+  ( Statement (..),+    preparable,+    unpreparable,+    refineResult,+    toSql,+    compilePreparedStatementData,+    compileUnpreparedStatementData,+  )+where++import Data.Text.Encoding qualified as TextEncoding+import Data.Vector qualified as Vector+import Hasql.Codecs.Encoders.Params qualified as Params+import Hasql.Codecs.RequestingOid qualified as RequestingOid+import Hasql.Codecs.Vocab qualified as Vocab+import Hasql.Codecs.Vocab.OidCache qualified as Vocab.OidCache+import Hasql.Codecs.Vocab.ParamMeta (ParamMeta (..))+import Hasql.Codecs.Vocab.TypeRef qualified as Vocab.TypeRef+import Hasql.Comms.ResultDecoder qualified as ResultDecoder+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Engine.Decoders.Result qualified as Decoders.Result+import Hasql.Platform.Prelude++-- |+-- Specification of a strictly single-statement query, which can be parameterized and prepared.+-- It encapsulates the mapping of parameters and results in association with an SQL template.+--+-- Following is an example of a declaration of a prepared statement with its associated codecs.+--+-- @+-- selectSum :: 'Statement' (Int64, Int64) Int64+-- selectSum =+--   'preparable' sql encoder decoder+--   where+--     sql =+--       \"select ($1 + $2)\"+--     encoder =+--       ('fst' '>$<' Encoders.'Hasql.Encoders.param' (Encoders.'Hasql.Encoders.nonNullable' Encoders.'Hasql.Encoders.int8')) '<>'+--       ('snd' '>$<' Encoders.'Hasql.Encoders.param' (Encoders.'Hasql.Encoders.nonNullable' Encoders.'Hasql.Encoders.int8'))+--     decoder =+--       Decoders.'Hasql.Decoders.singleRow' (Decoders.'Hasql.Decoders.column' (Decoders.'Hasql.Decoders.nonNullable' Decoders.'Hasql.Decoders.int8'))+-- @+--+-- The statement above accepts a product of two parameters of type 'Int64'+-- and produces a single result of type 'Int64'.+data Statement params result+  = Statement+  { -- | SQL template pre-encoded as UTF-8 for execution.+    sql :: ByteString,+    -- | Frozen per-parameter metadata: type reference, dimensionality, text-format flag.+    -- Produced once at construction from the Params DList and reused across executions.+    columnsMetadata :: Vector ParamMeta,+    -- | Serialise params to encoded wire values given a resolved OID cache.+    serializer :: Vocab.OidCache -> params -> [Maybe ByteString],+    -- | Render params in human-readable form (for error reporting).+    printer :: params -> [Text],+    -- | Union of encoder and decoder unknown types, resolved once at construction.+    unknownTypes :: HashSet Vocab.QualifiedTypeName,+    -- | Unwrapped result decoder (RequestingOid layer already peeled from Result).+    decoder :: RequestingOid.RequestingOid (ResultDecoder.ResultDecoder result),+    -- | Whether this statement may be prepared on the server.+    isPrepared :: Bool+  }++-- |+-- Construct a preparable statement.+--+-- Use this for statements that will be executed multiple times with different parameters.+-- Preparable statements are cached by PostgreSQL, which avoids reconstructing the execution plan each time.+--+-- Suitable for applications with a limited amount of queries that don't generate SQL dynamically.+preparable ::+  -- | SQL template with parameters in positional notation (@$1@, @$2@, etc.)+  Text ->+  -- | Parameters encoder+  Encoders.Params params ->+  -- | Result decoder+  Decoders.Result result ->+  Statement params result+preparable sqlText encoder resultDecoder =+  Statement+    { sql = TextEncoding.encodeUtf8 sqlText,+      columnsMetadata = Params.toColumnsMetadata encoder,+      serializer = Params.toSerializer encoder,+      printer = Params.toPrinter encoder,+      unknownTypes = Params.toUnknownTypes encoder <> RequestingOid.toUnknownTypes rawDecoder,+      decoder = rawDecoder,+      isPrepared = True+    }+  where+    rawDecoder = Decoders.Result.unwrap resultDecoder++-- |+-- Construct an unpreparable statement.+--+-- Use this for statements that are dynamically generated or executed only once.+-- Unpreparable statements are not cached by PostgreSQL.+--+-- Suitable for dynamic SQL or one-off queries.+unpreparable ::+  -- | SQL template with parameters in positional notation (@$1@, @$2@, etc.)+  Text ->+  -- | Parameters encoder+  Encoders.Params params ->+  -- | Result decoder+  Decoders.Result result ->+  Statement params result+unpreparable sqlText encoder resultDecoder =+  Statement+    { sql = TextEncoding.encodeUtf8 sqlText,+      columnsMetadata = Params.toColumnsMetadata encoder,+      serializer = Params.toSerializer encoder,+      printer = Params.toPrinter encoder,+      unknownTypes = Params.toUnknownTypes encoder <> RequestingOid.toUnknownTypes rawDecoder,+      decoder = rawDecoder,+      isPrepared = False+    }+  where+    rawDecoder = Decoders.Result.unwrap resultDecoder++instance Functor (Statement params) where+  {-# INLINE fmap #-}+  fmap f stmt = stmt {decoder = fmap (fmap f) (decoder stmt)}++instance Filterable (Statement params) where+  {-# INLINE mapMaybe #-}+  mapMaybe filtrator stmt = stmt {decoder = fmap (mapMaybe filtrator) (decoder stmt)}++instance Profunctor Statement where+  {-# INLINE dimap #-}+  dimap f1 f2 stmt =+    stmt+      { serializer = \oidCache -> serializer stmt oidCache . f1,+        printer = printer stmt . f1,+        decoder = fmap (fmap f2) (decoder stmt)+      }++-- |+-- Refine the result of a statement,+-- causing the running session to fail with the 'Hasql.Errors.UnexpectedResultStatementError' error in case of a refinement failure.+--+-- This function is especially useful for refining the results of statements produced with+-- <http://hackage.haskell.org/package/hasql-th the \"hasql-th\" library>.+refineResult :: (a -> Either Text b) -> Statement params a -> Statement params b+refineResult refiner stmt = stmt {decoder = fmap (ResultDecoder.refine refiner) (decoder stmt)}++-- | Extract the SQL template from a statement.+toSql :: Statement params result -> Text+toSql stmt = TextEncoding.decodeUtf8Lenient (sql stmt)++-- | Compile prepared-statement data: resolve OIDs and pair encoded values with their format flags.+compilePreparedStatementData ::+  Statement params result ->+  Vocab.OidCache ->+  params ->+  ([Word32], [Maybe (ByteString, Bool)])+compilePreparedStatementData stmt oidCache params =+  unzip+    $ zipWith+      (\(ParamMeta typeRef dim fmt) encoding -> (resolveOid typeRef dim, fmap (,fmt) encoding))+      (Vector.toList (columnsMetadata stmt))+      (serializer stmt oidCache params)+  where+    resolveOid (Vocab.TypeRef.NamedType name) dim =+      case Vocab.OidCache.lookupTypeNameScalar name oidCache of+        Just oid -> if dim == 0 then oid else fromMaybe 0 (Vocab.OidCache.lookupTypeNameArray name oidCache)+        Nothing -> 0+    resolveOid (Vocab.TypeRef.KnownOid oid) _ = oid++-- | Compile unprepared-statement data: resolve OIDs inline with encoded values.+compileUnpreparedStatementData ::+  Statement params result ->+  Vocab.OidCache ->+  params ->+  [Maybe (Word32, ByteString, Bool)]+compileUnpreparedStatementData stmt oidCache params =+  zipWith+    (\(ParamMeta typeRef dim fmt) encoding -> (,,) <$> Just (resolveOid typeRef dim) <*> encoding <*> Just fmt)+    (Vector.toList (columnsMetadata stmt))+    (serializer stmt oidCache params)+  where+    resolveOid (Vocab.TypeRef.NamedType name) dim =+      case Vocab.OidCache.lookupTypeNameScalar name oidCache of+        Just oid -> if dim == 0 then oid else fromMaybe 0 (Vocab.OidCache.lookupTypeNameArray name oidCache)+        Nothing -> 0+    resolveOid (Vocab.TypeRef.KnownOid oid) _ = oid
+ src/library/Hasql/Engine/Structures/ConnectionState.hs view
@@ -0,0 +1,98 @@+-- |+-- This module defines the internal state of a database connection.+module Hasql.Engine.Structures.ConnectionState+  ( ConnectionState (..),+    toStatementCache,+    fromConnection,+    setPreparedStatements,+    setStatementCache,+    setConnection,+    setOidCache,+    mapStatementCache,+    mapOidCache,+    traverseStatementCache,+    resetPreparedStatementsCache,+  )+where++import Hasql.Codecs.Vocab.OidCache qualified as OidCache+import Hasql.Engine.Structures.StatementCache qualified as StatementCache+import Hasql.Platform.Prelude+import 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 view
@@ -0,0 +1,56 @@+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/Errors.hs view
@@ -0,0 +1,226 @@+-- |+-- Explicit error types for all Hasql operations.+--+-- This module provides access to all error types used throughout Hasql:+--+-- * 'ConnectionError' - errors that occur when establishing a database connection+-- * 'SessionError' - errors that occur during session execution+--+-- The module follows Hasql's philosophy of explicit error handling,+-- where all errors are represented as values rather than exceptions.+module Hasql.Errors+  ( -- * Error class+    IsError (..),+    toDetailedText,++    -- * Connection errors+    ConnectionError (..),++    -- * Session errors+    SessionError (..),+    StatementError (..),+    RowError (..),+    CellError (..),+    ServerError (..),+  )+where++import Data.HashSet qualified as HashSet+import Data.Text qualified as Text+import Hasql.Engine.Errors+import Hasql.Platform.Prelude+import TextBuilder qualified++-- * Classes++-- | A class for types that can be treated as errors.+class IsError a where+  -- | Convert the error to a human-readable message with no dynamic details.+  toMessage :: a -> Text++  -- | Convert the error to a list of key-value pairs of dynamic details.+  toDetails :: a -> [(Text, Text)]++  -- | Whether the error is transient and the operation causing it can be retried.+  isTransient :: a -> Bool++-- | Convert the error to a multiline detailed human-readable text representation containing all details.+toDetailedText :: (IsError e) => e -> Text+toDetailedText = TextBuilder.toText . toDetailedTextBuilder++-- | Convert the error to a multiline detailed human-readable text representation containing all details.+toDetailedTextBuilder :: (IsError e) => e -> TextBuilder+toDetailedTextBuilder err =+  TextBuilder.text (toMessage err)+    <> foldMap+      ( \(key, value) ->+          mconcat+            [ "\n  ",+              TextBuilder.text key,+              case Text.lines value of+                [] -> ":"+                [singleLine] ->+                  ": " <> TextBuilder.text singleLine+                multipleLines ->+                  ":" <> foldMap (mappend "\n    " . TextBuilder.text) multipleLines+            ]+      )+      (toDetails err)++-- * Instances++instance IsError ConnectionError where+  toMessage = \case+    NetworkingConnectionError {} ->+      "Networking error while connecting to the database"+    AuthenticationConnectionError {} ->+      "Authentication error while connecting to the database"+    CompatibilityConnectionError {} ->+      "Compatibility error while connecting to the database"+    OtherConnectionError {} ->+      "Connection error while connecting to the database"++  toDetails = \case+    NetworkingConnectionError reason ->+      [("reason", reason)]+    AuthenticationConnectionError reason ->+      [("reason", reason)]+    CompatibilityConnectionError reason ->+      [("reason", reason)]+    OtherConnectionError reason ->+      [("reason", reason)]++  isTransient = \case+    NetworkingConnectionError {} -> True+    AuthenticationConnectionError {} -> False+    CompatibilityConnectionError {} -> False+    OtherConnectionError {} -> False++instance IsError ServerError where+  toMessage _ =+    "Server error"++  toDetails (ServerError code message detail hint position) =+    mconcat+      [ [("code", code), ("message", message)],+        maybe [] (\d -> [("detail", d)]) detail,+        maybe [] (\h -> [("hint", h)]) hint,+        maybe [] (\p -> [("position", (TextBuilder.toText . TextBuilder.decimal) p)]) position+      ]++  isTransient = const False++instance IsError CellError where+  toMessage = \case+    UnexpectedNullCellError ->+      "Unexpected null value"+    DeserializationCellError {} ->+      "Failed to deserialize cell"++  toDetails = \case+    UnexpectedNullCellError ->+      []+    DeserializationCellError reason ->+      [("reason", reason)]++  isTransient = const False++instance IsError StatementError where+  toMessage = \case+    ServerStatementError executionError ->+      toMessage executionError+    UnexpectedRowCountStatementError {} ->+      "Unexpected number of rows"+    UnexpectedColumnCountStatementError {} ->+      "Unexpected number of columns"+    UnexpectedColumnTypeStatementError {} ->+      "Unexpected column type"+    RowStatementError _ rowError ->+      toMessage rowError+    UnexpectedResultStatementError {} ->+      "Driver error"++  toDetails = \case+    ServerStatementError executionError ->+      toDetails executionError+    UnexpectedRowCountStatementError min max actual ->+      [ ("expectedMin", (TextBuilder.toText . TextBuilder.decimal) min),+        ("expectedMax", (TextBuilder.toText . TextBuilder.decimal) max),+        ("actual", (TextBuilder.toText . TextBuilder.decimal) actual)+      ]+    UnexpectedColumnCountStatementError expected actual ->+      [ ("expected", (TextBuilder.toText . TextBuilder.decimal) expected),+        ("actual", (TextBuilder.toText . TextBuilder.decimal) actual)+      ]+    UnexpectedColumnTypeStatementError colIdx expected actual ->+      [ ("columnIndex", (TextBuilder.toText . TextBuilder.decimal) colIdx),+        ("expectedOid", (TextBuilder.toText . TextBuilder.decimal) expected),+        ("actualOid", (TextBuilder.toText . TextBuilder.decimal) actual)+      ]+    RowStatementError rowIdx rowError ->+      ("rowIndex", (TextBuilder.toText . TextBuilder.decimal) rowIdx) : toDetails rowError+    UnexpectedResultStatementError reason ->+      [("reason", reason)]++  isTransient = const False++instance IsError RowError where+  toMessage = \case+    CellRowError _ _ cellErr ->+      toMessage cellErr+    RefinementRowError {} ->+      "Refinement error"++  toDetails = \case+    CellRowError colIdx oid cellErr ->+      [ ("columnIndex", (TextBuilder.toText . TextBuilder.decimal) colIdx),+        ("oid", (TextBuilder.toText . TextBuilder.decimal) oid)+      ]+        <> toDetails cellErr+    RefinementRowError reason ->+      [("reason", reason)]++  isTransient = const False++instance IsError SessionError where+  toMessage = \case+    StatementSessionError _ _ _ _ _ statementError ->+      toMessage statementError+    ScriptSessionError _ execErr ->+      toMessage execErr+    ConnectionSessionError {} ->+      "Connection error"+    DriverSessionError {} ->+      "Driver error"+    MissingTypesSessionError {} ->+      "Types not found in database"++  toDetails = \case+    StatementSessionError totalStatements statementIndex sql parameters prepared statementError ->+      [ ("totalStatements", (TextBuilder.toText . TextBuilder.decimal) totalStatements),+        ("statementIndex", (TextBuilder.toText . TextBuilder.decimal) statementIndex),+        ("sql", sql),+        ("parameters", Text.intercalate ", " parameters),+        ("prepared", if prepared then "true" else "false")+      ]+        <> toDetails statementError+    ScriptSessionError sql execErr ->+      ("sql", sql) : toDetails execErr+    ConnectionSessionError reason ->+      [("reason", reason)]+    DriverSessionError reason ->+      [("reason", reason)]+    MissingTypesSessionError missingTypes ->+      [ ( "missingTypes",+          (TextBuilder.toText . mconcat . intersperse ", " . fmap formatType . HashSet.toList) missingTypes+        )+      ]+      where+        formatType (schema, name) = maybe "" ((<> ".") . TextBuilder.text) schema <> TextBuilder.text name++  isTransient = \case+    ConnectionSessionError _ -> True+    StatementSessionError {} -> False+    ScriptSessionError {} -> False+    DriverSessionError {} -> False+    MissingTypesSessionError {} -> False
+ src/library/Hasql/Pipeline.hs view
@@ -0,0 +1,13 @@+module Hasql.Pipeline+  ( Pipeline.Pipeline,+    statement,+  )+where++import Hasql.Engine.Contexts.Pipeline qualified as Pipeline+import Hasql.Engine.Statement qualified as Statement++-- |+-- Execute a statement by providing parameters to it.+statement :: params -> Statement.Statement params result -> Pipeline.Pipeline result+statement params stmt = Pipeline.statement stmt params
+ src/library/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 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 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/library/Hasql/Pq.hs view
@@ -0,0 +1,99 @@+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 view
@@ -0,0 +1,25 @@+{-# 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 view
@@ -0,0 +1,71 @@+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/library/Hasql/Session.hs view
@@ -0,0 +1,24 @@+module Hasql.Session+  ( Session.Session,+    Session.pipeline,+    script,+    statement,+    Session.onLibpqConnection,+  )+where++import Hasql.Engine.Contexts.Session qualified as Session+import Hasql.Engine.Statement qualified as Statement+import Hasql.Platform.Prelude++-- |+-- Possibly a multi-statement query,+-- which however cannot be parameterized or prepared,+-- nor can any results of it be collected.+script :: Text -> Session.Session ()+script sql = Session.script (encodeUtf8 sql)++-- |+-- Execute a statement by providing parameters to it.+statement :: params -> Statement.Statement params result -> Session.Session result+statement params stmt = Session.statement stmt params
+ src/library/Hasql/Statement.hs view
@@ -0,0 +1,55 @@+module Hasql.Statement+  ( Statement,+    preparable,+    unpreparable,+    refineResult,+    toSql,++    -- * Recipes++    -- ** Insert many++    -- |+    -- Starting from PostgreSQL 9.4 there is an @unnest@ function which we can use in an analogous way+    -- to haskell's `zip` to pass in multiple arrays of values+    -- to be zipped into the rows to insert as in the following example:+    --+    -- @+    -- insertMultipleLocations :: 'Statement' (Vector (UUID, Double, Double)) ()+    -- insertMultipleLocations =+    --   'preparable' sql encoder decoder+    --   where+    --     sql =+    --       "insert into location (id, x, y) select * from unnest ($1, $2, $3)"+    --     encoder =+    --       Data.Vector.'Data.Vector.unzip3' '>$<'+    --         Contravariant.Extras.contrazip3+    --           (Encoders.'Encoders.param' $ Encoders.'Encoders.nonNullable' $ Encoders.'Encoders.foldableArray' $ Encoders.'Encoders.nonNullable' Encoders.'Encoders.uuid')+    --           (Encoders.'Encoders.param' $ Encoders.'Encoders.nonNullable' $ Encoders.'Encoders.foldableArray' $ Encoders.'Encoders.nonNullable' Encoders.'Encoders.float8')+    --           (Encoders.'Encoders.param' $ Encoders.'Encoders.nonNullable' $ Encoders.'Encoders.foldableArray' $ Encoders.'Encoders.nonNullable' Encoders.'Encoders.float8')+    --     decoder =+    --       Decoders.'Decoders.noResult'+    -- @+    --+    -- While this approach is much more efficient than executing a single-row insert-statement multiple times from within 'Session', a comparable performance can also be achieved by executing a single-insert statement from within a 'Pipeline'.++    -- ** IN and NOT IN++    -- |+    -- There is a common misconception that PostgreSQL supports array+    -- as the parameter for the @IN@ operator.+    -- However Postgres only supports a syntactical list of values with it,+    -- i.e., you have to specify each option as an individual parameter.+    -- E.g., @some_expression IN ($1, $2, $3)@.+    --+    -- Fortunately, Postgres does provide the expected functionality for arrays with other operators:+    --+    -- * Use @some_expression = ANY($1)@ instead of @some_expression IN ($1)@+    -- * Use @some_expression <> ALL($1)@ instead of @some_expression NOT IN ($1)@+    --+    -- For details refer to+    -- <https://www.postgresql.org/docs/9.6/static/functions-comparisons.html#AEN20944 the PostgreSQL docs>.+  )+where++import Hasql.Engine.Statement
+ src/profiling/Main.hs view
@@ -0,0 +1,117 @@+module Main where++import Control.Exception+import Data.Vector qualified as F+import Hasql.Connection qualified as Connection+import Hasql.Connection.Settings qualified as Settings+import Hasql.Decoders qualified as D+import Hasql.Session qualified as B+import Hasql.Statement qualified as Statement+import TestcontainersPostgresql qualified+import Prelude++main :: IO ()+main =+  withConnection \connection -> do+    traceEventIO "START Session"+    result <- Connection.use connection sessionWithManySmallResults+    traceEventIO "STOP Session"+    case result of+      Left err ->+        putStrLn ("Error: " <> show err)+      Right vector -> do+        putStrLn ("Received " <> show (F.length vector) <> " rows")+    return ()++-- * Sessions++sessionWithManySmallParameters :: Vector (Int64, Int64) -> B.Session ()+sessionWithManySmallParameters =+  error "TODO: sessionWithManySmallParameters"++sessionWithSingleLargeResultInVector :: B.Session (Vector (Int64, Int64))+sessionWithSingleLargeResultInVector =+  B.statement () statementWithManyRowsInVector++sessionWithSingleLargeResultInList :: B.Session [(Int64, Int64)]+sessionWithSingleLargeResultInList =+  B.statement () statementWithManyRowsInList++sessionWithManySmallResults :: B.Session (Vector (Int64, Int64))+sessionWithManySmallResults =+  F.replicateM 1000 (B.statement () statementWithSingleRow)++-- * Statements++statementWithManyParameters :: Statement.Statement (Vector (Int64, Int64)) ()+statementWithManyParameters =+  error "TODO: statementWithManyParameters"++statementWithSingleRow :: Statement.Statement () (Int64, Int64)+statementWithSingleRow =+  Statement.preparable template encoder decoder+  where+    template =+      "SELECT 1 :: int8, 2 :: int8"+    encoder =+      conquer+    decoder =+      D.singleRow row+      where+        row =+          tuple <$> (D.column . D.nonNullable) D.int8 <*> (D.column . D.nonNullable) D.int8+          where+            tuple !a !b =+              (a, b)++statementWithManyRows :: (D.Row (Int64, Int64) -> D.Result result) -> Statement.Statement () result+statementWithManyRows decoder =+  Statement.preparable template encoder (decoder rowDecoder)+  where+    template =+      "SELECT generate_series(0,1000) as a, generate_series(1000,2000) as b"+    encoder =+      conquer+    rowDecoder =+      tuple <$> (D.column . D.nonNullable) D.int8 <*> (D.column . D.nonNullable) D.int8+      where+        tuple !a !b =+          (a, b)++statementWithManyRowsInVector :: Statement.Statement () (Vector (Int64, Int64))+statementWithManyRowsInVector =+  statementWithManyRows D.rowVector++statementWithManyRowsInList :: Statement.Statement () [(Int64, Int64)]+statementWithManyRowsInList =+  statementWithManyRows D.rowList++-- * Testcontainers++withConnection :: (Connection.Connection -> IO ()) -> IO ()+withConnection = withConnectionByTagName "postgres:18"++withConnectionByTagName :: Text -> (Connection.Connection -> IO ()) -> IO ()+withConnectionByTagName tagName action = withConnectionSettings tagName \settings -> do+  connection <- Connection.acquire settings+  case connection of+    Left err -> fail ("Connection failed: " <> show err)+    Right conn -> finally (action conn) (Connection.release conn)++withConnectionSettings :: Text -> (Settings.Settings -> IO ()) -> IO ()+withConnectionSettings tagName action = do+  TestcontainersPostgresql.run+    TestcontainersPostgresql.Config+      { tagName,+        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"+              ]+      action settings
− tasty/Main.hs 
@@ -1,499 +0,0 @@-module Main where--import Contravariant.Extras-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 Hasql.TestingUtils.TestingDsl qualified as Session-import Main.Connection qualified as Connection-import Main.Prelude hiding (assert)-import Main.Statements qualified as Statements-import Test.QuickCheck.Instances ()-import Test.Tasty-import Test.Tasty.HUnit-import Test.Tasty.QuickCheck-import Test.Tasty.Runners--main :: IO ()-main =-  defaultMain tree--tree :: TestTree-tree =-  localOption (NumThreads 1)-    $ testGroup-      "All tests"-      [ testGroup "Roundtrips"-          $ let roundtrip encoder decoder input =-                  let session =-                        let statement = Statement.Statement "select $1" encoder decoder True-                         in Session.statement input statement-                   in unsafePerformIO $ do-                        x <- Connection.with (Session.run session)-                        return (Right (Right input) === x)-             in [ testProperty "Array"-                    $ let encoder = Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8)))))-                          decoder = Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.array (Decoders.dimension replicateM (Decoders.element (Decoders.nonNullable Decoders.int8))))))-                       in roundtrip encoder decoder,-                  testProperty "2D Array"-                    $ let encoder = Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8))))))-                          decoder = Decoders.singleRow (Decoders.column (Decoders.nonNullable (Decoders.array (Decoders.dimension replicateM (Decoders.dimension replicateM (Decoders.element (Decoders.nonNullable Decoders.int8)))))))-                       in \list -> list /= [] ==> roundtrip encoder decoder (replicate 3 list)-                ],-        testCase "Failed query"-          $ let statement =-                  Statement.Statement "select true where 1 = any ($1) and $2" encoder decoder True-                  where-                    encoder =-                      contrazip2-                        (Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8))))))-                        (Encoders.param (Encoders.nonNullable (Encoders.text)))-                    decoder =-                      fmap (maybe False (const True)) (Decoders.rowMaybe ((Decoders.column . Decoders.nonNullable) Decoders.bool))-                session =-                  Session.statement ([3, 7], "a") statement-             in do-                  x <- Connection.with (Session.run session)-                  assertBool (show x) $ case x of-                    Right (Left (Session.QueryError "select true where 1 = any ($1) and $2" ["[3, 7]", "\"a\""] _)) -> True-                    _ -> False,-        testCase "IN simulation"-          $ let statement =-                  Statement.Statement "select true where 1 = any ($1)" encoder decoder True-                  where-                    encoder =-                      Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8)))))-                    decoder =-                      fmap (maybe False (const True)) (Decoders.rowMaybe ((Decoders.column . Decoders.nonNullable) Decoders.bool))-                session =-                  do-                    result1 <- Session.statement [1, 2] statement-                    result2 <- Session.statement [2, 3] statement-                    return (result1, result2)-             in do-                  x <- Connection.with (Session.run session)-                  assertEqual (show x) (Right (Right (True, False))) x,-        testCase "NOT IN simulation"-          $ let statement =-                  Statement.Statement "select true where 3 <> all ($1)" encoder decoder True-                  where-                    encoder =-                      Encoders.param (Encoders.nonNullable (Encoders.array (Encoders.dimension foldl' (Encoders.element (Encoders.nonNullable Encoders.int8)))))-                    decoder =-                      fmap (maybe False (const True)) (Decoders.rowMaybe ((Decoders.column . Decoders.nonNullable) Decoders.bool))-                session =-                  do-                    result1 <- Session.statement [1, 2] statement-                    result2 <- Session.statement [2, 3] statement-                    return (result1, result2)-             in do-                  x <- Connection.with (Session.run session)-                  assertEqual (show x) (Right (Right (True, False))) x,-        testCase "Composite decoding"-          $ let statement =-                  Statement.Statement sql encoder decoder True-                  where-                    sql =-                      "select (1, true)"-                    encoder =-                      mempty-                    decoder =-                      Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.composite ((,) <$> (Decoders.field . Decoders.nonNullable) Decoders.int8 <*> (Decoders.field . Decoders.nonNullable) Decoders.bool)))-                session =-                  Session.statement () statement-             in do-                  x <- Connection.with (Session.run session)-                  assertEqual (show x) (Right (Right (1, True))) x,-        testCase "Complex composite decoding"-          $ let statement =-                  Statement.Statement sql encoder decoder True-                  where-                    sql =-                      "select (1, true) as entity1, ('hello', 3) as entity2"-                    encoder =-                      mempty-                    decoder =-                      Decoders.singleRow-                        $ (,)-                        <$> (Decoders.column . Decoders.nonNullable) entity1-                        <*> (Decoders.column . Decoders.nonNullable) entity2-                      where-                        entity1 =-                          Decoders.composite-                            $ (,)-                            <$> (Decoders.field . Decoders.nonNullable) Decoders.int8-                            <*> (Decoders.field . Decoders.nonNullable) Decoders.bool-                        entity2 =-                          Decoders.composite-                            $ (,)-                            <$> (Decoders.field . Decoders.nonNullable) Decoders.text-                            <*> (Decoders.field . Decoders.nonNullable) Decoders.int8-                session =-                  Session.statement () statement-             in do-                  x <- Connection.with (Session.run session)-                  assertEqual (show x) (Right (Right ((1, True), ("hello", 3)))) x,-        testGroup "unknownEnum"-          $ [ testCase "" $ do-                res <- Session.runSessionOnLocalDb $ do-                  let statement =-                        Statement.Statement sql mempty Decoders.noResult True-                        where-                          sql =-                            "drop type if exists mood"-                   in Session.statement () statement-                  let statement =-                        Statement.Statement sql mempty Decoders.noResult True-                        where-                          sql =-                            "create type mood as enum ('sad', 'ok', 'happy')"-                   in Session.statement () statement-                  let statement =-                        Statement.Statement sql encoder decoder True-                        where-                          sql =-                            "select $1"-                          decoder =-                            (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.enum (Just . id))))-                          encoder =-                            Encoders.param (Encoders.nonNullable (Encoders.unknownEnum id))-                   in Session.statement "ok" statement--                assertEqual "" (Right "ok") res-            ],-        testCase "Composite encoding" $ do-          let value =-                (123, 456, 789, "abc")-          res <--            let statement =-                  Statement.Statement sql encoder decoder True-                  where-                    sql =-                      "select $1 :: pg_enum"-                    encoder =-                      Encoders.param-                        . Encoders.nonNullable-                        . Encoders.composite-                        . mconcat-                        $ [ contramap (\(a, _, _, _) -> a) . Encoders.field . Encoders.nonNullable $ Encoders.oid,-                            contramap (\(_, a, _, _) -> a) . Encoders.field . Encoders.nonNullable $ Encoders.oid,-                            contramap (\(_, _, a, _) -> a) . Encoders.field . Encoders.nonNullable $ Encoders.float4,-                            contramap (\(_, _, _, a) -> a) . Encoders.field . Encoders.nonNullable $ Encoders.name-                          ]-                    decoder =-                      Decoders.singleRow-                        $ (Decoders.column . Decoders.nonNullable . Decoders.composite)-                          ( (,,,)-                              <$> (Decoders.field . Decoders.nonNullable) Decoders.int4-                              <*> (Decoders.field . Decoders.nonNullable) Decoders.int4-                              <*> (Decoders.field . Decoders.nonNullable) Decoders.float4-                              <*> (Decoders.field . Decoders.nonNullable) Decoders.text-                          )-             in Connection.with $ Session.run $ Session.statement value statement-          assertEqual "" (Right (Right value)) res,-        testCase "Empty array"-          $ let io =-                  do-                    x <- Connection.with (Session.run session)-                    assertEqual (show x) (Right (Right [])) x-                  where-                    session =-                      Session.statement () statement-                      where-                        statement =-                          Statement.Statement sql encoder decoder True-                          where-                            sql =-                              "select array[]::int8[]"-                            encoder =-                              mempty-                            decoder =-                              Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.array (Decoders.dimension replicateM (Decoders.element (Decoders.nonNullable Decoders.int8)))))-             in io,-        testCase "Failing prepared statements"-          $ let io =-                  Connection.with (Session.run session)-                    >>= (assertBool <$> show <*> resultTest)-                  where-                    resultTest =-                      \case-                        Right (Left (Session.QueryError _ _ (Session.ResultError (Session.ServerError "26000" _ _ _ _)))) -> False-                        _ -> True-                    session =-                      catchError session (const (pure ())) *> session-                      where-                        session =-                          Session.statement () statement-                          where-                            statement =-                              Statement.Statement sql encoder decoder True-                              where-                                sql =-                                  "absurd"-                                encoder =-                                  mempty-                                decoder =-                                  Decoders.noResult-             in io,-        testCase "Prepared statements after error"-          $ let io =-                  Connection.with (Session.run session)-                    >>= \x -> assertBool (show x) (either (const False) isRight x)-                  where-                    session =-                      try *> fail *> try-                      where-                        try =-                          Session.statement 1 statement-                          where-                            statement =-                              Statement.Statement sql encoder decoder True-                              where-                                sql =-                                  "select $1 :: int8"-                                encoder =-                                  Encoders.param (Encoders.nonNullable (Encoders.int8))-                                decoder =-                                  Decoders.singleRow $ (Decoders.column . Decoders.nonNullable) Decoders.int8-                        fail =-                          catchError (Session.sql "absurd") (const (pure ()))-             in io,-        testCase "\"in progress after error\" bugfix"-          $ let sumStatement :: Statement.Statement (Int64, Int64) Int64-                sumStatement =-                  Statement.Statement sql encoder decoder True-                  where-                    sql =-                      "select ($1 + $2)"-                    encoder =-                      contramap fst (Encoders.param (Encoders.nonNullable (Encoders.int8)))-                        <> contramap snd (Encoders.param (Encoders.nonNullable (Encoders.int8)))-                    decoder =-                      Decoders.singleRow ((Decoders.column . Decoders.nonNullable) Decoders.int8)-                sumSession :: Session.Session Int64-                sumSession =-                  Session.sql "begin" *> Session.statement (1, 1) sumStatement <* Session.sql "end"-                errorSession :: Session.Session ()-                errorSession =-                  Session.sql "asldfjsldk"-                io =-                  Connection.with $ \c -> do-                    Session.run errorSession c-                    Session.run sumSession c-             in io >>= \x -> assertBool (show x) (either (const False) isRight x),-        testCase "\"another command is already in progress\" bugfix"-          $ let sumStatement :: Statement.Statement (Int64, Int64) Int64-                sumStatement =-                  Statement.Statement sql encoder decoder True-                  where-                    sql =-                      "select ($1 + $2)"-                    encoder =-                      contramap fst (Encoders.param (Encoders.nonNullable (Encoders.int8)))-                        <> contramap snd (Encoders.param (Encoders.nonNullable (Encoders.int8)))-                    decoder =-                      Decoders.singleRow ((Decoders.column . Decoders.nonNullable) Decoders.int8)-                session :: Session.Session Int64-                session =-                  do-                    Session.sql "begin;"-                    s <- Session.statement (1, 1) sumStatement-                    Session.sql "end;"-                    return s-             in Session.runSessionOnLocalDb session >>= \x -> assertEqual (show x) (Right 2) x,-        testCase "Executing the same query twice"-          $ pure (),-        testCase "Interval Encoding"-          $ let actualIO =-                  Session.runSessionOnLocalDb $ do-                    let statement =-                          Statement.Statement sql encoder decoder True-                          where-                            sql =-                              "select $1 = interval '10 seconds'"-                            decoder =-                              (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.bool)))-                            encoder =-                              Encoders.param (Encoders.nonNullable (Encoders.interval))-                     in Session.statement (10 :: DiffTime) statement-             in actualIO >>= \x -> assertEqual (show x) (Right True) x,-        testCase "Interval Decoding"-          $ let actualIO =-                  Session.runSessionOnLocalDb $ do-                    let statement =-                          Statement.Statement sql encoder decoder True-                          where-                            sql =-                              "select interval '10 seconds'"-                            decoder =-                              (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.interval)))-                            encoder =-                              Encoders.noParams-                     in Session.statement () statement-             in actualIO >>= \x -> assertEqual (show x) (Right (10 :: DiffTime)) x,-        testCase "Interval Encoding/Decoding"-          $ let actualIO =-                  Session.runSessionOnLocalDb $ do-                    let statement =-                          Statement.Statement sql encoder decoder True-                          where-                            sql =-                              "select $1"-                            decoder =-                              (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.interval)))-                            encoder =-                              Encoders.param (Encoders.nonNullable (Encoders.interval))-                     in Session.statement (10 :: DiffTime) statement-             in actualIO >>= \x -> assertEqual (show x) (Right (10 :: DiffTime)) x,-        testCase "Unknown"-          $ let actualIO =-                  Session.runSessionOnLocalDb $ do-                    let statement =-                          Statement.Statement sql mempty Decoders.noResult True-                          where-                            sql =-                              "drop type if exists mood"-                     in Session.statement () statement-                    let statement =-                          Statement.Statement sql mempty Decoders.noResult True-                          where-                            sql =-                              "create type mood as enum ('sad', 'ok', 'happy')"-                     in Session.statement () statement-                    let statement =-                          Statement.Statement sql encoder decoder True-                          where-                            sql =-                              "select $1 = ('ok' :: mood)"-                            decoder =-                              (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.bool)))-                            encoder =-                              Encoders.param (Encoders.nonNullable (Encoders.unknown))-                     in Session.statement "ok" statement-             in actualIO >>= assertEqual "" (Right True),-        testCase "Textual Unknown"-          $ let actualIO =-                  Session.runSessionOnLocalDb $ do-                    let statement =-                          Statement.Statement sql mempty Decoders.noResult True-                          where-                            sql =-                              "create or replace function overloaded(a int, b int) returns int as $$ select a + b $$ language sql;"-                     in Session.statement () statement-                    let statement =-                          Statement.Statement sql mempty Decoders.noResult True-                          where-                            sql =-                              "create or replace function overloaded(a text, b text, c text) returns text as $$ select a || b || c $$ language sql;"-                     in Session.statement () statement-                    let statement =-                          Statement.Statement sql encoder decoder True-                          where-                            sql =-                              "select overloaded($1, $2) || overloaded($3, $4, $5)"-                            decoder =-                              (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.text)))-                            encoder =-                              contramany (Encoders.param (Encoders.nonNullable (Encoders.unknown)))-                     in Session.statement ["1", "2", "4", "5", "6"] statement-             in actualIO >>= assertEqual "" (Right "3456"),-        testCase "Enum"-          $ let actualIO =-                  Session.runSessionOnLocalDb $ do-                    let statement =-                          Statement.Statement sql mempty Decoders.noResult True-                          where-                            sql =-                              "drop type if exists mood"-                     in Session.statement () statement-                    let statement =-                          Statement.Statement sql mempty Decoders.noResult True-                          where-                            sql =-                              "create type mood as enum ('sad', 'ok', 'happy')"-                     in Session.statement () statement-                    let statement =-                          Statement.Statement sql encoder decoder True-                          where-                            sql =-                              "select ($1 :: mood)"-                            decoder =-                              (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.enum (Just . id))))-                            encoder =-                              Encoders.param (Encoders.nonNullable ((Encoders.enum id)))-                     in Session.statement "ok" statement-             in actualIO >>= assertEqual "" (Right "ok"),-        testCase "The same prepared statement used on different types"-          $ let actualIO =-                  Session.runSessionOnLocalDb $ do-                    let effect1 =-                          Session.statement "ok" statement-                          where-                            statement =-                              Statement.Statement sql encoder decoder True-                              where-                                sql =-                                  "select $1"-                                encoder =-                                  Encoders.param (Encoders.nonNullable (Encoders.text))-                                decoder =-                                  (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) (Decoders.text)))-                        effect2 =-                          Session.statement 1 statement-                          where-                            statement =-                              Statement.Statement sql encoder decoder True-                              where-                                sql =-                                  "select $1"-                                encoder =-                                  Encoders.param (Encoders.nonNullable (Encoders.int8))-                                decoder =-                                  (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) Decoders.int8))-                     in (,) <$> effect1 <*> effect2-             in actualIO >>= assertEqual "" (Right ("ok", 1)),-        testCase "Affected rows counting"-          $ replicateM_ 13-          $ let actualIO =-                  Session.runSessionOnLocalDb $ do-                    dropTable-                    createTable-                    replicateM_ 100 insertRow-                    deleteRows <* dropTable-                  where-                    dropTable =-                      Session.statement ()-                        $ Statements.plain-                        $ "drop table if exists a"-                    createTable =-                      Session.statement ()-                        $ Statements.plain-                        $ "create table a (id bigserial not null, name varchar not null, primary key (id))"-                    insertRow =-                      Session.statement ()-                        $ Statements.plain-                        $ "insert into a (name) values ('a')"-                    deleteRows =-                      Session.statement () $ Statement.Statement sql mempty decoder False-                      where-                        sql =-                          "delete from a"-                        decoder =-                          Decoders.rowsAffected-             in actualIO >>= assertEqual "" (Right 100),-        testCase "Result of an auto-incremented column"-          $ let actualIO =-                  Session.runSessionOnLocalDb $ do-                    Session.statement () $ Statements.plain $ "drop table if exists a"-                    Session.statement () $ Statements.plain $ "create table a (id serial not null, v char not null, primary key (id))"-                    id1 <- Session.statement () $ Statement.Statement "insert into a (v) values ('a') returning id" mempty (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) Decoders.int4)) False-                    id2 <- Session.statement () $ Statement.Statement "insert into a (v) values ('b') returning id" mempty (Decoders.singleRow ((Decoders.column . Decoders.nonNullable) Decoders.int4)) False-                    Session.statement () $ Statements.plain $ "drop table if exists a"-                    pure (id1, id2)-             in assertEqual "" (Right (1, 2)) =<< actualIO,-        testCase "List decoding"-          $ let actualIO =-                  Session.runSessionOnLocalDb $ Session.statement () $ Statements.selectList-             in assertEqual "" (Right [(1, 2), (3, 4), (5, 6)]) =<< actualIO-      ]
− tasty/Main/Connection.hs 
@@ -1,24 +0,0 @@-module Main.Connection where--import Hasql.Connection qualified as HC-import Main.Prelude--with :: (HC.Connection -> IO a) -> IO (Either HC.ConnectionError a)-with handler =-  runExceptT $ acquire >>= \connection -> use connection <* release connection-  where-    acquire =-      ExceptT $ HC.acquire settings-      where-        settings =-          HC.settings host port user password database-          where-            host = "localhost"-            port = 5432-            user = "postgres"-            password = "postgres"-            database = "postgres"-    use connection =-      lift $ handler connection-    release connection =-      lift $ HC.release connection
− tasty/Main/Prelude.hs 
@@ -1,6 +0,0 @@-module Main.Prelude-  ( module Exports,-  )-where--import Prelude as Exports
− tasty/Main/Statements.hs 
@@ -1,33 +0,0 @@-module Main.Statements where--import Hasql.Decoders qualified as HD-import Hasql.Statement qualified as HQ-import Main.Prelude--plain :: ByteString -> HQ.Statement () ()-plain sql =-  HQ.Statement sql mempty HD.noResult False--dropType :: ByteString -> HQ.Statement () ()-dropType name =-  plain-    $ "drop type if exists "-    <> name--createEnum :: ByteString -> [ByteString] -> HQ.Statement () ()-createEnum name values =-  plain-    $ "create type "-    <> name-    <> " as enum ("-    <> mconcat (intersperse ", " (map (\x -> "'" <> x <> "'") values))-    <> ")"--selectList :: HQ.Statement () ([] (Int64, Int64))-selectList =-  HQ.Statement sql mempty decoder True-  where-    sql =-      "values (1,2), (3,4), (5,6)"-    decoder =-      HD.rowList ((,) <$> (HD.column . HD.nonNullable) HD.int8 <*> (HD.column . HD.nonNullable) HD.int8)
− testing-utils/Hasql/TestingUtils/Constants.hs 
@@ -1,13 +0,0 @@-module Hasql.TestingUtils.Constants where--import Hasql.Connection qualified as Connection--localConnectionSettings :: Connection.Settings-localConnectionSettings =-  Connection.settings host port user password database-  where-    host = "localhost"-    port = 5432-    user = "postgres"-    password = "postgres"-    database = "postgres"
− testing-utils/Hasql/TestingUtils/TestingDsl.hs 
@@ -1,37 +0,0 @@-module Hasql.TestingUtils.TestingDsl-  ( Session.Session,-    SessionError (..),-    Session.QueryError (..),-    Session.CommandError (..),-    runSessionOnLocalDb,-    runStatementInSession,-  )-where--import Hasql.Connection qualified as Connection-import Hasql.Session qualified as Session-import Hasql.Statement qualified as Statement-import Hasql.TestingUtils.Constants qualified as Constants-import Prelude--data SessionError-  = ConnectionError (Connection.ConnectionError)-  | SessionError (Session.QueryError)-  deriving (Show, Eq)--runSessionOnLocalDb :: Session.Session a -> IO (Either SessionError a)-runSessionOnLocalDb session =-  runExceptT $ acquire >>= \connection -> use connection <* release connection-  where-    acquire =-      ExceptT $ fmap (mapLeft ConnectionError) $ Connection.acquire Constants.localConnectionSettings-    use connection =-      ExceptT-        $ fmap (mapLeft SessionError)-        $ Session.run session connection-    release connection =-      lift $ Connection.release connection--runStatementInSession :: Statement.Statement a b -> a -> Session.Session b-runStatementInSession statement params =-  Session.statement params statement
− threads-test/Main.hs 
@@ -1,42 +0,0 @@-module Main where--import Hasql.Connection qualified-import Hasql.Session qualified-import Main.Statements qualified as Statements-import Prelude--main :: IO ()-main =-  acquire >>= use-  where-    acquire =-      (,) <$> acquire <*> acquire-      where-        acquire =-          join-            $ fmap (either (fail . show) return)-            $ Hasql.Connection.acquire connectionSettings-          where-            connectionSettings =-              Hasql.Connection.settings "localhost" 5432 "postgres" "postgres" "postgres"-    use (connection1, connection2) =-      do-        beginVar <- newEmptyMVar-        finishVar <- newEmptyMVar-        forkIO $ do-          traceM "1: in"-          putMVar beginVar ()-          session connection1 (Hasql.Session.statement 0.2 Statements.selectSleep)-          traceM "1: out"-          void (tryPutMVar finishVar False)-        forkIO $ do-          takeMVar beginVar-          traceM "2: in"-          session connection2 (Hasql.Session.statement 0.1 Statements.selectSleep)-          traceM "2: out"-          void (tryPutMVar finishVar True)-        bool exitFailure exitSuccess . traceShowId =<< takeMVar finishVar-      where-        session connection session =-          Hasql.Session.run session connection-            >>= either (fail . show) return
− threads-test/Main/Statements.hs 
@@ -1,17 +0,0 @@-module Main.Statements where--import Hasql.Decoders qualified as D-import Hasql.Encoders qualified as E-import Hasql.Statement-import Prelude--selectSleep :: Statement Double ()-selectSleep =-  Statement sql encoder decoder True-  where-    sql =-      "select pg_sleep($1)"-    encoder =-      E.param (E.nonNullable E.float8)-    decoder =-      D.noResult