Compatibility with hpqtypes 2.0.0.0

.github/workflows/haskell-ci.yml

@@ -6,11 +6,11 @@
 #
 #   haskell-ci regenerate
 #
-# For more information, see https://github.com/haskell-CI/haskell-ci
+# For more information, see https://github.com/arybczak/haskell-ci
 #
-# version: 0.19.20260104
+# version: 0.19.20260424
 #
-# REGENDATA ("0.19.20260104",["github","cabal.project","--config=cabal.haskell-ci"])
+# REGENDATA ("0.19.20260424",["github","cabal.project","--config=cabal.haskell-ci"])
 #
 name: Haskell-CI
 on:
@@ -23,17 +23,22 @@ on:
   merge_group:
     branches:
       - master
+  workflow_dispatch:
+    {}
+concurrency:
+  group: ${{ github.workflow }}-${{ github.ref }}
+  cancel-in-progress: true
 jobs:
   linux:
     name: Haskell-CI - Linux - ${{ matrix.compiler }}
     runs-on: ubuntu-24.04
     timeout-minutes:
       60
     container:
-      image: buildpack-deps:jammy
+      image: buildpack-deps:resolute
     services:
       postgres:
-        image: postgres:14
+        image: postgres:18
         env:
           POSTGRES_PASSWORD: postgres
         options: --health-cmd pg_isready --health-interval 10s --health-timeout 5s --health-retries 5
@@ -46,9 +51,9 @@ jobs:
             compilerVersion: 9.14.1
             setup-method: ghcup
             allow-failure: false
-          - compiler: ghc-9.12.2
+          - compiler: ghc-9.12.4
             compilerKind: ghc
-            compilerVersion: 9.12.2
+            compilerVersion: 9.12.4
             setup-method: ghcup
             allow-failure: false
           - compiler: ghc-9.10.3
@@ -66,22 +71,12 @@ jobs:
             compilerVersion: 9.6.7
             setup-method: ghcup
             allow-failure: false
-          - compiler: ghc-9.4.8
-            compilerKind: ghc
-            compilerVersion: 9.4.8
-            setup-method: ghcup
-            allow-failure: false
-          - compiler: ghc-9.2.8
-            compilerKind: ghc
-            compilerVersion: 9.2.8
-            setup-method: ghcup
-            allow-failure: false
       fail-fast: false
     steps:
       - name: apt-get install
         run: |
           apt-get update
-          apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
+          apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common
       - name: Install GHCup
         run: |
           mkdir -p "$HOME/.ghcup/bin"
@@ -166,7 +161,7 @@ jobs:
           chmod a+x $HOME/.cabal/bin/cabal-plan
           cabal-plan --version
       - name: checkout
-        uses: actions/checkout@v5
+        uses: actions/checkout@v7
         with:
           path: source
       - name: initial cabal.project for sdist
@@ -198,23 +193,24 @@ jobs:
           echo "    ghc-options: -Werror=missing-methods -Werror=missing-fields" >> cabal.project
           echo "package consumers-metrics-prometheus" >> cabal.project
           echo "    ghc-options: -Werror=missing-methods -Werror=missing-fields" >> cabal.project
-          if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo "package consumers" >> cabal.project ; fi
-          if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo "    ghc-options: -Werror=unused-packages" >> cabal.project ; fi
-          if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo "package consumers-metrics-prometheus" >> cabal.project ; fi
-          if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo "    ghc-options: -Werror=unused-packages" >> cabal.project ; fi
+          echo "package consumers" >> cabal.project
+          echo "    ghc-options: -Werror=unused-packages" >> cabal.project
+          echo "package consumers-metrics-prometheus" >> cabal.project
+          echo "    ghc-options: -Werror=unused-packages" >> cabal.project
           echo "package consumers" >> cabal.project
           echo "    ghc-options: -Werror=incomplete-patterns -Werror=incomplete-uni-patterns" >> cabal.project
           echo "package consumers-metrics-prometheus" >> cabal.project
           echo "    ghc-options: -Werror=incomplete-patterns -Werror=incomplete-uni-patterns" >> cabal.project
           cat >> cabal.project <<EOF
-          constraints: data-sketches < 0.4
-          allow-newer: *:base
-          allow-newer: *:template-haskell
-          allow-newer: aeson:containers
-          allow-newer: aeson:indexed-traversable
-          allow-newer: aeson:semialign
-          allow-newer: aeson:time
-          allow-newer: indexed-traversable:containers
+          source-repository-package
+            type:     git
+            location: https://github.com/scrive/hpqtypes
+            tag:      a4785d18ff76ddb33d42d09d85d730cf6825ae39
+
+          source-repository-package
+            type:     git
+            location: https://github.com/scrive/hpqtypes-extras
+            tag:      433ef681f8a42f34f171050a1c54f1457c95c824
           EOF
           cat cabal.project
           cat cabal.project.local
@@ -223,7 +219,7 @@ jobs:
           $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
           cabal-plan
       - name: restore cache
-        uses: actions/cache/restore@v4
+        uses: actions/cache/restore@v5
         with:
           key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
           path: ~/.cabal/store
@@ -256,7 +252,7 @@ jobs:
           $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
       - name: save cache
         if: always()
-        uses: actions/cache/save@v4
+        uses: actions/cache/save@v5
         with:
           key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
           path: ~/.cabal/store

cabal.project

@@ -1,14 +1,11 @@
 packages: */*.cabal
 
--- for prometheus-client
-constraints: data-sketches < 0.4
+source-repository-package
+    type: git
+    location: https://github.com/scrive/hpqtypes
+    tag: a4785d18ff76ddb33d42d09d85d730cf6825ae39
 
--- GHC 9.14.1
-allow-newer:
-  , *:base
-  , *:template-haskell
-  , aeson:containers
-  , aeson:indexed-traversable
-  , aeson:semialign
-  , aeson:time
-  , indexed-traversable:containers
+source-repository-package
+    type: git
+    location: https://github.com/scrive/hpqtypes-extras
+    tag: 433ef681f8a42f34f171050a1c54f1457c95c824

consumers-metrics-prometheus/consumers-metrics-prometheus.cabal

@@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               consumers-metrics-prometheus
-version:            1.0.0.0
+version:            2.0.0.0
 synopsis:           Prometheus metrics for the consumers library
 
 description:        Provides seamless instrumentation of your existing
@@ -16,7 +16,7 @@ maintainer:         Andrzej Rybczak <andrzej@rybczak.net>,
 copyright:          Scrive AB
 category:           Concurrency, Database
 build-type:         Simple
-tested-with:        GHC == { 9.2.8, 9.4.8, 9.6.7, 9.8.4, 9.10.3, 9.12.2, 9.14.1 }
+tested-with:        GHC == { 9.6.7, 9.8.4, 9.10.3, 9.12.4, 9.14.1 }
 
 bug-reports:   https://github.com/scrive/consumers/issues
 source-repository head
@@ -42,10 +42,10 @@ library
 
   exposed-modules:  Database.PostgreSQL.Consumers.Instrumented
 
-  build-depends:    base              >= 4.16   && < 5
-                  , consumers         >= 2.3
+  build-depends:    base              >= 4.18   && < 5
+                  , consumers         >= 3.0
                   , exceptions        >= 0.10
-                  , hpqtypes          >= 1.13
+                  , hpqtypes          >= 2.0
                   , lifted-base       >= 0.2
                   , log-base          >= 0.11
                   , monad-control     >= 1.0

consumers-metrics-prometheus/src/Database/PostgreSQL/Consumers/Instrumented.hs

@@ -213,15 +213,15 @@ collectMetrics connSource ConsumerMetrics {..} ConsumerConfig {ccJobsTable, ccCo
       "SELECT count(id)::float8 FROM "
         <> raw ccConsumersTable
         <> " WHERE name =" <?> unRawSQL ccJobsTable
-    fetchOne runIdentity
+    fetchOne fromSQL
   liftBase $ Prom.withLabel jobInfo jobName (`Prom.setGauge` info)
 
   overdue <- do
     runSQL_ $
       "SELECT count(id)::float8 FROM "
         <> raw ccJobsTable
         <> " WHERE run_at <= now() AND reserved_by IS NULL"
-    fetchOne runIdentity
+    fetchOne fromSQL
   liftBase $ Prom.withLabel jobsOverdue jobName (`Prom.setGauge` overdue)
 
 -- | Alter a configuration to collect "job" metrics on 'ccProcessJob'

consumers/consumers.cabal

@@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               consumers
-version:            2.3.5.0
+version:            3.0.0.0
 synopsis:           Concurrent PostgreSQL data consumers
 
 description:        Library for setting up concurrent consumers of data
@@ -17,7 +17,7 @@ maintainer:         Andrzej Rybczak <andrzej@rybczak.net>,
 copyright:          Scrive AB
 category:           Concurrency, Database
 build-type:         Simple
-tested-with:        GHC == { 9.2.8, 9.4.8, 9.6.7, 9.8.4, 9.10.3, 9.12.2, 9.14.1 }
+tested-with:        GHC == { 9.6.7, 9.8.4, 9.10.3, 9.12.4, 9.14.1 }
 
 bug-reports:   https://github.com/scrive/consumers/issues
 source-repository head
@@ -53,11 +53,11 @@ library
                     Database.PostgreSQL.Consumers.Components,
                     Database.PostgreSQL.Consumers.Utils
 
-  build-depends:    base              >= 4.16   && < 5
+  build-depends:    base              >= 4.18   && < 5
                   , aeson             >= 2.0
                   , containers        >= 0.5
                   , exceptions        >= 0.10
-                  , hpqtypes          >= 1.13
+                  , hpqtypes          >= 2.0
                   , lifted-base       >= 0.2
                   , lifted-threads    >= 1.0
                   , log-base          >= 0.11
@@ -78,7 +78,7 @@ test-suite consumers-example
   build-depends:      base,
                       consumers,
                       hpqtypes,
-                      hpqtypes-extras >= 1.17.0.1,
+                      hpqtypes-extras >= 2.0,
                       log-base,
                       text
 
@@ -99,7 +99,7 @@ test-suite consumers-test
                       exceptions,
                       HUnit,
                       hpqtypes,
-                      hpqtypes-extras >= 1.19.0.0,
+                      hpqtypes-extras >= 2.0,
                       log-base,
                       monad-control,
                       monad-time,

consumers/example/Example.hs

@@ -102,7 +102,7 @@ main = do
         { ccJobsTable = "consumers_example_jobs"
         , ccConsumersTable = "consumers_example_consumers"
         , ccJobSelectors = ["id", "message"]
-        , ccJobFetcher = id
+        , ccJobFetcher = (,) <$> fromSQL <*> fromSQL
         , ccJobIndex = \(i :: Int64, _msg :: T.Text) -> i
         , ccNotificationChannel = Just "consumers_example_chan"
         , ccNotificationTimeout = 10 * 1000000 -- 10 sec

consumers/src/Database/PostgreSQL/Consumers/Components.hs

@@ -18,7 +18,6 @@ import Control.Monad.Catch
 import Control.Monad.Time
 import Control.Monad.Trans
 import Control.Monad.Trans.Control
-import Data.Foldable qualified as F
 import Data.Function
 import Data.Int
 import Data.Map.Strict qualified as M
@@ -255,7 +254,7 @@ spawnMonitor ConsumerConfig {..} cs cid = forkP "monitor" . forever $ do
         , "  AND name =" <?> unRawSQL ccJobsTable
         , "FOR UPDATE SKIP LOCKED"
         ]
-    fetchMany (runIdentity @Int64) >>= \case
+    fetchMany (fromSQL @Int64) >>= \case
       [] -> pure (0, [])
       inactive -> do
         -- Fetch all stuck jobs and run ccOnException on them to determine
@@ -265,7 +264,7 @@ spawnMonitor ConsumerConfig {..} cs cid = forkP "monitor" . forever $ do
           smconcat
             [ "SELECT" <+> mintercalate ", " ccJobSelectors
             , "FROM" <+> raw ccJobsTable
-            , "WHERE reserved_by = ANY(" <?> Array1 inactive <+> ")"
+            , "WHERE reserved_by = ANY(" <?> inactive <+> ")"
             , "FOR UPDATE SKIP LOCKED"
             ]
         stuckJobs <- fetchMany ccJobFetcher
@@ -277,7 +276,7 @@ spawnMonitor ConsumerConfig {..} cs cid = forkP "monitor" . forever $ do
         runPreparedSQL_ (preparedSqlName "removeInactive" ccConsumersTable) $
           smconcat
             [ "DELETE FROM" <+> raw ccConsumersTable
-            , "WHERE id = ANY(" <?> Array1 inactive <+> ")"
+            , "WHERE id = ANY(" <?> inactive <+> ")"
             ]
         pure (length inactive, map ccJobIndex stuckJobs)
   when (inactiveConsumers > 0) $ do
@@ -372,8 +371,7 @@ spawnDispatcher ConsumerConfig {..} cs cid semaphore runningJobsInfo runningJobs
             , "WHERE id IN (" <> reservedJobs now <> ")"
             , "RETURNING" <+> mintercalate ", " ccJobSelectors
             ]
-      -- Decode lazily as we want the transaction to be as short as possible.
-      (,n) . F.toList . fmap ccJobFetcher <$> queryResult
+      (,n) <$> fetchMany ccJobFetcher
       where
         reservedJobs :: UTCTime -> SQL
         reservedJobs now =
@@ -433,7 +431,7 @@ updateJobsQuery jobsTable results now =
   smconcat
     [ "WITH removed AS ("
     , "  DELETE FROM" <+> raw jobsTable
-    , "  WHERE id = ANY(" <?> Array1 deletes <+> ")"
+    , "  WHERE id = ANY(" <?> deletes <+> ")"
     , ")"
     , "UPDATE" <+> raw jobsTable <+> "SET"
     , "  reserved_by = NULL"
@@ -443,16 +441,16 @@ updateJobsQuery jobsTable results now =
     , "    ELSE NULL" -- processed
     , "  END"
     , ", finished_at = CASE"
-    , "    WHEN id = ANY(" <?> Array1 successes <+> ") THEN " <?> now
+    , "    WHEN id = ANY(" <?> successes <+> ") THEN " <?> now
     , "    ELSE NULL"
     , "  END"
-    , "WHERE id = ANY(" <?> Array1 (map fst updates) <+> ")"
+    , "WHERE id = ANY(" <?> map fst updates <+> ")"
     ]
   where
     retryToSQL (Left int) ids =
-      ("WHEN id = ANY(" <?> Array1 ids <+> ") THEN " <?> now <> " +" <?> int :)
+      ("WHEN id = ANY(" <?> ids <+> ") THEN " <?> now <> " +" <?> int :)
     retryToSQL (Right time) ids =
-      ("WHEN id = ANY(" <?> Array1 ids <+> ") THEN" <?> time :)
+      ("WHEN id = ANY(" <?> ids <+> ") THEN" <?> time :)
 
     retries = foldr (step . getAction) M.empty updates
       where

consumers/src/Database/PostgreSQL/Consumers/Config.hs

@@ -8,7 +8,7 @@ module Database.PostgreSQL.Consumers.Config
 import Control.Exception (SomeException)
 import Data.Aeson.Types qualified as A
 import Data.Time
-import Database.PostgreSQL.PQTypes.FromRow
+import Database.PostgreSQL.PQTypes.FromSQL
 import Database.PostgreSQL.PQTypes.Interval
 import Database.PostgreSQL.PQTypes.Notification
 import Database.PostgreSQL.PQTypes.SQL
@@ -27,7 +27,7 @@ data Result = Ok Action | Failed Action
   deriving (Eq, Ord, Show)
 
 -- | Config of a consumer.
-data ConsumerConfig m idx job = forall row. FromRow row => ConsumerConfig
+data ConsumerConfig m idx job = ConsumerConfig
   { ccJobsTable :: !(RawSQL ())
   -- ^ Name of the database table where jobs are stored. The table needs to have
   -- the following columns in order to be suitable for acting as a job queue:
@@ -79,8 +79,8 @@ data ConsumerConfig m idx job = forall row. FromRow row => ConsumerConfig
   , ccJobSelectors :: ![SQL]
   -- ^ Fields needed to be selected from the jobs table in order to assemble a
   -- job.
-  , ccJobFetcher :: !(row -> job)
-  -- ^ Function that transforms the list of fields into a job.
+  , ccJobFetcher :: !(RowDecoder job)
+  -- ^ Decoder that transforms the selected fields into a job.
   , ccJobIndex :: !(job -> idx)
   -- ^ Selector for taking out job ID from the job object.
   , ccNotificationChannel :: !(Maybe Channel)