beam-postgres 0.6.2.0 → 0.6.3.0

raw patch · 8 files changed

+2468/−71 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +30/−5
• Database/Beam/Postgres/Full.hs +812/−15
• Database/Beam/Postgres/Syntax.hs +58/−11
• beam-postgres.cabal +3/−1
• test/Database/Beam/Postgres/Test.hs +8/−5
• test/Database/Beam/Postgres/Test/CTE.hs +1334/−0
• test/Database/Beam/Postgres/Test/CTENegative.hs +180/−0
• test/Main.hs +43/−34

@@ -1,3 +1,33 @@+# 0.6.3.0++## Added features++* Added the PostgreSQL-specific, placement-indexed `PgWith` CTE builder. It can+  lift helpers built with the portable `With Postgres` API, while the new+  data-modifying builders produce blocks which cannot be embedded in a+  subquery.+* Added `pgSelectingWith` for PostgreSQL 12+ `MATERIALIZED` and+  `NOT MATERIALIZED` SELECT CTEs, with `pgSelecting` retaining PostgreSQL's+  default planner policy.+* Added `cteInsertReturning`, `cteUpdateReturning`, and `cteDeleteReturning`+  for exposing the `RETURNING` rows of PostgreSQL data-modifying CTEs through+  `reuse`.+* Added `cteInsert`, `cteUpdate`, and `cteDelete` for data-modifying CTEs which+  execute for their side effects and intentionally produce no reusable rows.+* Added support for reusable zero-column CTE projections. SELECT CTEs omit the+  optional output alias list, while data-modifying CTEs use a private+  `NULL::boolean` `RETURNING` value to preserve one degree-zero result row per+  affected row without exposing a value to Beam's result decoder.+* Added `pgSelectWithNested` and `pgSelectWithTopLevel` for consuming safe+  nested and top-level `PgWith` blocks respectively, plus `pgInsertWith`,+  `pgUpdateWith`, and `pgDeleteWith` for terminating a top-level `WITH` block+  with a data-modifying statement.++## Bug fixes++* Fixed an issue where using `pgSelectWith` with no common-table expressions+  would lead to an invalid SQL query at runtime.+ # 0.6.2.0  ## Added features@@ -7,11 +37,6 @@   over colums of type `citext` (#818) * Exposed the functionality to implement user-defined extensions via   `Database.Beam.Postgres.Extensions` (#819)--## Bug fixes--* Fixed an issue where using `pgSelectWith` with no common-table expressions-  would lead to an invalid SQL query at runtime.  # 0.6.1.0 

@@ -1,6 +1,9 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeOperators #-}@@ -9,6 +12,11 @@ -- manipulation statements. These functions shadow the functions in -- "Database.Beam.Query" and provide a strict superset of functionality. They -- map 1-to-1 with the underlying Postgres support.+--+-- PostgreSQL-specific common table expressions use the placement-indexed+-- 'PgWith' builder. It supports explicit SELECT materialization and both+-- returning and side-effect-only data-modifying CTEs without changing the+-- portable CTE API in beam-core. module Database.Beam.Postgres.Full   ( -- * Additional @SELECT@ features @@ -19,14 +27,18 @@    , locked_, lockAll_, withLocks_ -  -- ** Inner WITH queries-  , pgSelectWith+  -- ** Common table expressions+  , PgCtePlacement(..), PgWith+  , pgLiftWith, pgToTopLevel+  , PgCteMaterialization(..), pgSelecting, pgSelectingWith+  , pgSelectWith, pgSelectWithNested, pgSelectWithTopLevel+  , pgInsertWith, pgUpdateWith, pgDeleteWith    -- ** Lateral joins   , lateral_    -- * @INSERT@ and @INSERT RETURNING@-  , insert, insertReturning+  , insert, insertReturning, cteInsert, cteInsertReturning   , insertDefaults   , runPgInsertReturningList @@ -45,12 +57,12 @@   -- * @UPDATE RETURNING@   , PgUpdateReturning(..)   , runPgUpdateReturningList-  , updateReturning+  , updateReturning, cteUpdate, cteUpdateReturning    -- * @DELETE RETURNING@   , PgDeleteReturning(..)   , runPgDeleteReturningList-  , deleteReturning+  , deleteReturning, cteDelete, cteDeleteReturning    -- * Generalized @RETURNING@   , PgReturning(..)@@ -66,18 +78,235 @@ import           Database.Beam.Postgres.Types import           Database.Beam.Postgres.Syntax +import           Control.Monad.Fix (MonadFix(..)) import           Control.Monad.Free.Church-import           Control.Monad.State.Strict (evalState)-import           Control.Monad.Writer (runWriterT)+import           Control.Monad.State.Strict (evalState, get, put)+import           Control.Monad.Writer (runWriterT, tell) -import           Data.List.NonEmpty (nonEmpty)+import           Data.List.NonEmpty (NonEmpty(..), nonEmpty) import qualified Data.List.NonEmpty as NonEmpty import           Data.Kind (Type) import           Data.Proxy (Proxy(..))+import           Data.String (fromString)+import           Data.Text (Text) import qualified Data.Text as T  -- * @SELECT@ +-- | Whether every CTE in a PostgreSQL @WITH@ block may appear in a nested+-- query, or whether the block must be attached to a top-level statement.+--+-- PostgreSQL permits SELECT CTEs in nested queries, but permits data-modifying+-- CTEs only in a @WITH@ clause attached to the top-level statement. The index+-- on 'PgWith' records that rule for the builders in this module, so invalid+-- nesting is rejected by Haskell rather than by PostgreSQL. See PostgreSQL's+-- <https://www.postgresql.org/docs/current/queries-with.html#QUERIES-WITH-MODIFYING data-modifying WITH documentation>.+--+-- @since 0.6.3.0+data PgCtePlacement+  = PgCteNestedAllowed+    -- ^ The block contains only CTEs which may be nested.+  | PgCteTopLevelOnly+    -- ^ The block contains a data-modifying CTE and must remain top-level.++-- | A PostgreSQL-specific CTE builder.+--+-- This newtype uses beam-core's existing 'With' action and CTE accumulator. It+-- adds a placement index for PostgreSQL data-modifying CTEs without introducing+-- a second name supply or syntax writer. Consequently a lifted portable helper+-- and a native PostgreSQL CTE allocate names from the same sequence.+--+-- Use 'pgSelecting' for SELECT CTEs, 'cteInsertReturning',+-- 'cteUpdateReturning', or 'cteDeleteReturning' for reusable modifying CTEs,+-- and 'cteInsert', 'cteUpdate', or 'cteDelete' for side-effect-only CTEs.+-- Consume the completed block with 'pgSelectWithTopLevel', 'pgInsertWith',+-- 'pgUpdateWith', or 'pgDeleteWith'.+--+-- @since 0.6.3.0+newtype PgWith db (placement :: PgCtePlacement) a =+  PgWith { unPgWith :: With Postgres db a }+  deriving (Functor, Applicative, Monad)++-- The placement parameter is phantom at runtime. A nominal role prevents+-- Data.Coerce from relabelling a top-level-only block as nested-safe.+type role PgWith nominal nominal nominal++-- Recursive knots are deliberately restricted to SELECT-only construction.+-- Complete such a knot first and then use 'pgToTopLevel' before adding a+-- data-modifying CTE which consumes its rows.+instance MonadFix (PgWith db 'PgCteNestedAllowed) where+  mfix f = PgWith (mfix (unPgWith . f))++-- | Lift an existing portable PostgreSQL 'With' helper into 'PgWith'.+--+-- Helpers constructed with the portable 'selecting' API contain SELECT+-- statements, so they are valid at either placement. The lifted action uses+-- the surrounding 'PgWith' name supply; lifting a helper which defines several+-- CTEs therefore cannot collide with CTEs defined before or after it.+--+-- > native <- pgSelecting nativeQuery+-- > rows <- pgLiftWith existingSelectCtes+-- > changed <- cteDeleteReturning table predicate id+-- > pure $ do+-- >   nativeRow <- reuse native+-- >   row <- reuse rows+-- >   changedRow <- reuse changed+-- >   pure (nativeRow, row, changedRow)+--+-- If @existingSelectCtes@ defines two CTEs and one native CTE precedes it,+-- Beam generates one block whose names continue through the lifted helper:+--+-- @+-- WITH "cte0"("res0") AS (SELECT ...),+--      "cte1"("res0") AS (SELECT ...),+--      "cte2"("res0") AS (SELECT ... FROM "cte1"),+--      "cte3"("res0", "res1") AS+--        (DELETE FROM "table" ... RETURNING "id", "value")+-- SELECT ... FROM "cte0" CROSS JOIN "cte2" CROSS JOIN "cte3"+-- @+--+-- The 'With' constructor is public for low-level extension code. 'pgLiftWith'+-- assumes such code preserves the portable API's SELECT-only invariant.+--+-- @since 0.6.3.0+pgLiftWith :: With Postgres db a -> PgWith db placement a+pgLiftWith = PgWith++-- | Promote a completed nested-safe block for composition with+-- data-modifying CTEs.+--+-- This operation is one-way. In particular, there is no public operation for+-- converting 'PgCteTopLevelOnly' back to 'PgCteNestedAllowed'.+--+-- > pgSelectWithTopLevel $ do+-- >   recursiveRows <- pgToTopLevel $ mdo+-- >     rows <- pgSelecting recursiveQuery+-- >     pure rows+-- >   cteDelete table $ \row -> exists_ $ do+-- >     recursiveRow <- reuse recursiveRows+-- >     guard_ (rowId row ==. rowId recursiveRow)+-- >   pure finalQuery+--+-- The promotion changes no SQL. It permits the subsequent modifying CTE, so+-- the complete block has the following form:+--+-- @+-- WITH RECURSIVE "cte0"("res0") AS+--        (SELECT ... UNION ALL SELECT ... FROM "cte0"),+--      "cte1" AS+--        (DELETE FROM "table"+--         WHERE EXISTS (SELECT ... FROM "cte0"))+-- SELECT ...+-- @+--+-- @since 0.6.3.0+pgToTopLevel+  :: PgWith db 'PgCteNestedAllowed a+  -> PgWith db 'PgCteTopLevelOnly a+pgToTopLevel (PgWith with) = PgWith with++-- | PostgreSQL's materialization policy for a SELECT CTE.+--+-- Explicit materialization control is available in PostgreSQL 12 and later.+-- 'PgCteDefault' emits no modifier and therefore retains PostgreSQL's normal+-- planner behaviour and compatibility with earlier server versions.+-- See PostgreSQL's+-- <https://www.postgresql.org/docs/current/queries-with.html#QUERIES-WITH-CTE-MATERIALIZATION CTE materialization documentation>.+--+-- @since 0.6.3.0+data PgCteMaterialization+  = PgCteDefault+    -- ^ Let PostgreSQL decide whether to fold or materialize the CTE.+  | PgCteMaterialized+    -- ^ Emit @MATERIALIZED@, requesting separate calculation of the CTE. This+    -- can act as an optimization fence or prevent duplicated computation.+  | PgCteNotMaterialized+    -- ^ Emit @NOT MATERIALIZED@, allowing the CTE and parent query to be+    -- optimized together. PostgreSQL ignores this for recursive or+    -- non-side-effect-free queries.+  deriving (Eq, Show)++-- | Introduce a SELECT query as a reusable PostgreSQL CTE using the server's+-- default materialization policy.+--+-- This is the usual PostgreSQL-specific counterpart of 'selecting'. Use+-- 'pgSelectingWith' when the planner boundary should be controlled explicitly.+--+-- > rows <- pgSelecting sourceQuery+-- > pure (reuse rows)+--+-- With a top-level SELECT consumer this produces:+--+-- @+-- WITH "cte0"("res0", "res1") AS (SELECT ...)+-- SELECT "t0"."res0", "t0"."res1" FROM "cte0" AS "t0"+-- @+--+-- @since 0.6.3.0+pgSelecting+  :: ( Projectible Postgres res+     , ThreadRewritable CTE.QAnyScope res )+  => Q Postgres db CTE.QAnyScope res+  -> PgWith db placement (ReusableQ Postgres db res)+pgSelecting = pgSelectingWith PgCteDefault++-- | Introduce a SELECT query as a reusable PostgreSQL CTE with an explicit+-- materialization policy.+--+-- For example:+--+-- > expensive <- pgSelectingWith PgCteMaterialized expensiveQuery+-- > pure $ do+-- >   left <- reuse expensive+-- >   right <- reuse expensive+-- >   guard_ (leftId left ==. rightId right)+-- >   pure (left, right)+--+-- With 'pgSelectWithTopLevel', this produces a statement shaped like:+--+-- @+-- WITH "cte0"("res0", "res1") AS MATERIALIZED (SELECT ...)+-- SELECT ...+-- FROM "cte0" AS "t0" CROSS JOIN "cte0" AS "t1"+-- WHERE "t0"."res0" = "t1"."res0"+-- @+--+-- @NOT MATERIALIZED@ may allow restrictions in the parent query to reach the+-- CTE, but may also duplicate its computation when it is referenced more than+-- once. PostgreSQL ignores @NOT MATERIALIZED@ when folding would not be+-- semantically valid, for example for a recursive query or a query containing+-- volatile functions.+--+-- A projection with no fields is represented by omitting the CTE column-alias+-- list. PostgreSQL then treats the CTE as a degree-zero relation: it has no+-- columns, but it retains the row cardinality of @query@. For example, a query+-- which produces two empty rows has the following shape:+--+-- @+-- WITH "cte0" AS MATERIALIZED (SELECT FROM ...)+-- SELECT FROM "cte0" AS "t0"+-- @+--+-- Reusing such a CTE remains meaningful in joins, @EXISTS@, and aggregates+-- even though no value can be projected from an individual row.+--+-- @since 0.6.3.0+pgSelectingWith+  :: forall res db placement+   . ( Projectible Postgres res+     , ThreadRewritable CTE.QAnyScope res )+  => PgCteMaterialization+  -> Q Postgres db CTE.QAnyScope res+  -> PgWith db placement (ReusableQ Postgres db res)+pgSelectingWith materialization q = do+  tblNm <- pgRegisterCte $ \name ->+    let (_ :: res, fields) = mkFieldNames @Postgres (qualifiedField name)+        body = fromPgSelect (buildSqlQuery (name <> "_") q)+    in case nonEmpty fields of+         Nothing -> pgCteSyntax name Nothing materialization body+         Just fields' -> pgOutputCteSyntax name fields' materialization body+  pure (CTE.reusableForCTE tblNm)+ -- | An explicit lock against some tables. You can create a value of this type using the 'locked_' -- function. You can combine these values monoidally to combine multiple locks for use with the -- 'withLocks_' function.@@ -220,6 +449,101 @@       tblSettings = dbTableSettings tbl +-- | Introduce a PostgreSQL @INSERT@ statement as a side-effect-only CTE.+--+-- The CTE has no @RETURNING@ clause and therefore produces no reusable+-- relation; PostgreSQL nevertheless executes it exactly once and to+-- completion when the surrounding top-level statement executes.+--+-- > pgSelectWithTopLevel $ do+-- >   cteInsert users (insertValues [newUser]) onConflictDefault+-- >   pure finalQuery+--+-- This produces SQL shaped like:+--+-- @+-- WITH cte0 AS (INSERT INTO users ...)+-- SELECT ...+-- @+--+-- Empty insert values register no CTE. The result is still conservatively+-- 'PgCteTopLevelOnly', because the placement index cannot vary with the+-- supplied values.+--+-- @since 0.6.3.0+cteInsert+  :: DatabaseEntity Postgres db (TableEntity table)+  -> SqlInsertValues Postgres (table (QExpr Postgres s))+  -> PgInsertOnConflict table+  -> PgWith db 'PgCteTopLevelOnly ()+cteInsert table values onConflict_ =+  case insert table values onConflict_ of+    SqlInsertNoRows -> pure ()+    SqlInsert _ (PgInsertSyntax syntax) -> pgDataModifyingCte_ syntax++-- | Introduce a PostgreSQL @INSERT ... RETURNING@ statement as a+-- data-modifying common table expression. The returned value can be used in a+-- subsequent query with 'reuse'.+--+-- Returns 'Nothing' when the supplied insert values are empty, because in that+-- case there is no statement or common table expression to reuse.+-- Data-modifying CTEs are restricted to top-level 'PgWith' blocks and cannot+-- be passed to 'pgSelectWithNested'.+--+-- For example, this inserts a row once and makes the rows produced by+-- @RETURNING@ available to the final query:+--+-- > pgSelectWithTopLevel $ do+-- >   inserted <- cteInsertReturning+-- >     users+-- >     (insertValues [newUser])+-- >     onConflictDefault+-- >     id+-- >   case inserted of+-- >     Nothing -> pure noRowsQuery+-- >     Just rows -> pure (reuse rows)+--+-- The generated statement has the shape:+--+-- @+-- WITH "cte0"("res0", ...) AS+--        (INSERT INTO "users" ... RETURNING ...)+-- SELECT ... FROM "cte0" AS "t0"+-- @+--+-- The projection may contain no fields. In that case Beam preserves one+-- degree-zero result row per inserted row. PostgreSQL requires at least one+-- @RETURNING@ expression, so the CTE contains a private boolean sentinel while+-- the final SELECT exposes no columns:+--+-- @+-- WITH "cte0"("res0") AS+--        (INSERT INTO "users" ... RETURNING NULL::boolean)+-- SELECT FROM "cte0" AS "t0"+-- @+--+-- The sentinel is not part of the returned Haskell value. If neither the final+-- statement nor another CTE needs the inserted-row output, prefer 'cteInsert'.+-- It omits @RETURNING@ and produces no reusable result.+--+-- @since 0.6.3.0+cteInsertReturning+  :: ( Projectible Postgres a+     , ThreadRewritable PostgresInaccessible a+     , Projectible Postgres (WithRewrittenThread PostgresInaccessible CTE.QAnyScope a)+     , ThreadRewritable CTE.QAnyScope (WithRewrittenThread PostgresInaccessible CTE.QAnyScope a)+     )+  => DatabaseEntity Postgres db (TableEntity table)+  -> SqlInsertValues Postgres (table (QExpr Postgres s))+  -> PgInsertOnConflict table+  -> (table (QExpr Postgres PostgresInaccessible) -> a)+  -> PgWith db 'PgCteTopLevelOnly (Maybe (ReusableQ Postgres db (WithRewrittenThread PostgresInaccessible CTE.QAnyScope a)))+cteInsertReturning table values onConflict_ mkProjection =+  case insertReturning table values onConflict_ (Just mkProjection) of+    PgInsertReturningEmpty -> pure Nothing+    PgInsertReturning syntax ->+      Just <$> pgDataModifyingCte syntax+ runPgInsertReturningList   :: ( MonadBeam be m      , BeamSqlBackendSyntax be ~ PgCommandSyntax@@ -278,9 +602,7 @@                            (\_ -> Nothing)                            (rewriteThread (Proxy @s)))) --- | The SQL standard only allows CTE expressions (WITH expressions)--- at the top-level. Postgres allows you to embed these within a--- subquery.+-- | Embed a portable SELECT CTE block within a PostgreSQL subquery. -- -- For example, --@@ -288,13 +610,62 @@ -- SELECT a.column1, b.column2 FROM (WITH RECURSIVE ... ) a JOIN b -- @ ----- @beam-core@ offers 'selectWith' to produce a top-level 'SqlSelect'--- but these cannot be turned into 'Q' objects for use within joins.--- The 'pgSelectWith' function is more flexible.+-- @beam-core@'s 'selectWith' produces a top-level 'SqlSelect', which cannot be+-- used as a 'Q' value within a join. PostgreSQL accepts a SELECT-only @WITH@+-- query in that subquery position, and 'pgSelectWith' exposes that placement.+--+-- > select $ pgSelectWith $ do+-- >   reusableRows <- selecting someQuery+-- >   pure (reuse reusableRows)+--+-- This can produce a subquery such as:+--+-- @+-- SELECT ... FROM (WITH cte0 AS (SELECT ...) SELECT ... FROM cte0) AS nested+-- @+-- pgSelectWith :: forall db s res               . Projectible Postgres res              => With Postgres db (Q Postgres db s res) -> Q Postgres db s res-pgSelectWith (CTE.With mkQ) =+pgSelectWith = pgSelectWith_++-- | Embed a nested-safe PostgreSQL-specific CTE block in a query.+--+-- This is the 'PgWith' counterpart of 'pgSelectWith'. It supports+-- 'pgSelectingWith', including explicit materialization, while its placement+-- index rejects data-modifying CTEs because PostgreSQL accepts those only in a+-- @WITH@ clause attached to the top-level statement.+--+-- > select $ pgSelectWithNested $ do+-- >   rows <- pgSelectingWith PgCteMaterialized sourceQuery+-- >   pure (reuse rows)+--+-- This produces a derived table containing the complete nested @WITH@ query:+--+-- @+-- SELECT "t0"."res0", "t0"."res1"+-- FROM (WITH "cte0"("res0", "res1") AS MATERIALIZED (SELECT ...)+--       SELECT "sub_t0"."res0", "sub_t0"."res1"+--       FROM "cte0" AS "sub_t0") AS "t0"("res0", "res1")+-- @+--+-- @since 0.6.3.0+pgSelectWithNested+  :: forall db s res+   . Projectible Postgres res+  => PgWith db 'PgCteNestedAllowed (Q Postgres db s res)+  -> Q Postgres db s res+pgSelectWithNested = pgSelectWith_ . unPgWith++-- Shared implementation for the compatible portable and PostgreSQL-specific+-- nested APIs. Keeping the syntax conversion here avoids evaluating or+-- traversing a PgWith block a second time.+pgSelectWith_+  :: forall db s res+   . Projectible Postgres res+  => With Postgres db (Q Postgres db s res)+  -> Q Postgres db s res+pgSelectWith_ (CTE.With mkQ) =     let (q, (recursiveness, mctes)) = evalState (runWriterT mkQ) 0         fromSyntax tblPfx =             case (recursiveness, nonEmpty mctes) of@@ -316,6 +687,263 @@                       (const Nothing)                       snd)) +-- | Attach a PostgreSQL-specific CTE block to a top-level @SELECT@ statement.+--+-- Unlike 'pgSelectWith', this consumes 'PgWith' and can therefore safely+-- accept data-modifying CTEs. SELECT-only blocks work as well, so callers can+-- use one terminal function while a workflow grows from portable SELECT CTEs+-- to PostgreSQL-specific operations.+--+-- > pgSelectWithTopLevel $ do+-- >   selected <- pgSelecting sourceQuery+-- >   deleted <- cteDeleteReturning target predicate id+-- >   pure $ do+-- >     source <- reuse selected+-- >     removed <- reuse deleted+-- >     pure (source, removed)+--+-- This produces one statement of the following form:+--+-- @+-- WITH "cte0"("res0", "res1") AS (SELECT ...),+--      "cte1"("res0", "res1") AS+--        (DELETE FROM "target" ... RETURNING "id", "value")+-- SELECT ... FROM "cte0" CROSS JOIN "cte1"+-- @+--+-- The complete @WITH ... SELECT ...@ is one 'SqlSelect' and is sent to+-- PostgreSQL in a single round trip.+--+-- @since 0.6.3.0+pgSelectWithTopLevel+  :: Projectible Postgres res+  => PgWith db placement (Q Postgres db QBaseScope res)+  -> SqlSelect Postgres (QExprToIdentity res)+pgSelectWithTopLevel = selectWith . unPgWith++-- | Attach a common-table-expression block to a top-level PostgreSQL+-- @INSERT@ statement.+--+-- Unlike 'pgSelectWithNested', this is a top-level statement consumer and+-- therefore accepts both 'PgCteNestedAllowed' and 'PgCteTopLevelOnly' blocks.+-- The final insert can read reusable rows produced by either SELECT CTEs or+-- data-modifying CTEs:+--+-- > pgInsertWith $ do+-- >   rows <- pgSelecting sourceQuery+-- >   pure $ insert destination (insertFrom (reuse rows)) onConflictDefault+--+-- This produces a statement with the following shape:+--+-- @+-- WITH "cte0"("res0", "res1") AS (SELECT ...)+-- INSERT INTO "destination"("id", "value")+-- SELECT "t0"."res0", "t0"."res1" FROM "cte0" AS "t0"+-- @+--+-- If the final insert has no rows, the result remains 'SqlInsertNoRows'. There+-- is then no terminal statement to which PostgreSQL could attach the @WITH@+-- block, so none of its CTE bodies are executed.+--+-- Apply 'returning' to the resulting 'SqlInsert' when the terminal statement+-- should return rows.+--+-- @since 0.6.3.0+pgInsertWith+  :: PgWith db placement (SqlInsert Postgres table)+  -> SqlInsert Postgres table+pgInsertWith with =+  case runPgWith with of+    (SqlInsertNoRows, _, _) -> SqlInsertNoRows+    (SqlInsert settings (PgInsertSyntax statement), recursiveness, ctes) ->+      SqlInsert settings (PgInsertSyntax (pgWithSyntax recursiveness ctes statement))++-- | Attach a common-table-expression block to a top-level PostgreSQL+-- @UPDATE@ statement.+--+-- Reusable CTE rows can be referenced from the final update predicate, for+-- example through 'exists_':+--+-- > pgUpdateWith $ do+-- >   wanted <- pgSelecting wantedUsers+-- >   pure $ update users+-- >     (\user -> userEnabled user <-. val_ False)+-- >     (\user -> exists_ $ do+-- >        candidate <- reuse wanted+-- >        guard_ (userId user ==. userId candidate))+--+-- This produces SQL of the following form:+--+-- @+-- WITH "cte0"("res0") AS (SELECT ... AS "res0")+-- UPDATE "users" SET "enabled"=FALSE+-- WHERE EXISTS+--   (SELECT "t0"."res0" FROM "cte0" AS "t0"+--    WHERE "id" = "t0"."res0")+-- @+--+-- An identity update remains 'SqlIdentityUpdate'; as with an empty insert,+-- there is no terminal PostgreSQL statement and the accumulated CTEs are not+-- executed.+--+-- Apply 'returning' to the resulting 'SqlUpdate' when the terminal statement+-- should return rows.+--+-- @since 0.6.3.0+pgUpdateWith+  :: PgWith db placement (SqlUpdate Postgres table)+  -> SqlUpdate Postgres table+pgUpdateWith with =+  case runPgWith with of+    (SqlIdentityUpdate, _, _) -> SqlIdentityUpdate+    (SqlUpdate settings (PgUpdateSyntax statement), recursiveness, ctes) ->+      SqlUpdate settings (PgUpdateSyntax (pgWithSyntax recursiveness ctes statement))++-- | Attach a common-table-expression block to a top-level PostgreSQL+-- @DELETE@ statement.+--+-- > pgDeleteWith $ do+-- >   expired <- pgSelecting expiredUsers+-- >   pure $ delete users $ \user -> exists_ $ do+-- >     candidate <- reuse expired+-- >     guard_ (userId user ==. userId candidate)+--+-- This produces SQL of the following form:+--+-- @+-- WITH "cte0"("res0") AS (SELECT ... AS "res0")+-- DELETE FROM "users" AS "delete_target"+-- WHERE EXISTS+--   (SELECT "t0"."res0" FROM "cte0" AS "t0"+--    WHERE "delete_target"."id" = "t0"."res0")+-- @+--+-- Since 'SqlDelete' always contains a statement, the accumulated CTE block is+-- always preserved.+-- Apply 'returning' to the result when the terminal statement should return+-- deleted rows.+--+-- @since 0.6.3.0+pgDeleteWith+  :: PgWith db placement (SqlDelete Postgres table)+  -> SqlDelete Postgres table+pgDeleteWith with =+  case runPgWith with of+    (SqlDelete settings (PgDeleteSyntax statement), recursiveness, ctes) ->+      SqlDelete settings (PgDeleteSyntax (pgWithSyntax recursiveness ctes statement))++-- Allocate a name and append one PostgreSQL CTE definition to beam-core's+-- existing writer. All PgWith constructors use this path so lifted and native+-- actions share one monotonically increasing name supply.+pgRegisterCte+  :: (Text -> PgCommonTableExpressionSyntax)+  -> PgWith db placement Text+pgRegisterCte mkCte = PgWith . CTE.With $ do+  cteId <- get+  put (cteId + 1)++  let tblNm = fromString ("cte" ++ show cteId)+  tell (CTE.Nonrecursive, [mkCte tblNm])+  pure tblNm++-- Construct a reusable CTE with a statically non-empty physical output. Keeping+-- the invariant in the type prevents callers from accidentally rendering the+-- invalid PostgreSQL spelling @name() AS (...)@.+pgOutputCteSyntax+  :: Text+  -> NonEmpty Text+  -> PgCteMaterialization+  -> PgSyntax+  -> PgCommonTableExpressionSyntax+pgOutputCteSyntax name fields materialization body =+  pgCteSyntax name (Just fields) materialization body++-- Render the common outer shape for SELECT, returning DML, and+-- side-effect-only DML CTEs. A missing column list is used for degree-zero+-- SELECT CTEs and for modifying statements without @RETURNING@. Materialization+-- is deliberately passed as PgCteDefault for every DML caller: PostgreSQL's+-- materialization controls apply to SELECT CTE folding, while modifying CTEs+-- always execute exactly once and to completion.+pgCteSyntax+  :: Text+  -> Maybe (NonEmpty Text)+  -> PgCteMaterialization+  -> PgSyntax+  -> PgCommonTableExpressionSyntax+pgCteSyntax name fields materialization body =+  PgCommonTableExpressionSyntax $+    pgQuotedIdentifier name <>+    maybe mempty+      (pgParens . pgSepBy (emit ",") . map pgQuotedIdentifier . NonEmpty.toList)+      fields <>+    emit " AS" <>+    materializationSyntax materialization <>+    emit " " <>+    pgParens body+  where+    materializationSyntax PgCteDefault = mempty+    materializationSyntax PgCteMaterialized = emit " MATERIALIZED"+    materializationSyntax PgCteNotMaterialized = emit " NOT MATERIALIZED"++-- Register a modifying CTE with @RETURNING@ output and construct the reusable+-- relation which refers to its generated name.+--+-- PostgreSQL requires @RETURNING@ to contain at least one expression. The+-- existing INSERT, UPDATE, and DELETE returning renderers end in the keyword+-- and a space when Beam's logical projection has no fields. In that case this+-- CTE-specific path appends one private, constant boolean expression and gives+-- it the physical name @res0@. 'CTE.reusableForCTE' is still instantiated at+-- the original zero-field result type, so final Beam SELECTs project no+-- physical columns and the sentinel is never exposed to result decoding.+--+-- One sentinel row is produced for every affected row. Consequently the+-- degree-zero relation preserves the modifying statement's cardinality when it+-- is reused by joins, @EXISTS@, or aggregates.+pgDataModifyingCte+  :: forall res db+   . ( Projectible Postgres res+     , ThreadRewritable CTE.QAnyScope res )+  => PgSyntax+  -> PgWith db 'PgCteTopLevelOnly (ReusableQ Postgres db res)+pgDataModifyingCte body = do+  tblNm <- pgRegisterCte $ \name ->+    let (_ :: res, fields) = mkFieldNames @Postgres (qualifiedField name)+    in case nonEmpty fields of+         Nothing ->+           pgOutputCteSyntax+             name+             ("res0" :| [])+             PgCteDefault+             (body <> emit "NULL::boolean")+         Just fields' -> pgOutputCteSyntax name fields' PgCteDefault body+  pure (CTE.reusableForCTE tblNm)++-- Register a modifying CTE without @RETURNING@. PostgreSQL executes the body,+-- but the CTE forms no temporary table and therefore has no result which can be+-- passed to 'reuse'. This accounts for both the unit result and the absence of+-- a column-alias list.+pgDataModifyingCte_+  :: PgSyntax+  -> PgWith db 'PgCteTopLevelOnly ()+pgDataModifyingCte_ body = do+  _ <- pgRegisterCte $ \name ->+    pgCteSyntax name Nothing PgCteDefault body+  pure ()++-- Evaluate a PostgreSQL CTE builder once and retain the information required+-- by each top-level statement consumer. Keeping this helper local ensures that+-- the backend-independent CTE API does not acquire PostgreSQL command types.+runPgWith+  :: PgWith db placement a+  -> (a, PgCteRecursiveness, [BeamSql99BackendCTESyntax Postgres])+runPgWith (PgWith with) =+  let (result, (recursiveness, ctes)) =+        evalState (runWriterT (CTE.runWith with)) 0+      pgRecursiveness = case recursiveness of+        CTE.Nonrecursive -> PgCteNonrecursive+        CTE.Recursive -> PgCteRecursive+  in (result, pgRecursiveness, ctes)+ -- | By default, Postgres will throw an error when a conflict is detected. This -- preserves that functionality. onConflictDefault :: PgInsertOnConflict tbl@@ -388,6 +1016,93 @@   where     tblQ = changeBeamRep (\(Columnar' f) -> Columnar' (QExpr (pure (fieldE (unqualifiedField (_fieldName f)))))) tblSettings +-- | Introduce a PostgreSQL @UPDATE@ statement as a side-effect-only CTE.+--+-- Since no @RETURNING@ clause is emitted, the result is @()@ and cannot be+-- passed to 'reuse'. PostgreSQL still executes the update exactly once when+-- the surrounding top-level statement executes:+--+-- > pgDeleteWith $ do+-- >   cteUpdate users+-- >     (\user -> userActive user <-. val_ False)+-- >     (\user -> userLastSeen user <. val_ cutoff)+-- >   pure (delete sessions expiredSession)+--+-- This produces one side-effect-only definition before the terminal delete:+--+-- @+-- WITH "cte0" AS+--        (UPDATE "users" SET "active"=FALSE WHERE "last_seen" < ...)+-- DELETE FROM "sessions" AS "delete_target" WHERE ...+-- @+--+-- An identity assignment registers no CTE. As with 'cteInsert', its type+-- remains 'PgCteTopLevelOnly' independently of that value-level result.+--+-- @since 0.6.3.0+cteUpdate+  :: DatabaseEntity Postgres db (TableEntity table)+  -> (forall s. table (QField s) -> QAssignment Postgres s)+  -> (forall s. table (QExpr Postgres s) -> QExpr Postgres s Bool)+  -> PgWith db 'PgCteTopLevelOnly ()+cteUpdate table@(DatabaseEntity (DatabaseTable {})) mkAssignments mkWhere =+  case update table mkAssignments mkWhere of+    SqlIdentityUpdate -> pure ()+    SqlUpdate _ (PgUpdateSyntax syntax) -> pgDataModifyingCte_ syntax++-- | Introduce a PostgreSQL @UPDATE ... RETURNING@ statement as a+-- data-modifying common table expression. The returned value can be used in a+-- subsequent query with 'reuse'.+--+-- Returns 'Nothing' when the assignments form an identity update, because in+-- that case there is no statement or common table expression to reuse.+-- Data-modifying CTEs are restricted to top-level 'PgWith' blocks and cannot+-- be used with 'pgSelectWithNested'.+--+-- > pgSelectWithTopLevel $ do+-- >   updated <- cteUpdateReturning+-- >     users+-- >     (\user -> userEnabled user <-. val_ False)+-- >     (\user -> userId user ==. val_ wantedUserId)+-- >     id+-- >   case updated of+-- >     Nothing -> pure noRowsQuery+-- >     Just rows -> pure (reuse rows)+--+-- This renders the update once inside @WITH@ and reads its @RETURNING@ rows+-- through the reusable CTE name:+--+-- @+-- WITH "cte0"("res0", "res1") AS+--        (UPDATE "users" SET "enabled"=FALSE+--         WHERE "id" = ... RETURNING "id", "enabled")+-- SELECT "t0"."res0", "t0"."res1" FROM "cte0" AS "t0"+-- @+--+-- As with 'cteInsertReturning', a projection containing no fields is supported.+-- Beam emits @RETURNING NULL::boolean@ inside the CTE and @SELECT FROM "cte0"@+-- outside it, retaining one zero-field row per updated row without exposing the+-- private sentinel. If neither the final statement nor another CTE needs the+-- updated-row output, use 'cteUpdate' instead.+--+-- @since 0.6.3.0+cteUpdateReturning+  :: ( Projectible Postgres a+     , ThreadRewritable PostgresInaccessible a+     , Projectible Postgres (WithRewrittenThread PostgresInaccessible CTE.QAnyScope a)+     , ThreadRewritable CTE.QAnyScope (WithRewrittenThread PostgresInaccessible CTE.QAnyScope a)+     )+  => DatabaseEntity Postgres db (TableEntity table)+  -> (forall s. table (QField s) -> QAssignment Postgres s)+  -> (forall s. table (QExpr Postgres s) -> QExpr Postgres s Bool)+  -> (table (QExpr Postgres PostgresInaccessible) -> a)+  -> PgWith db 'PgCteTopLevelOnly (Maybe (ReusableQ Postgres db (WithRewrittenThread PostgresInaccessible CTE.QAnyScope a)))+cteUpdateReturning table mkAssignments mkWhere mkProjection =+  case updateReturning table mkAssignments mkWhere mkProjection of+    PgUpdateReturningEmpty -> pure Nothing+    PgUpdateReturning syntax ->+      Just <$> pgDataModifyingCte syntax+ runPgUpdateReturningList   :: ( MonadBeam be m      , BeamSqlBackendSyntax be ~ PgCommandSyntax@@ -428,6 +1143,88 @@   where     SqlDelete _ pgDelete = delete table $ \t -> mkWhere t     tblQ = changeBeamRep (\(Columnar' f) -> Columnar' (QExpr (pure (fieldE (unqualifiedField (_fieldName f)))))) tblSettings++-- | Introduce a PostgreSQL @DELETE@ statement as a side-effect-only CTE.+--+-- The deletion executes exactly once even when the terminal statement does not+-- refer to it. Without @RETURNING@ it produces no reusable relation:+--+-- > pgInsertWith $ do+-- >   cteDelete stagingRows isExpired+-- >   pure (insert archive newRows onConflictDefault)+--+-- This renders a definition without an empty column list, followed by the+-- terminal insert:+--+-- @+-- WITH "cte0" AS+--        (DELETE FROM "staging_rows" AS "delete_target" WHERE ...)+-- INSERT INTO "archive" ...+-- @+--+-- Sibling modifying CTEs use the same PostgreSQL snapshot and cannot observe+-- one another's table changes. Use their @RETURNING@ output when one operation+-- needs to communicate rows to another.+--+-- @since 0.6.3.0+cteDelete+  :: DatabaseEntity Postgres db (TableEntity table)+  -> (forall s. table (QExpr Postgres s) -> QExpr Postgres s Bool)+  -> PgWith db 'PgCteTopLevelOnly ()+cteDelete table mkWhere =+  case delete table (\row -> mkWhere row) of+    SqlDelete _ (PgDeleteSyntax syntax) -> pgDataModifyingCte_ syntax++-- | Introduce a PostgreSQL @DELETE ... RETURNING@ statement as a+-- data-modifying common table expression. The returned value can be used in a+-- subsequent query with 'reuse'.+--+-- Data-modifying CTEs are restricted to top-level 'PgWith' blocks and cannot+-- be used with 'pgSelectWithNested'.+--+-- Unlike insert and update, delete always has a statement to introduce, so no+-- 'Maybe' is required:+--+-- > pgSelectWithTopLevel $ do+-- >   deleted <- cteDeleteReturning+-- >     users+-- >     (\user -> userExpired user ==. val_ True)+-- >     id+-- >   pure (reuse deleted)+--+-- The corresponding SQL has the following form:+--+-- @+-- WITH "cte0"("res0", "res1") AS+--        (DELETE FROM "users" AS "delete_target"+--         WHERE "delete_target"."expired" = TRUE+--         RETURNING "id", "expired")+-- SELECT "t0"."res0", "t0"."res1" FROM "cte0" AS "t0"+-- @+--+-- The final query observes the deleted rows through @DELETE ... RETURNING@.+-- This is also the supported way to communicate between data-modifying CTEs,+-- since PostgreSQL executes sibling statements against the same snapshot.+-- A projection containing no fields is also reusable: Beam emits a private+-- @NULL::boolean@ returning expression and an outer zero-column SELECT, so its+-- row count still equals the number of deleted rows. If neither the final+-- statement nor another CTE needs the deleted-row output, use 'cteDelete'+-- instead.+--+-- @since 0.6.3.0+cteDeleteReturning+  :: ( Projectible Postgres a+     , ThreadRewritable PostgresInaccessible a+     , Projectible Postgres (WithRewrittenThread PostgresInaccessible CTE.QAnyScope a)+     , ThreadRewritable CTE.QAnyScope (WithRewrittenThread PostgresInaccessible CTE.QAnyScope a)+     )+  => DatabaseEntity Postgres db (TableEntity table)+  -> (forall s. table (QExpr Postgres s) -> QExpr Postgres s Bool)+  -> (table (QExpr Postgres PostgresInaccessible) -> a)+  -> PgWith db 'PgCteTopLevelOnly (ReusableQ Postgres db (WithRewrittenThread PostgresInaccessible CTE.QAnyScope a))+cteDeleteReturning table mkWhere mkProjection =+  let PgDeleteReturning syntax = deleteReturning table mkWhere mkProjection+  in pgDataModifyingCte syntax  runPgDeleteReturningList   :: ( MonadBeam be m

@@ -21,7 +21,7 @@      , emit, emitBuilder, escapeString     , escapeBytea, escapeIdentifier-    , pgParens+    , pgParens, PgCteRecursiveness(..), pgWithSyntax     , pgStringLit, pgCharLit, pgBoolLit     , nextSyntaxStep @@ -30,6 +30,7 @@     , PgInsertSyntax(..)     , PgDeleteSyntax(..)     , PgUpdateSyntax(..)+    , PgCommonTableExpressionSyntax(..)      , PgExpressionSyntax(..), PgFromSyntax(..), PgTableNameSyntax(..)     , PgComparisonQuantifierSyntax(..)@@ -272,9 +273,54 @@ data PgSelectLockingClauseSyntax = PgSelectLockingClauseSyntax { pgSelectLockingClauseStrength :: PgSelectLockingStrength                                                                , pgSelectLockingTables :: [T.Text]                                                                , pgSelectLockingClauseOptions :: Maybe PgSelectLockingOptions }+-- | One named definition in a PostgreSQL @WITH@ clause.+--+-- This is exported for PostgreSQL extension modules. Application code should+-- normally construct CTEs through "Database.Beam.Postgres.Full".+--+-- @since 0.6.3.0 newtype PgCommonTableExpressionSyntax     = PgCommonTableExpressionSyntax { fromPgCommonTableExpression :: PgSyntax } +-- | Whether a PostgreSQL @WITH@ clause is recursive.+--+-- Keeping this distinction explicit avoids assigning a context-dependent+-- meaning to a 'Bool' at the low-level syntax boundary.+--+-- @since 0.6.3.0+data PgCteRecursiveness+    = PgCteNonrecursive+      -- ^ Emit @WITH@.+    | PgCteRecursive+      -- ^ Emit @WITH RECURSIVE@.+    deriving (Eq, Show)++-- | Prefix a PostgreSQL statement with a common-table-expression list.+-- The public CTE consumers use this prefix before their @SELECT@, @INSERT@,+-- @UPDATE@, and @DELETE@ terminal statements, so this operation works on the+-- shared raw syntax instead of giving the terminal statement a misleading+-- type.+--+-- An empty list leaves the statement unchanged. 'PgCteRecursive' selects+-- @WITH RECURSIVE@ when the CTE builder used recursive bindings.+--+-- @since 0.6.3.0+pgWithSyntax+    :: PgCteRecursiveness+    -> [PgCommonTableExpressionSyntax]+    -> PgSyntax+    -> PgSyntax+pgWithSyntax _ [] statement = statement+pgWithSyntax recursiveness ctes statement =+    emit withKeyword <>+    pgSepBy (emit ", ") (map fromPgCommonTableExpression ctes) <>+    emit " " <>+    statement+  where+    withKeyword = case recursiveness of+        PgCteNonrecursive -> "WITH "+        PgCteRecursive -> "WITH RECURSIVE "+ fromPgOrdering :: PgOrderingSyntax -> PgSyntax fromPgOrdering (PgOrderingSyntax s Nothing) = s fromPgOrdering (PgOrderingSyntax s (Just PgNullOrderingNullsFirst)) = s <> emit " NULLS FIRST"@@ -622,25 +668,27 @@     type Sql99SelectCTESyntax PgSelectSyntax = PgCommonTableExpressionSyntax      withSyntax ctes (PgSelectSyntax select) =-        PgSelectSyntax $-        emit "WITH " <>-        pgSepBy (emit ", ") (map fromPgCommonTableExpression ctes) <>-        select+        PgSelectSyntax (pgWithSyntax PgCteNonrecursive ctes select)  instance IsSql99RecursiveCommonTableExpressionSelectSyntax PgSelectSyntax where     withRecursiveSyntax ctes (PgSelectSyntax select) =-        PgSelectSyntax $-        emit "WITH RECURSIVE " <>-        pgSepBy (emit ", ") (map fromPgCommonTableExpression ctes) <>-        select+        PgSelectSyntax (pgWithSyntax PgCteRecursive ctes select)  instance IsSql99CommonTableExpressionSyntax PgCommonTableExpressionSyntax where     type Sql99CTESelectSyntax PgCommonTableExpressionSyntax = PgSelectSyntax      cteSubquerySyntax tbl fields (PgSelectSyntax select) =         PgCommonTableExpressionSyntax $-        pgQuotedIdentifier tbl <> pgParens (pgSepBy (emit ",") (map pgQuotedIdentifier fields)) <>+        pgQuotedIdentifier tbl <> columnAliases <>         emit " AS " <> pgParens select+      where+        -- PostgreSQL represents a degree-zero CTE by omitting its optional+        -- column-alias list. Rendering an empty pair of parentheses instead+        -- would be a syntax error.+        columnAliases =+          case fields of+            [] -> mempty+            _ -> pgParens (pgSepBy (emit ",") (map pgQuotedIdentifier fields))  instance IsSql2008BigIntDataTypeSyntax PgDataTypeSyntax where   bigIntType = PgDataTypeSyntax (PgDataTypeDescrOid (Pg.typoid Pg.int8) Nothing) (emit "BIGINT") bigIntType@@ -1587,4 +1635,3 @@       where         quoteIdentifierChar '"' = char8 '"' <> char8 '"'         quoteIdentifierChar c = char8 c-

@@ -1,5 +1,5 @@ name:                 beam-postgres-version:              0.6.2.0+version:              0.6.3.0 synopsis:             Connection layer between beam and postgres description:          Beam driver for <https://www.postgresql.org/ PostgreSQL>, an advanced open-source RDBMS homepage:             https://haskell-beam.github.io/beam/user-guide/backends/beam-postgres@@ -81,6 +81,8 @@   hs-source-dirs: test   main-is: Main.hs   other-modules: Database.Beam.Postgres.Test,+                 Database.Beam.Postgres.Test.CTE,+                 Database.Beam.Postgres.Test.CTENegative,                  Database.Beam.Postgres.Test.Copy,                  Database.Beam.Postgres.Test.Marshal,                  Database.Beam.Postgres.Test.Select,

@@ -13,19 +13,22 @@ withTestPostgres dbName getConnStr action = do   connStr <- getConnStr -  let connStrTemplate1 = connStr <> " dbname=template1"+  -- Create and drop isolated test databases from the administrative postgres+  -- database, leaving template1 free to serve as CREATE DATABASE's default+  -- template.+  let connStrAdmin = connStr <> " dbname=postgres"       connStrDb = connStr <> " dbname=" <> fromString dbName -      withTemplate1 :: (Pg.Connection -> IO b) -> IO b-      withTemplate1 = bracket (Pg.connectPostgreSQL connStrTemplate1) Pg.close+      withAdmin :: (Pg.Connection -> IO b) -> IO b+      withAdmin = bracket (Pg.connectPostgreSQL connStrAdmin) Pg.close -      createDatabase = withTemplate1 $ \c -> do+      createDatabase = withAdmin $ \c -> do                          void $ Pg.execute_ c (fromString ("CREATE DATABASE " <> dbName))                           Pg.connectPostgreSQL connStrDb       dropDatabase c = do         Pg.close c-        withTemplate1 $ \c' -> void $+        withAdmin $ \c' -> void $           Pg.execute_ c' (fromString ("DROP DATABASE " <> dbName))    bracket createDatabase dropDatabase action

@@ -0,0 +1,1334 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE StandaloneDeriving #-}++-- | Rendering, type-safety, and PostgreSQL integration tests for common table+-- expressions. Deliberately ill-typed expressions live in+-- "Database.Beam.Postgres.Test.CTENegative" so this module retains normal type+-- checking.+module Database.Beam.Postgres.Test.CTE (unitTests, integrationTests) where++import Control.Exception (TypeError, evaluate, try)+import qualified Data.ByteString.Lazy.Char8 as BL+import Data.ByteString (ByteString)+import Data.Int (Int32)+import Data.Kind (Type)+import Data.List (isInfixOf, isPrefixOf, sortOn)+import Data.Text (Text)++import Database.Beam+import Database.Beam.Postgres+import qualified Database.Beam.Postgres.Full as Pg+import qualified Database.Beam.Query.CTE as CTE+import Database.Beam.Postgres.Syntax+  ( PgDeleteSyntax(..)+  , PgInsertSyntax(..)+  , PgSelectSyntax(..)+  , PgUpdateSyntax(..)+  , PostgresInaccessible+  , pgRenderSyntaxScript+  )+import Database.PostgreSQL.Simple (execute_)++import qualified Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import Test.Tasty+import Test.Tasty.HUnit++import Database.Beam.Postgres.Test+import qualified Database.Beam.Postgres.Test.CTENegative as Negative++data CteRowT f = CteRow+  { cteId    :: C f Int32+  , cteValue :: C f Text+  } deriving (Generic, Beamable)++deriving instance Show (CteRowT Identity)+deriving instance Eq (CteRowT Identity)++-- A legal Haskell projection shape with no fields. PostgreSQL represents this+-- degree-zero relation by omitting the CTE column-alias list. Data-modifying+-- CTEs with RETURNING use a private physical sentinel to satisfy PostgreSQL's+-- grammar while retaining this zero-field shape at Beam's public boundary.+data EmptyCteT (f :: Type -> Type) = EmptyCte+  deriving (Generic, Beamable)++deriving instance Show (EmptyCteT Identity)+deriving instance Eq (EmptyCteT Identity)++instance Table CteRowT where+  data PrimaryKey CteRowT f = CteRowKey (C f Int32)+    deriving (Generic, Beamable)+  primaryKey = CteRowKey . cteId++newtype CteDb entity = CteDb+  { dbCteRows :: entity (TableEntity CteRowT)+  } deriving (Generic, Database Postgres)++cteDb :: DatabaseSettings Postgres CteDb+cteDb = defaultDbSettings++unitTests :: TestTree+unitTests = testGroup "Common table expression tests"+  [ renderingTests+  , typeSafetyTests+  ]++integrationTests :: IO ByteString -> TestTree+integrationTests getConn = testGroup "Common table expression integration tests"+  [ testMixedCteBodies getConn+  , testSideEffectOnlyCtes getConn+  , testMaterializationExecution getConn+  , testLiftedWithExecution getConn+  , testWithDmlConsumers getConn+  , testCteParameterOrdering getConn+  , testDataModifyingCteModel getConn+  , testSideEffectOnlyCteModel getConn+  , testWithDmlConsumerModel getConn+  , testRecursiveCteModel getConn+  , testDegreeZeroSelects getConn+  , testDegreeZeroDataModifyingCtes getConn+  , testDegreeZeroRepeatedReuse getConn+  ]++renderingTests :: TestTree+renderingTests = testGroup "Common table expression rendering tests"+  [ testMixedCteRendering+  , testMaterializationRendering+  , testNestedMaterializedCteRendering+  , testSideEffectOnlyRendering+  , testSideEffectNoOps+  , testLiftedWithNameSupply+  , testNestedSelectCteRendering+  , testRecursiveSelectThenDeleteRendering+  , testEmptyDataModifyingCtes+  , testWithDmlConsumerRendering+  , testRecursiveInsertWithRendering+  , testTopLevelOnlyDmlConsumerRendering+  , testEmptyDmlConsumers+  , testReturningAfterDmlConsumers+  , testDegreeZeroSelectRendering+  , testDegreeZeroDataModifyingRendering+  ]++-- These tests force expressions compiled with deferred type errors in the+-- isolated negative-fixture module. Checking fragments of GHC's error ensures+-- an unrelated deferred error cannot make a test pass accidentally.+typeSafetyTests :: TestTree+typeSafetyTests = testGroup "Common table expression type-safety tests"+  [ testCase "rejects a DELETE CTE inside pgSelectWith" $+      assertPlacementTypeError Negative.invalidNestedDelete+  , testCase "rejects an INSERT CTE inside pgSelectWith" $+      assertPlacementTypeError Negative.invalidNestedInsert+  , testCase "rejects an UPDATE CTE inside pgSelectWith" $+      assertPlacementTypeError Negative.invalidNestedUpdate+  , testCase "rejects SELECT followed by DELETE inside pgSelectWith" $+      assertPlacementTypeError Negative.invalidNestedSelectThenDelete+  , testCase "rejects DELETE followed by SELECT inside pgSelectWith" $+      assertPlacementTypeError Negative.invalidNestedDeleteThenSelect+  , testCase "conservatively rejects an empty INSERT inside pgSelectWith" $+      assertPlacementTypeError Negative.invalidNestedEmptyInsert+  , testCase "conservatively rejects an identity UPDATE inside pgSelectWith" $+      assertPlacementTypeError Negative.invalidNestedIdentityUpdate+  , testCase "rejects a side-effect-only DELETE inside pgSelectWithNested" $+      assertPlacementTypeError Negative.invalidNestedSideEffectDelete+  , testCase "placement cannot be bypassed with coerce" $+      assertPlacementTypeError Negative.invalidCoercedPlacement+  , testCase "rejects a recursively self-referencing INSERT CTE" $+      assertDeferredTypeErrorContaining+        ["No instance", "MonadFix", "PgCteTopLevelOnly"]+        Negative.invalidRecursiveInsert+  , testCase "side-effect-only CTE results cannot be reused" $+      assertDeferredTypeErrorContaining+        ["ReusableQ"]+        Negative.invalidReuseSideEffect+  ]++assertPlacementTypeError :: SqlSelect Postgres a -> Assertion+assertPlacementTypeError =+  assertDeferredTypeErrorContaining ["PgCteTopLevelOnly", "PgCteNestedAllowed"]++assertDeferredTypeErrorContaining+  :: [String]+  -> SqlSelect Postgres a+  -> Assertion+assertDeferredTypeErrorContaining expectedFragments sql = do+  result <- try (evaluate (BL.length (renderSelectBytes sql)))+  case result of+    Left (err :: TypeError) ->+      let message = show err+      in mapM_ (assertFragment message) expectedFragments+    Right _ ->+      assertFailure "expected the expression to contain a deferred type error"+  where+    assertFragment message fragment =+      assertBool+        ("mentions " ++ fragment ++ "\nDeferred error was:\n" ++ message)+        (fragment `isInfixOf` message)++-- A single top-level WITH block may freely mix SELECT and data-modifying CTE+-- bodies. Besides checking the individual keywords, this guards against+-- accidentally nesting a second WITH while combining the syntax fragments.+testMixedCteRendering :: TestTree+testMixedCteRendering = testCase "renders mixed SELECT, INSERT, UPDATE, and DELETE CTEs" $ do+  let sql = renderSelect mixedCteSelect+  assertBool "renders one top-level WITH" ("WITH " `isPrefixOf` sql)+  assertBool "does not render a nested WITH keyword" (not ("WITH WITH" `isInfixOf` sql))+  assertBool "renders INSERT" ("INSERT INTO" `isInfixOf` sql)+  assertBool "renders UPDATE" ("UPDATE" `isInfixOf` sql)+  assertBool "renders DELETE" ("DELETE FROM" `isInfixOf` sql)+  assertEqual "renders three RETURNING clauses" 3 (length (filter (== "RETURNING") (words sql)))++-- Materialization is an explicit PostgreSQL 12+ spelling choice. Check the+-- complete token rather than a loose MATERIALIZED substring, since the latter+-- would make the NOT MATERIALIZED case pass the positive assertion too.+testMaterializationRendering :: TestTree+testMaterializationRendering = testCase "renders every SELECT CTE materialization policy" $ do+  let defaultSql = renderSelect (materializationSelect Pg.PgCteDefault)+      materializedSql = renderSelect (materializationSelect Pg.PgCteMaterialized)+      notMaterializedSql = renderSelect (materializationSelect Pg.PgCteNotMaterialized)+  assertBool "default omits MATERIALIZED"+    (not (" MATERIALIZED (" `isInfixOf` defaultSql))+  assertBool "default omits NOT MATERIALIZED"+    (not (" NOT MATERIALIZED (" `isInfixOf` defaultSql))+  assertBool "renders AS MATERIALIZED"+    (" AS MATERIALIZED (" `isInfixOf` materializedSql)+  assertBool "renders AS NOT MATERIALIZED"+    (" AS NOT MATERIALIZED (" `isInfixOf` notMaterializedSql)++-- pgSelectWithNested is the safe nested consumer for PostgreSQL-specific+-- SELECT CTE features. This complements the compatibility test for the older+-- pgSelectWith API below.+testNestedMaterializedCteRendering :: TestTree+testNestedMaterializedCteRendering = testCase "embeds a materialized PgWith block in a subquery" $ do+  let sql = renderSelect nestedMaterializedCteSelect+  assertBool "renders the nested WITH"+    ("FROM (WITH " `isInfixOf` sql)+  assertBool "retains the materialization modifier"+    (" AS MATERIALIZED (" `isInfixOf` sql)++-- DML without RETURNING is still executed by PostgreSQL but forms no temporary+-- table and exposes no reusable result. Its CTE name must therefore have no+-- empty column-alias list.+testSideEffectOnlyRendering :: TestTree+testSideEffectOnlyRendering = testCase "renders side-effect-only INSERT, UPDATE, and DELETE CTEs" $ do+  let sql = renderSelect sideEffectOnlyCteSelect+  assertBool "renders INSERT" ("INSERT INTO" `isInfixOf` sql)+  assertBool "renders UPDATE" ("UPDATE" `isInfixOf` sql)+  assertBool "renders DELETE" ("DELETE FROM" `isInfixOf` sql)+  assertBool "does not render RETURNING" (not ("RETURNING" `isInfixOf` sql))+  assertBool "does not render an empty alias list" (not ("() AS" `isInfixOf` sql))++-- Empty inserts and identity updates should consume neither a name nor a CTE+-- slot. With no other CTEs, the final query must not acquire an empty WITH.+testSideEffectNoOps :: TestTree+testSideEffectNoOps = testCase "omits side-effect-only empty INSERT and identity UPDATE" $ do+  let sql = renderSelect sideEffectNoOpSelect+  assertBool "does not render WITH" (not ("WITH " `isPrefixOf` sql))+  assertBool "does not render INSERT" (not ("INSERT INTO" `isInfixOf` sql))+  assertBool "does not render UPDATE" (not ("UPDATE" `isInfixOf` sql))++-- Lifting a complete portable helper must not restart its State Int name+-- supply. Four definitions from native/lifted/native construction should be+-- allocated exactly once as cte0 through cte3.+testLiftedWithNameSupply :: TestTree+testLiftedWithNameSupply = testCase "shares CTE names across lifted and native builders" $ do+  let sql = renderSelect liftedWithSelect+  mapM_ (\name -> assertBool ("renders " ++ name) (("\"" ++ name ++ "\"") `isInfixOf` sql))+    ["cte0", "cte1", "cte2", "cte3"]+  assertBool "does not allocate cte4" (not ("\"cte4\"" `isInfixOf` sql))++-- pgSelectWith remains available for its original purpose: embedding a+-- SELECT-only WITH block as a subquery.+testNestedSelectCteRendering :: TestTree+testNestedSelectCteRendering = testCase "SELECT CTEs remain valid inside pgSelectWith" $ do+  let sql = renderSelect nestedSelectCteSelect+  assertBool "renders an inner WITH" ("FROM (WITH " `isInfixOf` sql)++-- Closing the recursive SELECT portion with pgToTopLevel should preserve WITH+-- RECURSIVE while allowing a later DELETE CTE in the same top-level block.+testRecursiveSelectThenDeleteRendering :: TestTree+testRecursiveSelectThenDeleteRendering = testCase "recursive SELECT can feed a top-level DELETE CTE" $ do+  let sql = renderSelect recursiveSelectThenDeleteCteSelect+  assertBool "renders WITH RECURSIVE" ("WITH RECURSIVE " `isPrefixOf` sql)+  assertBool "renders DELETE" ("DELETE FROM" `isInfixOf` sql)++-- Value-level empty operations must not leave behind an empty or partial WITH+-- clause when the final SELECT is rendered.+testEmptyDataModifyingCtes :: TestTree+testEmptyDataModifyingCtes = testCase "omits empty INSERT and identity UPDATE CTEs" $ do+  let sql = renderSelect emptyDataModifyingCteSelect+  assertBool "does not render WITH" (not ("WITH " `isPrefixOf` sql))+  assertBool "does not render INSERT" (not ("INSERT INTO" `isInfixOf` sql))+  assertBool "does not render UPDATE" (not ("UPDATE" `isInfixOf` sql))++-- Each PostgreSQL DML consumer must place the WITH block before, rather than+-- inside, its terminal statement. These rendering checks cover INSERT, UPDATE,+-- and DELETE while retaining Beam's existing Sql* result types.+testWithDmlConsumerRendering :: TestTree+testWithDmlConsumerRendering = testCase "renders WITH before terminal INSERT, UPDATE, and DELETE" $ do+  assertWithTerminal "INSERT INTO" (renderInsert insertWithStatement)+  assertWithTerminal "UPDATE" (renderUpdate updateWithStatement)+  assertWithTerminal "DELETE FROM" (renderDelete deleteWithStatement)++-- A recursive SELECT CTE is legal before a terminal DML statement. This makes+-- sure pgInsertWith preserves the recursive flag collected by With.+testRecursiveInsertWithRendering :: TestTree+testRecursiveInsertWithRendering = testCase "renders WITH RECURSIVE before a terminal INSERT" $ do+  sql <- requireRenderedStatement (renderInsert recursiveInsertWithStatement)+  assertBool "starts with WITH RECURSIVE" ("WITH RECURSIVE " `isPrefixOf` sql)+  assertBool "renders terminal INSERT" (" INSERT INTO" `isInfixOf` sql)++-- Top-level DML consumers may accept the stronger PgCteTopLevelOnly placement.+-- A data-modifying CTE followed by DELETE exercises that fact at compile time+-- as well as checking the resulting SQL shape.+testTopLevelOnlyDmlConsumerRendering :: TestTree+testTopLevelOnlyDmlConsumerRendering = testCase "accepts a modifying CTE before terminal DELETE" $ do+  sql <- requireRenderedStatement (renderDelete topLevelOnlyDeleteWithStatement)+  assertBool "renders DELETE as the CTE body"+    ("AS (DELETE FROM" `isInfixOf` sql)+  assertBool "renders DELETE as the terminal statement"+    (") DELETE FROM" `isInfixOf` sql)++-- An empty INSERT and identity UPDATE have no terminal statement. PostgreSQL+-- cannot execute a bare WITH clause, so their consumers must retain the+-- existing no-op representation and discard the accumulated definitions.+testEmptyDmlConsumers :: TestTree+testEmptyDmlConsumers = testCase "keeps empty INSERT and identity UPDATE as no-ops" $ do+  assertEqual "empty INSERT has no syntax" Nothing+    (renderInsert emptyInsertWithStatement)+  assertEqual "identity UPDATE has no syntax" Nothing+    (renderUpdate identityUpdateWithStatement)++-- The consumers deliberately return the existing Sql* wrappers. Their+-- PgReturning instances must therefore remain usable without a parallel+-- pgInsertReturningWith/pgUpdateReturningWith/pgDeleteReturningWith API.+testReturningAfterDmlConsumers :: TestTree+testReturningAfterDmlConsumers = testCase "supports RETURNING after each terminal DML consumer" $ do+  assertReturning "INSERT" (renderInsertReturning (Pg.returning insertWithStatement id))+  assertReturning "UPDATE" (renderUpdateReturning (Pg.returning updateWithStatement id))+  assertReturning "DELETE" (renderDeleteReturning (Pg.returning deleteWithStatement id))++-- PostgreSQL's syntax for a degree-zero CTE has no column-alias parentheses.+-- Cover both the portable selecting renderer and the native renderer, including+-- nested and explicit materialization forms, because they enter PostgreSQL+-- syntax through different code paths.+testDegreeZeroSelectRendering :: TestTree+testDegreeZeroSelectRendering = testCase "renders reusable degree-zero SELECT CTEs" $ do+  let portableSql = renderSelect emptySelectProjection+      nativeSql = renderSelect+        (emptyNativeSelectProjection Pg.PgCteDefault)+      materializedSql = renderSelect+        (emptyNativeSelectProjection Pg.PgCteMaterialized)+      nestedSql = renderSelect nestedEmptySelectProjection++  mapM_ assertDegreeZeroSelect+    [portableSql, nativeSql, materializedSql, nestedSql]+  assertBool "retains explicit materialization"+    (" AS MATERIALIZED (" `isInfixOf` materializedSql)+  assertBool "remains valid in a nested SELECT"+    ("FROM (WITH " `isInfixOf` nestedSql)+  where+    assertDegreeZeroSelect sql = do+      assertBool "does not render an empty CTE alias list"+        (not ("\"cte0\"()" `isInfixOf` sql))+      assertBool "the CTE body projects no columns"+        ("SELECT  FROM" `isInfixOf` sql || "SELECT FROM" `isInfixOf` sql)+      assertBool "the consumer projects no columns"+        ("SELECT  FROM \"cte0\"" `isInfixOf` sql ||+         "SELECT FROM \"cte0\"" `isInfixOf` sql)++-- INSERT, UPDATE, and DELETE share the sentinel path but have independent+-- RETURNING renderers. Assert every spelling, including that the physical+-- sentinel is declared once and is not selected by the zero-field consumer.+testDegreeZeroDataModifyingRendering :: TestTree+testDegreeZeroDataModifyingRendering =+  testCase "renders reusable degree-zero data-modifying CTEs" $+    mapM_ assertDegreeZeroDml+      [ ("INSERT", renderSelect (emptyInsertProjection [CteRow 1 "one"]))+      , ("UPDATE", renderSelect (emptyUpdateProjection 1 "updated"))+      , ("DELETE", renderSelect (emptyDeleteProjection 1))+      ]+  where+    assertDegreeZeroDml (command, sql) = do+      assertBool (command ++ " declares one physical sentinel")+        ("\"cte0\"(\"res0\") AS" `isInfixOf` sql)+      assertBool (command ++ " appends a valid RETURNING expression")+        (" RETURNING NULL::boolean" `isInfixOf` sql)+      assertEqual (command ++ " emits one RETURNING keyword")+        1+        (length (filter (== "RETURNING") (words sql)))+      assertBool (command ++ " does not expose the sentinel")+        ("SELECT  FROM \"cte0\"" `isInfixOf` sql ||+         "SELECT FROM \"cte0\"" `isInfixOf` sql)++-- Rendering alone cannot verify PostgreSQL's execution and snapshot semantics.+-- This integration case checks both the RETURNING rows and the final table+-- state after all three modifying CTEs execute.+testMixedCteBodies :: IO ByteString -> TestTree+testMixedCteBodies getConn = testCase "SELECT and data-modifying CTEs can be mixed" $+  withTestPostgres "mixed_cte_bodies" getConn $ \conn -> do+    execute_ conn "CREATE TABLE cte_rows (id INT PRIMARY KEY, value TEXT NOT NULL)"+    execute_ conn "INSERT INTO cte_rows VALUES (1, 'selected'), (3, 'before-update'), (4, 'deleted')"++    result <- runBeamPostgres conn $ runSelectReturningList mixedCteSelect++    assertEqual "rows returned by each CTE"+      [ ( CteRow 1 "selected"+        , CteRow 2 "inserted"+        , CteRow 3 "updated"+        , CteRow 4 "deleted"+        )+      ]+      result++    remaining <- runBeamPostgres conn $ runSelectReturningList $ select $+      orderBy_ (asc_ . cteId) $ all_ (dbCteRows cteDb)+    assertEqual "data modifications were applied"+      [ CteRow 1 "selected"+      , CteRow 2 "inserted"+      , CteRow 3 "updated"+      ]+      remaining++-- PostgreSQL executes a modifying CTE exactly once even when it has no+-- RETURNING clause and the terminal SELECT does not reference it. Verify that+-- all three commands affect the final database state, not merely that their+-- syntax parses.+testSideEffectOnlyCtes :: IO ByteString -> TestTree+testSideEffectOnlyCtes getConn = testCase "unreferenced side-effect-only CTEs execute once" $+  withTestPostgres "side_effect_only_ctes" getConn $ \conn -> do+    execute_ conn "CREATE TABLE cte_rows (id INT PRIMARY KEY, value TEXT NOT NULL)"+    execute_ conn "INSERT INTO cte_rows VALUES (1, 'unchanged'), (2, 'before-update'), (3, 'delete-me')"++    marker <- runBeamPostgres conn $+      runSelectReturningOne sideEffectOnlyCteSelect+    assertEqual "terminal SELECT still runs" (Just (1 :: Int32)) marker++    remaining <- runBeamPostgres conn $ runSelectReturningList $ select $+      orderBy_ (asc_ . cteId) $ all_ (dbCteRows cteDb)+    assertEqual "all expected side effects were applied"+      [ CteRow 1 "unchanged"+      , CteRow 2 "after-update"+      , CteRow 4 "inserted"+      ]+      remaining++-- Planner choices are deliberately not asserted because they may vary across+-- PostgreSQL releases. Successful execution and equal results validate the two+-- explicit PostgreSQL 12+ spellings without coupling the test to EXPLAIN.+testMaterializationExecution :: IO ByteString -> TestTree+testMaterializationExecution getConn = testCase "MATERIALIZED and NOT MATERIALIZED execute" $+  withTestPostgres "cte_materialization" getConn $ \conn -> do+    execute_ conn "CREATE TABLE cte_rows (id INT PRIMARY KEY, value TEXT NOT NULL)"+    execute_ conn "INSERT INTO cte_rows VALUES (1, 'one'), (2, 'two')"++    materialized <- runBeamPostgres conn $ runSelectReturningList $+      materializationSelect Pg.PgCteMaterialized+    notMaterialized <- runBeamPostgres conn $ runSelectReturningList $+      materializationSelect Pg.PgCteNotMaterialized+    assertEqual "both policies preserve query results" materialized notMaterialized++-- Rendering checks the shared name supply; execution additionally proves that+-- ReusableQ values returned by a lifted multi-CTE helper retain their meaning.+testLiftedWithExecution :: IO ByteString -> TestTree+testLiftedWithExecution getConn = testCase "a lifted multi-CTE helper remains reusable" $+  withTestPostgres "lifted_with_execution" getConn $ \conn -> do+    lifted <- runBeamPostgres conn $ runSelectReturningList liftedWithSelect+    assertEqual "a lifted multi-CTE helper remains reusable"+      [(1, 11, 12)]+      lifted++-- Execute each terminal DML consumer against PostgreSQL. The three statements+-- use SELECT CTEs to choose or construct their affected rows, proving that the+-- reusable names remain visible to INSERT, UPDATE, and DELETE.+testWithDmlConsumers :: IO ByteString -> TestTree+testWithDmlConsumers getConn = testCase "WITH can terminate in INSERT, UPDATE, or DELETE" $+  withTestPostgres "with_dml_consumers" getConn $ \conn -> do+    execute_ conn "CREATE TABLE cte_rows (id INT PRIMARY KEY, value TEXT NOT NULL)"+    execute_ conn "INSERT INTO cte_rows VALUES (1, 'source'), (3, 'before-update'), (4, 'delete-me')"++    runBeamPostgres conn $ do+      runInsert insertWithStatement+      runUpdate updateWithStatement+      runDelete deleteWithStatement++    remaining <- runBeamPostgres conn $ runSelectReturningList $ select $+      orderBy_ (asc_ . cteId) $ all_ (dbCteRows cteDb)+    assertEqual "all terminal DML statements used their CTE rows"+      [ CteRow 1 "source"+      , CteRow 2 "inserted-with"+      , CteRow 3 "updated-with"+      ]+      remaining++-- PostgreSQL receives Beam values separately from the rendered placeholders.+-- Generate distinct values at each syntactic level so any disagreement between+-- syntax construction order and parameter collection order becomes observable+-- in the returned rows, rather than merely producing valid-looking SQL.+testCteParameterOrdering :: IO ByteString -> TestTree+testCteParameterOrdering getConn = testCase "preserves parameter order across CTE bodies and the terminal query" $+  withTestPostgres "cte_parameter_ordering_property" getConn $ \conn -> do+    passes <- Hedgehog.check . Hedgehog.property $ do+      baseId <- Hedgehog.forAll (Gen.int (Range.linear (-100000) 100000))+      firstOffset <- Hedgehog.forAll (Gen.int (Range.linear 1 1000))+      secondOffset <- Hedgehog.forAll (Gen.int (Range.linear 1 1000))+      payload <- Hedgehog.forAll (Gen.text (Range.linear 0 24) Gen.alphaNum)++      let first = CteRow (fromIntegral baseId) ("first:" <> payload)+          second = CteRow+            (fromIntegral (baseId + firstOffset))+            ("second:" <> payload)+          terminal = CteRow+            (fromIntegral (baseId + firstOffset + secondOffset))+            ("terminal:" <> payload)++      actual <- Hedgehog.evalIO $ runBeamPostgres conn $+        runSelectReturningList (parameterOrderingSelect first second terminal)++      actual Hedgehog.=== [(first, second, terminal)]++    assertBool "CTE parameter-ordering property failed" passes++-- Model a statement containing all three kinds of data-modifying CTE. The+-- operations use disjoint keys, avoiding PostgreSQL's deliberately unspecified+-- ordering when sibling modifying CTEs affect the same row. Both RETURNING+-- values and durable table state are compared with the pure expected result.+testDataModifyingCteModel :: IO ByteString -> TestTree+testDataModifyingCteModel getConn = testCase "data-modifying CTEs agree with a pure table model" $+  withTestPostgres "data_modifying_cte_model_property" getConn $ \conn -> do+    execute_ conn "CREATE TABLE cte_rows (id INT PRIMARY KEY, value TEXT NOT NULL)"++    passes <- Hedgehog.check . Hedgehog.property $ do+      baseId <- Hedgehog.forAll (Gen.int (Range.linear (-100000) 96000))+      payload <- Hedgehog.forAll (Gen.text (Range.linear 0 24) Gen.alphaNum)++      let inserted = CteRow (fromIntegral baseId) ("inserted:" <> payload)+          beforeUpdate = CteRow (fromIntegral (baseId + 1)) ("before-update:" <> payload)+          updated = CteRow (cteId beforeUpdate) ("updated:" <> payload)+          deleted = CteRow (fromIntegral (baseId + 2)) ("deleted:" <> payload)+          untouched = CteRow (fromIntegral (baseId + 3)) ("untouched:" <> payload)+          initial = [beforeUpdate, deleted, untouched]+          expectedFinal = [inserted, updated, untouched]++      Hedgehog.evalIO $ do+        execute_ conn "TRUNCATE TABLE cte_rows"+        runBeamPostgres conn $ runInsert $+          insert (dbCteRows cteDb) (insertValues initial)++      returned <- Hedgehog.evalIO $ runBeamPostgres conn $+        runSelectReturningList $+          dataModifyingCteModelSelect inserted (cteId updated) (cteValue updated) (cteId deleted)++      finalRows <- Hedgehog.evalIO $ runBeamPostgres conn $+        runSelectReturningList $ select $+          orderBy_ (asc_ . cteId) $ all_ (dbCteRows cteDb)++      returned Hedgehog.=== [(inserted, updated, deleted)]+      finalRows Hedgehog.=== expectedFinal++    assertBool "data-modifying CTE model property failed" passes++-- Repeat the three-operation model without RETURNING. This catches parameter+-- ordering or accidental omission in the side-effect-only path by+-- comparing durable state over generated inputs.+testSideEffectOnlyCteModel :: IO ByteString -> TestTree+testSideEffectOnlyCteModel getConn = testCase "side-effect-only CTEs agree with a pure table model" $+  withTestPostgres "side_effect_only_cte_model_property" getConn $ \conn -> do+    execute_ conn "CREATE TABLE cte_rows (id INT PRIMARY KEY, value TEXT NOT NULL)"++    passes <- Hedgehog.check . Hedgehog.property $ do+      baseId <- Hedgehog.forAll (Gen.int (Range.linear (-100000) 96000))+      payload <- Hedgehog.forAll (Gen.text (Range.linear 0 24) Gen.alphaNum)++      let inserted = CteRow (fromIntegral baseId) ("inserted:" <> payload)+          beforeUpdate = CteRow (fromIntegral (baseId + 1)) ("before-update:" <> payload)+          updated = CteRow (cteId beforeUpdate) ("updated:" <> payload)+          deleted = CteRow (fromIntegral (baseId + 2)) ("deleted:" <> payload)+          untouched = CteRow (fromIntegral (baseId + 3)) ("untouched:" <> payload)+          initial = [beforeUpdate, deleted, untouched]+          expectedFinal = [inserted, updated, untouched]++      Hedgehog.evalIO $ do+        execute_ conn "TRUNCATE TABLE cte_rows"+        runBeamPostgres conn $ runInsert $+          insert (dbCteRows cteDb) (insertValues initial)++      marker <- Hedgehog.evalIO $ runBeamPostgres conn $+        runSelectReturningOne $+          sideEffectCteModelSelect inserted (cteId updated) (cteValue updated) (cteId deleted)+      finalRows <- Hedgehog.evalIO $ runBeamPostgres conn $+        runSelectReturningList $ select $+          orderBy_ (asc_ . cteId) $ all_ (dbCteRows cteDb)++      marker Hedgehog.=== Just (1 :: Int32)+      finalRows Hedgehog.=== expectedFinal++    assertBool "side-effect-only CTE model property failed" passes++-- Exercise each top-level WITH consumer with independently generated values.+-- RETURNING results prove that the existing PostgreSQL execution instances can+-- still consume the Sql* wrappers, while the final table comparison checks the+-- combined INSERT, UPDATE, and DELETE behavior against a pure model.+testWithDmlConsumerModel :: IO ByteString -> TestTree+testWithDmlConsumerModel getConn = testCase "WITH DML consumers agree with a pure table model" $+  withTestPostgres "with_dml_consumer_model_property" getConn $ \conn -> do+    execute_ conn "CREATE TABLE cte_rows (id INT PRIMARY KEY, value TEXT NOT NULL)"++    passes <- Hedgehog.check . Hedgehog.property $ do+      baseId <- Hedgehog.forAll (Gen.int (Range.linear (-100000) 95000))+      payload <- Hedgehog.forAll (Gen.text (Range.linear 0 24) Gen.alphaNum)++      let source = CteRow (fromIntegral baseId) ("source:" <> payload)+          inserted = CteRow (fromIntegral (baseId + 1)) ("inserted:" <> payload)+          beforeUpdate = CteRow (fromIntegral (baseId + 2)) ("before-update:" <> payload)+          updated = CteRow (cteId beforeUpdate) ("updated:" <> payload)+          deleted = CteRow (fromIntegral (baseId + 3)) ("deleted:" <> payload)+          untouched = CteRow (fromIntegral (baseId + 4)) ("untouched:" <> payload)+          initial = [source, beforeUpdate, deleted, untouched]+          expectedFinal = [source, inserted, updated, untouched]++      Hedgehog.evalIO $ do+        execute_ conn "TRUNCATE TABLE cte_rows"+        runBeamPostgres conn $ runInsert $+          insert (dbCteRows cteDb) (insertValues initial)++      (insertedRows, updatedRows, deletedRows) <- Hedgehog.evalIO $+        runBeamPostgres conn $ do+          insertedRows <- Pg.runPgInsertReturningList $ Pg.returning+            (modelInsertWithStatement (cteId source) inserted) id+          updatedRows <- Pg.runPgUpdateReturningList $ Pg.returning+            (modelUpdateWithStatement (cteId updated) (cteValue updated)) id+          deletedRows <- Pg.runPgDeleteReturningList $ Pg.returning+            (modelDeleteWithStatement (cteId deleted)) id+          pure (insertedRows, updatedRows, deletedRows)++      finalRows <- Hedgehog.evalIO $ runBeamPostgres conn $+        runSelectReturningList $ select $+          orderBy_ (asc_ . cteId) $ all_ (dbCteRows cteDb)++      insertedRows Hedgehog.=== [inserted]+      updatedRows Hedgehog.=== [updated]+      deletedRows Hedgehog.=== [deleted]+      finalRows Hedgehog.=== expectedFinal++    assertBool "WITH DML consumer model property failed" passes++-- Generate a bounded recursive sequence, use it to drive a DELETE CTE, and+-- compare both the returned rows and remaining table against the corresponding+-- Haskell lists. This executes the recursive SELECT, its pgToTopLevel promotion,+-- and the following modifying CTE rather than checking only rendered keywords.+testRecursiveCteModel :: IO ByteString -> TestTree+testRecursiveCteModel getConn = testCase "recursive CTE execution agrees with a bounded sequence model" $+  withTestPostgres "recursive_cte_model_property" getConn $ \conn -> do+    execute_ conn "CREATE TABLE cte_rows (id INT PRIMARY KEY, value TEXT NOT NULL)"++    passes <- Hedgehog.check . Hedgehog.property $ do+      start <- Hedgehog.forAll (Gen.int (Range.linear (-100000) 95000))+      count <- Hedgehog.forAll (Gen.int (Range.linear 1 25))+      payload <- Hedgehog.forAll (Gen.text (Range.linear 0 24) Gen.alphaNum)++      let startId = fromIntegral start+          endId = fromIntegral (start + count - 1)+          recursiveRows =+            [ CteRow (fromIntegral rowId) ("recursive:" <> payload)+            | rowId <- [start .. start + count - 1]+            ]+          untouched = CteRow (fromIntegral (start + count)) ("untouched:" <> payload)++      Hedgehog.evalIO $ do+        execute_ conn "TRUNCATE TABLE cte_rows"+        runBeamPostgres conn $ runInsert $+          insert (dbCteRows cteDb) (insertValues (recursiveRows ++ [untouched]))++      deletedRows <- Hedgehog.evalIO $ runBeamPostgres conn $+        runSelectReturningList (recursiveCteModelSelect startId endId)+      finalRows <- Hedgehog.evalIO $ runBeamPostgres conn $+        runSelectReturningList $ select $+          orderBy_ (asc_ . cteId) $ all_ (dbCteRows cteDb)++      sortOn cteId deletedRows Hedgehog.=== recursiveRows+      finalRows Hedgehog.=== [untouched]++    assertBool "recursive CTE model property failed" passes++-- A row need not contain a projected value. PostgreSQL still returns one+-- zero-field result for every source row, and postgresql-simple must decode the+-- final rows without expecting any result fields. Exercise both the portable+-- and native builders and both explicit materialization policies.+testDegreeZeroSelects :: IO ByteString -> TestTree+testDegreeZeroSelects getConn = testCase "degree-zero SELECT CTEs preserve source cardinality" $+  withTestPostgres "degree_zero_select_ctes" getConn $ \conn -> do+    execute_ conn "CREATE TABLE cte_rows (id INT PRIMARY KEY, value TEXT NOT NULL)"++    emptySummary <- runBeamPostgres conn $ runSelectReturningOne $+      emptySelectSummary+    assertEqual "an empty degree-zero relation has count zero and is not present"+      (Just (0, False))+      emptySummary++    execute_ conn "INSERT INTO cte_rows VALUES (1, 'one'), (2, 'two'), (3, 'three')"++    portable <- runBeamPostgres conn $+      runSelectReturningList emptySelectProjection+    native <- runBeamPostgres conn $ runSelectReturningList $+      emptyNativeSelectProjection Pg.PgCteDefault+    materialized <- runBeamPostgres conn $ runSelectReturningList $+      emptyNativeSelectProjection Pg.PgCteMaterialized+    notMaterialized <- runBeamPostgres conn $ runSelectReturningList $+      emptyNativeSelectProjection Pg.PgCteNotMaterialized+    populatedSummary <- runBeamPostgres conn $ runSelectReturningOne $+      emptySelectSummary++    let expected = replicate 3 EmptyCte+    assertEqual "portable selecting preserves cardinality" expected portable+    assertEqual "native default preserves cardinality" expected native+    assertEqual "MATERIALIZED preserves cardinality" expected materialized+    assertEqual "NOT MATERIALIZED preserves cardinality" expected notMaterialized+    assertEqual "aggregates and EXISTS observe degree-zero rows"+      (Just (3, True))+      populatedSummary++-- Each modifying command has a separate RETURNING renderer. Besides validating+-- all three, this checks the boundary cases of several affected rows and no+-- affected rows, verifies that the private sentinel is not passed to the row+-- decoder, and compares the resulting durable table state.+testDegreeZeroDataModifyingCtes :: IO ByteString -> TestTree+testDegreeZeroDataModifyingCtes getConn =+  testCase "degree-zero modifying CTEs preserve affected-row cardinality" $+    withTestPostgres "degree_zero_modifying_ctes" getConn $ \conn -> do+      execute_ conn "CREATE TABLE cte_rows (id INT PRIMARY KEY, value TEXT NOT NULL)"+      execute_ conn "INSERT INTO cte_rows VALUES (1, 'one'), (2, 'two'), (3, 'three')"++      inserted <- runBeamPostgres conn $ runSelectReturningList $+        emptyInsertProjection [CteRow 4 "four", CteRow 5 "five"]+      updated <- runBeamPostgres conn $ runSelectReturningList $+        emptyUpdateProjection 2 "updated"+      deleted <- runBeamPostgres conn $ runSelectReturningList $+        emptyDeleteProjection 3+      deletedNone <- runBeamPostgres conn $ runSelectReturningList $+        emptyDeleteProjection 99++      assertEqual "INSERT retains two affected rows"+        (replicate 2 EmptyCte) inserted+      assertEqual "UPDATE retains two affected rows"+        (replicate 2 EmptyCte) updated+      assertEqual "DELETE retains three affected rows"+        (replicate 3 EmptyCte) deleted+      assertEqual "a command affecting no rows returns an empty relation"+        [] deletedNone++      remaining <- runBeamPostgres conn $ runSelectReturningList $ select $+        orderBy_ (asc_ . cteId) $ all_ (dbCteRows cteDb)+      assertEqual "all modifying commands applied their side effects"+        [CteRow 1 "updated", CteRow 2 "updated"]+        remaining++-- Reusing a degree-zero modifying CTE twice is a useful stress case: no field+-- can carry cardinality through the query, so the nine rows show that both+-- references read the same three-row RETURNING result. The final table state+-- separately confirms that the DELETE removed every source row.+testDegreeZeroRepeatedReuse :: IO ByteString -> TestTree+testDegreeZeroRepeatedReuse getConn =+  testCase "repeated degree-zero reuse preserves relational cardinality" $+    withTestPostgres "degree_zero_repeated_reuse" getConn $ \conn -> do+      execute_ conn "CREATE TABLE cte_rows (id INT PRIMARY KEY, value TEXT NOT NULL)"+      execute_ conn "INSERT INTO cte_rows VALUES (1, 'one'), (2, 'two'), (3, 'three')"++      summary <- runBeamPostgres conn $ runSelectReturningOne $+        emptyDeleteSummary+      assertEqual "COUNT and EXISTS observe every returned DELETE row"+        (Just (3, True))+        summary++      execute_ conn "INSERT INTO cte_rows VALUES (1, 'one'), (2, 'two'), (3, 'three')"+      products <- runBeamPostgres conn $ runSelectReturningList $+        repeatedEmptyDeleteProjection+      assertEqual "two references form the expected Cartesian product"+        (replicate 9 EmptyCte)+        products++      remaining <- runBeamPostgres conn $ runSelectReturningList $ select $+        all_ (dbCteRows cteDb)+      assertEqual "the modifying CTE deletes every source row"+        []+        remaining++materializationSelect+  :: Pg.PgCteMaterialization+  -> SqlSelect Postgres (CteRowT Identity)+materializationSelect materialization = Pg.pgSelectWithTopLevel $ do+  rows <- Pg.pgSelectingWith materialization $ all_ (dbCteRows cteDb)+  pure (reuse rows)++nestedMaterializedCteSelect :: SqlSelect Postgres (CteRowT Identity)+nestedMaterializedCteSelect = select $ Pg.pgSelectWithNested $ do+  rows <- Pg.pgSelectingWith Pg.PgCteMaterialized $+    all_ (dbCteRows cteDb)+  pure (reuse rows)++sideEffectOnlyCteSelect :: SqlSelect Postgres Int32+sideEffectOnlyCteSelect = Pg.pgSelectWithTopLevel $ do+  Pg.cteInsert+    (dbCteRows cteDb)+    (insertValues [CteRow 4 "inserted"])+    Pg.onConflictDefault+  Pg.cteUpdate+    (dbCteRows cteDb)+    (\row -> cteValue row <-. val_ "after-update")+    (\row -> cteId row ==. val_ 2)+  Pg.cteDelete+    (dbCteRows cteDb)+    (\row -> cteId row ==. val_ 3)+  pure finalMarkerQuery++sideEffectNoOpSelect :: SqlSelect Postgres Int32+sideEffectNoOpSelect = Pg.pgSelectWithTopLevel $ do+  Pg.cteInsert+    (dbCteRows cteDb)+    SqlInsertValuesEmpty+    Pg.onConflictDefault+  Pg.cteUpdate+    (dbCteRows cteDb)+    (const mempty)+    (const (val_ True))+  pure finalMarkerQuery++finalMarkerQuery+  :: Q Postgres CteDb QBaseScope (QExpr Postgres QBaseScope Int32)+finalMarkerQuery = pure (val_ 1)++-- A complete two-CTE portable helper is lifted as one action. Its internal+-- dependency also proves that lifting preserves ReusableQ values, not only the+-- emitted syntax fragments.+portableWithHelper+  :: With Postgres CteDb+       (ReusableQ Postgres CteDb (QExpr Postgres CTE.QAnyScope Int32))+portableWithHelper = do+  first <- selecting $ pure (as_ @Int32 (val_ 10))+  selecting $ do+    value <- reuse first+    pure (value + 1)++liftedWithSelect+  :: SqlSelect Postgres+       (Int32, Int32, Int32)+liftedWithSelect = Pg.pgSelectWithTopLevel $ do+  nativeBefore <- Pg.pgSelecting $ pure (as_ @Int32 (val_ 1))+  lifted <- Pg.pgLiftWith portableWithHelper+  nativeAfter <- Pg.pgSelecting $ do+    value <- reuse lifted+    pure (value + 1)+  pure $ do+    before <- reuse nativeBefore+    middle <- reuse lifted+    after <- reuse nativeAfter+    pure (before, middle, after)++-- Exercise the main user-facing flow: bind a normal SELECT CTE, perform each+-- supported data modification, then join all four reusable results in the final+-- SELECT. The placement of the complete block is inferred as top-level-only.+mixedCteSelect+  :: SqlSelect Postgres+       ( CteRowT Identity+       , CteRowT Identity+       , CteRowT Identity+       , CteRowT Identity+       )+mixedCteSelect = Pg.pgSelectWithTopLevel $ do+  selected <- Pg.pgSelecting $ do+    row <- all_ (dbCteRows cteDb)+    guard_ (cteId row ==. val_ 1)+    pure row++  inserted <- Pg.cteInsertReturning+    (dbCteRows cteDb)+    (insertValues [CteRow 2 "inserted"])+    Pg.onConflictDefault+    id++  updated <- Pg.cteUpdateReturning+    (dbCteRows cteDb)+    (\row -> cteValue row <-. val_ "updated")+    (\row -> cteId row ==. val_ 3)+    id++  deleted <- Pg.cteDeleteReturning+    (dbCteRows cteDb)+    (\row -> cteId row ==. val_ 4)+    id++  case (inserted, updated) of+    (Just inserted', Just updated') -> pure $ do+      selectedRow <- reuse selected+      insertedRow <- reuse inserted'+      updatedRow <- reuse updated'+      deletedRow <- reuse deleted+      pure (selectedRow, insertedRow, updatedRow, deletedRow)+    _ -> error "Expected non-empty INSERT and UPDATE CTEs"++-- Place values in two dependent CTE bodies and in the terminating SELECT. The+-- dependency prevents the second CTE from becoming an unrelated test fragment,+-- while the result exposes every bound value for exact comparison.+parameterOrderingSelect+  :: CteRowT Identity+  -> CteRowT Identity+  -> CteRowT Identity+  -> SqlSelect Postgres+       (CteRowT Identity, CteRowT Identity, CteRowT Identity)+parameterOrderingSelect first second terminal = selectWith $ do+  firstRows <- selecting $ pure (cteRowValues_ @CTE.QAnyScope first)+  secondRows <- selecting $ do+    _ <- reuse firstRows+    pure (cteRowValues_ @CTE.QAnyScope second)+  pure $ do+    firstRow <- reuse firstRows+    secondRow <- reuse secondRows+    pure+      ( firstRow+      , secondRow+      , cteRowValues_ @QBaseScope terminal+      )++cteRowValues_+  :: forall scope. CteRowT Identity -> CteRowT (QExpr Postgres scope)+cteRowValues_ row = CteRow (val_ (cteId row)) (val_ (cteValue row))++-- The returned relation exposes the result of every modifying CTE. Keeping+-- their keys disjoint gives the property a deterministic reference model while+-- still exercising mixed syntax assembly and PostgreSQL execution semantics.+dataModifyingCteModelSelect+  :: CteRowT Identity+  -> Int32+  -> Text+  -> Int32+  -> SqlSelect Postgres+       (CteRowT Identity, CteRowT Identity, CteRowT Identity)+dataModifyingCteModelSelect inserted updateId updateValue deleteId =+  Pg.pgSelectWithTopLevel $ do+    insertedRows <- Pg.cteInsertReturning+      (dbCteRows cteDb)+      (insertValues [inserted])+      Pg.onConflictDefault+      id+    updatedRows <- Pg.cteUpdateReturning+      (dbCteRows cteDb)+      (\row -> cteValue row <-. val_ updateValue)+      (\row -> cteId row ==. val_ updateId)+      id+    deletedRows <- Pg.cteDeleteReturning+      (dbCteRows cteDb)+      (\row -> cteId row ==. val_ deleteId)+      id++    case (insertedRows, updatedRows) of+      (Just insertedRows', Just updatedRows') -> pure $ do+        insertedRow <- reuse insertedRows'+        updatedRow <- reuse updatedRows'+        deletedRow <- reuse deletedRows+        pure (insertedRow, updatedRow, deletedRow)+      _ -> error "Expected non-empty INSERT and UPDATE CTEs"++sideEffectCteModelSelect+  :: CteRowT Identity+  -> Int32+  -> Text+  -> Int32+  -> SqlSelect Postgres Int32+sideEffectCteModelSelect inserted updateId updateValue deleteId =+  Pg.pgSelectWithTopLevel $ do+    Pg.cteInsert+      (dbCteRows cteDb)+      (insertValues [inserted])+      Pg.onConflictDefault+    Pg.cteUpdate+      (dbCteRows cteDb)+      (\row -> cteValue row <-. val_ updateValue)+      (\row -> cteId row ==. val_ updateId)+    Pg.cteDelete+      (dbCteRows cteDb)+      (\row -> cteId row ==. val_ deleteId)+    pure finalMarkerQuery++-- The source key is selected in a CTE, then used to derive the inserted key.+-- This keeps both the CTE and terminal INSERT semantically relevant.+modelInsertWithStatement+  :: Int32+  -> CteRowT Identity+  -> SqlInsert Postgres CteRowT+modelInsertWithStatement sourceId inserted = Pg.pgInsertWith $ do+  sourceIds <- Pg.pgSelecting $ do+    row <- all_ (dbCteRows cteDb)+    guard_ (cteId row ==. val_ sourceId)+    pure (cteId row)+  pure $ Pg.insert+    (dbCteRows cteDb)+    (insertFrom $ do+      selectedId <- reuse sourceIds+      pure $ CteRow+        (selectedId + val_ (cteId inserted - sourceId))+        (val_ (cteValue inserted)))+    Pg.onConflictDefault++modelUpdateWithStatement+  :: Int32+  -> Text+  -> SqlUpdate Postgres CteRowT+modelUpdateWithStatement updateId updateValue = Pg.pgUpdateWith $ do+  targetIds <- Pg.pgSelecting $ do+    row <- all_ (dbCteRows cteDb)+    guard_ (cteId row ==. val_ updateId)+    pure (cteId row)+  pure $ update+    (dbCteRows cteDb)+    (\row -> cteValue row <-. val_ updateValue)+    (\row -> exists_ $ do+      targetId <- reuse targetIds+      guard_ (cteId row ==. targetId)+      pure targetId)++modelDeleteWithStatement+  :: Int32+  -> SqlDelete Postgres CteRowT+modelDeleteWithStatement deleteId = Pg.pgDeleteWith $ do+  targetIds <- Pg.pgSelecting $ do+    row <- all_ (dbCteRows cteDb)+    guard_ (cteId row ==. val_ deleteId)+    pure (cteId row)+  pure $ delete (dbCteRows cteDb) $ \row -> exists_ $ do+    targetId <- reuse targetIds+    guard_ (cteId row ==. targetId)+    pure targetId++recursiveCteModelSelect+  :: Int32+  -> Int32+  -> SqlSelect Postgres (CteRowT Identity)+recursiveCteModelSelect startId endId = Pg.pgSelectWithTopLevel $ do+  recursiveIds <- Pg.pgToTopLevel $ mdo+    ids <- Pg.pgSelecting $+      pure (as_ @Int32 (val_ startId)) `unionAll_` do+        previousId <- reuse ids+        guard_ (previousId <. val_ endId)+        pure (previousId + 1)+    pure ids++  deletedRows <- Pg.cteDeleteReturning+    (dbCteRows cteDb)+    (\row -> exists_ $ do+      recursiveId <- reuse recursiveIds+      guard_ (cteId row ==. recursiveId)+      pure recursiveId)+    id++  pure (reuse deletedRows)++nestedSelectCteSelect :: SqlSelect Postgres (CteRowT Identity)+nestedSelectCteSelect = select $ Pg.pgSelectWith $ do+  selected <- selecting $ do+    row <- all_ (dbCteRows cteDb)+    guard_ (cteId row ==. val_ 1)+    pure row+  pure (reuse selected)++-- PostgreSQL permits a recursive SELECT CTE to feed a later modifying CTE, but+-- not a modifying CTE to recursively reference itself. 'pgToTopLevel' closes the+-- recursive SELECT knot before the DELETE is added.+recursiveSelectThenDeleteCteSelect :: SqlSelect Postgres (CteRowT Identity)+recursiveSelectThenDeleteCteSelect = Pg.pgSelectWithTopLevel $ do+  recursiveIds <- Pg.pgToTopLevel $ mdo+    ids <- Pg.pgSelecting $+      pure (as_ @Int32 (val_ 1)) `unionAll_` do+        previousId <- reuse ids+        guard_ (previousId <. val_ 2)+        pure (previousId + 1)+    pure ids++  deleted <- Pg.cteDeleteReturning+    (dbCteRows cteDb)+    (\row -> exists_ $ do+      recursiveId <- reuse recursiveIds+      guard_ (cteId row ==. recursiveId)+      pure recursiveId)+    id++  pure (reuse deleted)++-- Empty INSERT values and identity UPDATE assignments do not produce SQL.+-- Their wrappers return Nothing, leaving pgSelectWithTopLevel to render the+-- final query without an empty WITH clause.+emptyDataModifyingCteSelect :: SqlSelect Postgres Int32+emptyDataModifyingCteSelect = Pg.pgSelectWithTopLevel $ do+  inserted <- Pg.cteInsertReturning+    (dbCteRows cteDb)+    SqlInsertValuesEmpty+    Pg.onConflictDefault+    id+  updated <- Pg.cteUpdateReturning+    (dbCteRows cteDb)+    (const mempty)+    (const (val_ True))+    id+  case (inserted, updated) of+    (Nothing, Nothing) -> pure finalQuery+    _ -> error "Expected empty INSERT and UPDATE CTEs"+  where+    finalQuery :: Q Postgres CteDb QBaseScope (QExpr Postgres QBaseScope Int32)+    finalQuery = pure (val_ 1)++-- The portable builder reaches PostgreSQL through the SQL99-shaped compatibility+-- instance. Each input table row contributes one row to the reusable+-- degree-zero relation even though the projection contains no values.+emptySelectProjection :: SqlSelect Postgres (EmptyCteT Identity)+emptySelectProjection = selectWith $ do+  rows <- selecting $ do+    _ <- all_ (dbCteRows cteDb)+    pure (EmptyCte :: EmptyCteT (QExpr Postgres CTE.QAnyScope))+  pure (reuse rows)++-- The native SELECT path additionally carries PostgreSQL's materialization+-- policy. Its logical result is identical for all three policies.+emptyNativeSelectProjection+  :: Pg.PgCteMaterialization+  -> SqlSelect Postgres (EmptyCteT Identity)+emptyNativeSelectProjection materialization = Pg.pgSelectWithTopLevel $ do+  rows <- Pg.pgSelectingWith materialization $ do+    _ <- all_ (dbCteRows cteDb)+    pure (EmptyCte :: EmptyCteT (QExpr Postgres CTE.QAnyScope))+  pure (reuse rows)++-- SELECT CTEs remain nestable when their relation has degree zero.+nestedEmptySelectProjection :: SqlSelect Postgres (EmptyCteT Identity)+nestedEmptySelectProjection = select $ Pg.pgSelectWithNested $ do+  rows <- Pg.pgSelecting $ do+    _ <- all_ (dbCteRows cteDb)+    pure (EmptyCte :: EmptyCteT (QExpr Postgres CTE.QAnyScope))+  pure (reuse rows)++-- COUNT(*) and EXISTS do not need a projected field, so they are natural+-- consumers of a degree-zero relation. Both references share one CTE body.+emptySelectSummary :: SqlSelect Postgres (Int32, Bool)+emptySelectSummary = Pg.pgSelectWithTopLevel $ do+  rows <- Pg.pgSelecting $ do+    _ <- all_ (dbCteRows cteDb)+    pure (EmptyCte :: EmptyCteT (QExpr Postgres CTE.QAnyScope))+  pure $ do+    count <- aggregate_ (const (as_ @Int32 countAll_)) (reuse rows)+    pure (count, exists_ (reuse rows))++-- The next three fixtures deliberately return no logical values. PostgreSQL's+-- RETURNING grammar is satisfied internally, while the outer SELECT exposes no+-- physical columns and retains one row per affected table row.+emptyInsertProjection+  :: [CteRowT Identity]+  -> SqlSelect Postgres (EmptyCteT Identity)+emptyInsertProjection values = Pg.pgSelectWithTopLevel $ do+  rows <- Pg.cteInsertReturning+    (dbCteRows cteDb)+    (insertValues values)+    Pg.onConflictDefault+    (const (EmptyCte :: EmptyCteT (QExpr Postgres PostgresInaccessible)))+  case rows of+    Just rows' -> pure (reuse rows')+    Nothing -> error "Expected non-empty INSERT values"++emptyUpdateProjection+  :: Int32+  -> Text+  -> SqlSelect Postgres (EmptyCteT Identity)+emptyUpdateProjection maximumId value = Pg.pgSelectWithTopLevel $ do+  rows <- Pg.cteUpdateReturning+    (dbCteRows cteDb)+    (\row -> cteValue row <-. val_ value)+    (\row -> cteId row <=. val_ maximumId)+    (const (EmptyCte :: EmptyCteT (QExpr Postgres PostgresInaccessible)))+  case rows of+    Just rows' -> pure (reuse rows')+    Nothing -> error "Expected a non-identity UPDATE"++emptyDeleteProjection+  :: Int32+  -> SqlSelect Postgres (EmptyCteT Identity)+emptyDeleteProjection minimumId = Pg.pgSelectWithTopLevel $ do+  rows <- Pg.cteDeleteReturning+    (dbCteRows cteDb)+    (\row -> cteId row >=. val_ minimumId)+    (const (EmptyCte :: EmptyCteT (QExpr Postgres PostgresInaccessible)))+  pure (reuse rows)++-- Two references to the same modifying CTE must multiply its row cardinality,+-- not execute the DELETE twice or expose its private sentinel.+repeatedEmptyDeleteProjection :: SqlSelect Postgres (EmptyCteT Identity)+repeatedEmptyDeleteProjection = Pg.pgSelectWithTopLevel $ do+  rows <- Pg.cteDeleteReturning+    (dbCteRows cteDb)+    (const (val_ True))+    (const (EmptyCte :: EmptyCteT (QExpr Postgres PostgresInaccessible)))+  pure $ do+    _ <- reuse rows+    _ <- reuse rows+    pure (EmptyCte :: EmptyCteT (QExpr Postgres QBaseScope))++-- Aggregating the reusable DELETE result verifies that the private physical+-- sentinel supplies relational rows without becoming a Beam expression.+emptyDeleteSummary :: SqlSelect Postgres (Int32, Bool)+emptyDeleteSummary = Pg.pgSelectWithTopLevel $ do+  rows <- Pg.cteDeleteReturning+    (dbCteRows cteDb)+    (const (val_ True))+    (const (EmptyCte :: EmptyCteT (QExpr Postgres PostgresInaccessible)))+  pure $ do+    count <- aggregate_ (const (as_ @Int32 countAll_)) (reuse rows)+    pure (count, exists_ (reuse rows))++-- Copy one row selected by the CTE into a new row. insertFrom is what exposes+-- the reusable query to the terminal INSERT source.+insertWithStatement :: SqlInsert Postgres CteRowT+insertWithStatement = Pg.pgInsertWith $ do+  source <- Pg.pgSelecting $ do+    row <- all_ (dbCteRows cteDb)+    guard_ (cteId row ==. val_ 1)+    pure row+  pure $ Pg.insert+    (dbCteRows cteDb)+    (insertFrom $ do+      row <- reuse source+      pure (CteRow (cteId row + 1) (val_ "inserted-with")))+    Pg.onConflictDefault++-- Select the target key independently, then reference it through EXISTS in+-- the terminal UPDATE predicate.+updateWithStatement :: SqlUpdate Postgres CteRowT+updateWithStatement = Pg.pgUpdateWith $ do+  targets <- Pg.pgSelecting $ do+    row <- all_ (dbCteRows cteDb)+    guard_ (cteId row ==. val_ 3)+    pure (cteId row)+  pure $ update+    (dbCteRows cteDb)+    (\row -> cteValue row <-. val_ "updated-with")+    (\row -> exists_ $ do+      targetId <- reuse targets+      guard_ (cteId row ==. targetId)+      pure targetId)++-- The DELETE form uses the same reusable-key pattern as UPDATE, exercising+-- the third terminal syntax wrapper.+deleteWithStatement :: SqlDelete Postgres CteRowT+deleteWithStatement = Pg.pgDeleteWith $ do+  targets <- Pg.pgSelecting $ do+    row <- all_ (dbCteRows cteDb)+    guard_ (cteId row ==. val_ 4)+    pure (cteId row)+  pure $ delete (dbCteRows cteDb) $ \row -> exists_ $ do+    targetId <- reuse targets+    guard_ (cteId row ==. targetId)+    pure targetId++-- Recursion is completed while the block is still nested-safe. The terminal+-- INSERT then consumes the recursive result at top level.+recursiveInsertWithStatement :: SqlInsert Postgres CteRowT+recursiveInsertWithStatement = Pg.pgInsertWith recursiveInsertWith++recursiveInsertWith+  :: Pg.PgWith CteDb 'Pg.PgCteNestedAllowed (SqlInsert Postgres CteRowT)+recursiveInsertWith = mdo+  ids <- Pg.pgSelecting $+    pure (as_ @Int32 (val_ 1)) `unionAll_` do+      previousId <- reuse ids+      guard_ (previousId <. val_ 2)+      pure (previousId + 1)+  pure $ Pg.insert+    (dbCteRows cteDb)+    (insertFrom $ do+      rowId <- reuse ids+      pure (CteRow rowId (val_ "recursive")))+    Pg.onConflictDefault++-- Adding a modifying CTE fixes the block to PgCteTopLevelOnly. pgDeleteWith is+-- a top-level consumer, so this remains well-typed.+topLevelOnlyDeleteWithStatement :: SqlDelete Postgres CteRowT+topLevelOnlyDeleteWithStatement = Pg.pgDeleteWith $ do+  _ <- Pg.cteDeleteReturning+    (dbCteRows cteDb)+    (\row -> cteId row ==. val_ 99)+    id+  pure $ delete+    (dbCteRows cteDb)+    (\row -> cteId row ==. val_ 100)++emptyInsertWithStatement :: SqlInsert Postgres CteRowT+emptyInsertWithStatement = Pg.pgInsertWith $ do+  _ <- Pg.pgSelecting $ all_ (dbCteRows cteDb)+  pure $ Pg.insert+    (dbCteRows cteDb)+    SqlInsertValuesEmpty+    Pg.onConflictDefault++identityUpdateWithStatement :: SqlUpdate Postgres CteRowT+identityUpdateWithStatement = Pg.pgUpdateWith $ do+  _ <- Pg.pgSelecting $ all_ (dbCteRows cteDb)+  pure $ update+    (dbCteRows cteDb)+    (const mempty)+    (const (val_ True))++assertWithTerminal+  :: String+  -> Maybe String+  -> Assertion+assertWithTerminal terminal rendered = do+  sql <- requireRenderedStatement rendered+  assertBool "starts with WITH" ("WITH " `isPrefixOf` sql)+  assertBool ("renders terminal " ++ terminal) ((" " ++ terminal) `isInfixOf` sql)++requireRenderedStatement+  :: Maybe String+  -> IO String+requireRenderedStatement rendered =+  case rendered of+    Nothing -> assertFailure "expected a PostgreSQL statement" >> pure ""+    Just sql -> pure sql++renderInsert :: SqlInsert Postgres table -> Maybe String+renderInsert SqlInsertNoRows = Nothing+renderInsert (SqlInsert _ (PgInsertSyntax syntax)) =+  Just (BL.unpack (pgRenderSyntaxScript syntax))++renderUpdate :: SqlUpdate Postgres table -> Maybe String+renderUpdate SqlIdentityUpdate = Nothing+renderUpdate (SqlUpdate _ (PgUpdateSyntax syntax)) =+  Just (BL.unpack (pgRenderSyntaxScript syntax))++renderDelete :: SqlDelete Postgres table -> Maybe String+renderDelete (SqlDelete _ (PgDeleteSyntax syntax)) =+  Just (BL.unpack (pgRenderSyntaxScript syntax))++assertReturning :: String -> Maybe String -> Assertion+assertReturning command rendered = do+  sql <- requireRenderedStatement rendered+  assertBool (command ++ " retains its WITH prefix") ("WITH " `isPrefixOf` sql)+  assertBool (command ++ " renders RETURNING") (" RETURNING " `isInfixOf` sql)++renderInsertReturning :: Pg.PgInsertReturning a -> Maybe String+renderInsertReturning Pg.PgInsertReturningEmpty = Nothing+renderInsertReturning (Pg.PgInsertReturning syntax) =+  Just (BL.unpack (pgRenderSyntaxScript syntax))++renderUpdateReturning :: Pg.PgUpdateReturning a -> Maybe String+renderUpdateReturning Pg.PgUpdateReturningEmpty = Nothing+renderUpdateReturning (Pg.PgUpdateReturning syntax) =+  Just (BL.unpack (pgRenderSyntaxScript syntax))++renderDeleteReturning :: Pg.PgDeleteReturning a -> Maybe String+renderDeleteReturning (Pg.PgDeleteReturning syntax) =+  Just (BL.unpack (pgRenderSyntaxScript syntax))++renderSelect :: SqlSelect Postgres a -> String+renderSelect = BL.unpack . renderSelectBytes++renderSelectBytes :: SqlSelect Postgres a -> BL.ByteString+renderSelectBytes (SqlSelect (PgSelectSyntax syntax)) =+  pgRenderSyntaxScript syntax

@@ -0,0 +1,180 @@+{-# OPTIONS_GHC -fdefer-type-errors -Wno-deferred-type-errors #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE StandaloneDeriving #-}++-- This module deliberately contains expressions which must not type-check.+-- Deferred type errors are isolated here so the positive CTE tests retain+-- normal, strict type checking.+module Database.Beam.Postgres.Test.CTENegative+  ( invalidNestedDelete+  , invalidNestedInsert+  , invalidNestedUpdate+  , invalidNestedSelectThenDelete+  , invalidNestedDeleteThenSelect+  , invalidNestedEmptyInsert+  , invalidNestedIdentityUpdate+  , invalidNestedSideEffectDelete+  , invalidCoercedPlacement+  , invalidRecursiveInsert+  , invalidReuseSideEffect+  ) where++import qualified Data.Coerce as Coerce+import Data.Int (Int32)+import Data.Text (Text)++import Database.Beam+import Database.Beam.Postgres+import qualified Database.Beam.Postgres.Full as Pg+import qualified Database.Beam.Query.CTE as CTE++data NegativeCteRowT f = NegativeCteRow+  { negativeCteId :: C f Int32+  , negativeCteValue :: C f Text+  } deriving (Generic, Beamable)++deriving instance Show (NegativeCteRowT Identity)+deriving instance Eq (NegativeCteRowT Identity)++instance Table NegativeCteRowT where+  data PrimaryKey NegativeCteRowT f = NegativeCteRowKey (C f Int32)+    deriving (Generic, Beamable)+  primaryKey = NegativeCteRowKey . negativeCteId++newtype NegativeCteDb entity = NegativeCteDb+  { negativeCteRows :: entity (TableEntity NegativeCteRowT)+  } deriving (Generic, Database Postgres)++negativeCteDb :: DatabaseSettings Postgres NegativeCteDb+negativeCteDb = defaultDbSettings++-- Each of the following three expressions attempts to put a modifying CTE in+-- pgSelectWithNested. They must fail with PgCteTopLevelOnly versus+-- PgCteNestedAllowed,+-- independently of which data-modifying command produced the CTE.+invalidNestedDelete :: SqlSelect Postgres (NegativeCteRowT Identity)+invalidNestedDelete = select $ Pg.pgSelectWithNested $ do+  deleted <- topLevelDeleteCte+  pure (reuse deleted)++invalidNestedInsert :: SqlSelect Postgres (NegativeCteRowT Identity)+invalidNestedInsert = select $ Pg.pgSelectWithNested $ do+  inserted <- Pg.cteInsertReturning+    (negativeCteRows negativeCteDb)+    (insertValues [NegativeCteRow 2 "inserted"])+    Pg.onConflictDefault+    id+  case inserted of+    Nothing -> pure $ all_ (negativeCteRows negativeCteDb)+    Just inserted' -> pure (reuse inserted')++invalidNestedUpdate :: SqlSelect Postgres (NegativeCteRowT Identity)+invalidNestedUpdate = select $ Pg.pgSelectWithNested $ do+  updated <- Pg.cteUpdateReturning+    (negativeCteRows negativeCteDb)+    (\row -> negativeCteValue row <-. val_ "updated")+    (\row -> negativeCteId row ==. val_ 1)+    id+  case updated of+    Nothing -> pure $ all_ (negativeCteRows negativeCteDb)+    Just updated' -> pure (reuse updated')++-- Placement is a property of the whole With block. Reordering a normal SELECT+-- CTE around the DELETE must not weaken the top-level-only requirement.+invalidNestedSelectThenDelete :: SqlSelect Postgres (NegativeCteRowT Identity)+invalidNestedSelectThenDelete = select $ Pg.pgSelectWithNested $ do+  _ <- nestedSelectCte+  deleted <- topLevelDeleteCte+  pure (reuse deleted)++invalidNestedDeleteThenSelect :: SqlSelect Postgres (NegativeCteRowT Identity)+invalidNestedDeleteThenSelect = select $ Pg.pgSelectWithNested $ do+  deleted <- topLevelDeleteCte+  _ <- nestedSelectCte+  pure (reuse deleted)++-- The result is conservatively top-level-only even when the supplied values or+-- assignments make the INSERT or UPDATE a no-op. The placement index cannot+-- vary with that value-level outcome.+invalidNestedEmptyInsert :: SqlSelect Postgres (NegativeCteRowT Identity)+invalidNestedEmptyInsert = select $ Pg.pgSelectWithNested $ do+  inserted <- Pg.cteInsertReturning+    (negativeCteRows negativeCteDb)+    SqlInsertValuesEmpty+    Pg.onConflictDefault+    id+  case inserted of+    Nothing -> pure $ all_ (negativeCteRows negativeCteDb)+    Just inserted' -> pure (reuse inserted')++invalidNestedIdentityUpdate :: SqlSelect Postgres (NegativeCteRowT Identity)+invalidNestedIdentityUpdate = select $ Pg.pgSelectWithNested $ do+  updated <- Pg.cteUpdateReturning+    (negativeCteRows negativeCteDb)+    (const mempty)+    (const (val_ True))+    id+  case updated of+    Nothing -> pure $ all_ (negativeCteRows negativeCteDb)+    Just updated' -> pure (reuse updated')++-- A no-RETURNING modifying CTE has the same top-level placement requirement as+-- its returning counterpart, even though it exposes no relation.+invalidNestedSideEffectDelete :: SqlSelect Postgres (NegativeCteRowT Identity)+invalidNestedSideEffectDelete = select $ Pg.pgSelectWithNested $ do+  Pg.cteDelete+    (negativeCteRows negativeCteDb)+    (\row -> negativeCteId row ==. val_ 1)+  pure $ all_ (negativeCteRows negativeCteDb)++-- PgWith has nominal roles and an abstract constructor, so Data.Coerce cannot+-- be used to relabel a top-level-only block as nested-safe.+invalidCoercedPlacement :: SqlSelect Postgres (NegativeCteRowT Identity)+invalidCoercedPlacement = select $ Pg.pgSelectWithNested $ coercePlacement $ do+  deleted <- topLevelDeleteCte+  pure (reuse deleted)++-- MonadFix exists only for PgCteNestedAllowed. This prevents an INSERT CTE from+-- reading its own RETURNING rows recursively, which PostgreSQL rejects.+invalidRecursiveInsert :: SqlSelect Postgres (NegativeCteRowT Identity)+invalidRecursiveInsert = Pg.pgSelectWithTopLevel $ mdo+  ~(Just inserted) <- Pg.cteInsertReturning+    (negativeCteRows negativeCteDb)+    (insertFrom (reuse inserted))+    Pg.onConflictDefault+    id+  pure (reuse inserted)++-- Side-effect-only CTEs deliberately return unit because a DML statement+-- without RETURNING forms no temporary relation in PostgreSQL.+invalidReuseSideEffect :: SqlSelect Postgres (NegativeCteRowT Identity)+invalidReuseSideEffect = Pg.pgSelectWithTopLevel $ do+  deleted <- Pg.cteDelete+    (negativeCteRows negativeCteDb)+    (\row -> negativeCteId row ==. val_ 1)+  let impossible+        :: ReusableQ Postgres NegativeCteDb+             (NegativeCteRowT (QExpr Postgres CTE.QAnyScope))+      impossible = deleted+  pure (reuse impossible)++coercePlacement+  :: Pg.PgWith NegativeCteDb 'Pg.PgCteTopLevelOnly a+  -> Pg.PgWith NegativeCteDb 'Pg.PgCteNestedAllowed a+coercePlacement = Coerce.coerce++nestedSelectCte+  :: Pg.PgWith NegativeCteDb placement+       (ReusableQ Postgres NegativeCteDb+         (NegativeCteRowT (QExpr Postgres CTE.QAnyScope)))+nestedSelectCte = Pg.pgSelecting $ all_ (negativeCteRows negativeCteDb)++topLevelDeleteCte+  :: Pg.PgWith NegativeCteDb 'Pg.PgCteTopLevelOnly+       (ReusableQ Postgres NegativeCteDb+         (NegativeCteRowT (QExpr Postgres CTE.QAnyScope)))+topLevelDeleteCte = Pg.cteDeleteReturning+  (negativeCteRows negativeCteDb)+  (\row -> negativeCteId row ==. val_ 1)+  id

@@ -1,13 +1,14 @@ module Main where -import Data.ByteString ( ByteString )-import Data.Text ( unpack )+import Data.ByteString (ByteString)+import Data.Text (unpack) import qualified Data.Text.Lazy as TL  import Test.Tasty import qualified TestContainers.Tasty as TC  import qualified Database.Beam.Postgres.Test.Copy as Copy+import qualified Database.Beam.Postgres.Test.CTE as CTE import qualified Database.Beam.Postgres.Test.DataTypes as DataType import qualified Database.Beam.Postgres.Test.Marshal as Marshal import qualified Database.Beam.Postgres.Test.Migrate as Migrate@@ -15,44 +16,52 @@ import qualified Database.Beam.Postgres.Test.Select.PgNubBy as Select.PgNubBy import qualified Database.Beam.Postgres.Test.TempTable as TempTable import qualified Database.Beam.Postgres.Test.Windowing as Windowing-import Database.PostgreSQL.Simple ( ConnectInfo(..), defaultConnectInfo )+import Database.PostgreSQL.Simple (ConnectInfo(..), defaultConnectInfo) import qualified Database.PostgreSQL.Simple as Postgres  main :: IO ()-main = defaultMain-     $ TC.withContainers setupTempPostgresDB-     $ \getConnStr ->-        testGroup "beam-postgres tests"-          [ Marshal.tests getConnStr-          , Select.tests getConnStr-          , Select.PgNubBy.tests getConnStr-          , DataType.tests getConnStr-          , Migrate.tests getConnStr-          , TempTable.tests getConnStr-          , Windowing.tests getConnStr-          , Copy.tests getConnStr-          ]+main = defaultMain $ testGroup "beam-postgres tests"+  -- Rendering and compile-negative tests do not need Docker, so keep them+  -- outside the Testcontainers resource and available as fast unit tests.+  [ CTE.unitTests+  , TC.withContainers setupTempPostgresDB $ \getConnStr ->+      testGroup "PostgreSQL integration tests"+        [ Marshal.tests getConnStr+        , CTE.integrationTests getConnStr+        , Select.tests getConnStr+        , Select.PgNubBy.tests getConnStr+        , DataType.tests getConnStr+        , Migrate.tests getConnStr+        , TempTable.tests getConnStr+        , Windowing.tests getConnStr+        , Copy.tests getConnStr+        ]+  ]   setupTempPostgresDB :: TC.MonadDocker m => m ByteString setupTempPostgresDB = do-    let user     = "postgres"-        password = "root"-        db       = "testdb"+  let user = "postgres"+      password = "root"+      db = "testdb" -    timescaleContainer <- TC.run $ TC.containerRequest (TC.fromTag "postgres:16.4")-        TC.& TC.setExpose [ 5432 ]-        TC.& TC.setEnv [ ("POSTGRES_USER", user)-                       , ("POSTGRES_PASSWORD", password)-                       , ("POSTGRES_DB", db)-                       ]-        TC.& TC.setWaitingFor (TC.waitForLogLine TC.Stderr ("database system is ready to accept connections" `TL.isInfixOf`))+  -- Pin the server version so normal CI runs are reproducible.+  postgresContainer <- TC.run $+    TC.containerRequest (TC.fromTag "postgres:18.4")+      TC.& TC.setExpose [5432]+      TC.& TC.setEnv+        [ ("POSTGRES_USER", user)+        , ("POSTGRES_PASSWORD", password)+        , ("POSTGRES_DB", db)+        ]+      TC.& TC.setWaitingFor+        (TC.waitForLogLine TC.Stderr+          ("database system is ready to accept connections" `TL.isInfixOf`)) -    pure $ Postgres.postgreSQLConnectionString-                   ( defaultConnectInfo { connectHost     = "localhost"-                                        , connectUser     = unpack user-                                        , connectPassword = unpack password-                                        , connectDatabase = unpack db-                                        , connectPort     = fromIntegral $ TC.containerPort timescaleContainer 5432-                                        }-                   )+  pure $ Postgres.postgreSQLConnectionString defaultConnectInfo+    { connectHost = "localhost"+    , connectUser = unpack user+    , connectPassword = unpack password+    , connectDatabase = unpack db+    , connectPort = fromIntegral $ TC.containerPort postgresContainer 5432+    }