diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 9039bf9..780c15d 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.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.20251118 +# version: 0.19.20260424 # -# REGENDATA ("0.19.20251118",["github","--config=cabal.haskell-ci","cabal.project"]) +# REGENDATA ("0.19.20260424",["github","--config=cabal.haskell-ci","cabal.project"]) # name: Haskell-CI on: @@ -23,6 +23,11 @@ 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 }} @@ -30,10 +35,10 @@ jobs: 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 @@ -41,14 +46,14 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.14.0.20251104 + - compiler: ghc-9.14.1 compilerKind: ghc - compilerVersion: 9.14.0.20251104 - setup-method: ghcup-prerelease + 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" @@ -105,21 +100,6 @@ jobs: HCKIND: ${{ matrix.compilerKind }} HCNAME: ${{ matrix.compiler }} HCVER: ${{ matrix.compilerVersion }} - - name: Install GHC (GHCup prerelease) - if: matrix.setup-method == 'ghcup-prerelease' - run: | - "$HOME/.ghcup/bin/ghcup" config add-release-channel prereleases - "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) - HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") - HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') - HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') - echo "HC=$HC" >> "$GITHUB_ENV" - echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" - echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" - env: - HCKIND: ${{ matrix.compilerKind }} - HCNAME: ${{ matrix.compiler }} - HCVER: ${{ matrix.compilerVersion }} - name: Set PATH and environment variables run: | echo "$HOME/.cabal/bin" >> $GITHUB_PATH @@ -130,7 +110,7 @@ jobs: echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" - if [ $((HCNUMVER >= 91400)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi + echo "HEADHACKAGE=false" >> "$GITHUB_ENV" echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" env: HCKIND: ${{ matrix.compilerKind }} @@ -158,18 +138,6 @@ jobs: repository hackage.haskell.org url: http://hackage.haskell.org/ EOF - if $HEADHACKAGE; then - cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> cabal.project echo "package hpqtypes-effectful" >> cabal.project echo " ghc-options: -Werror=missing-methods -Werror=missing-fields" >> cabal.project - if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo "package hpqtypes-effectful" >> cabal.project ; fi - if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then echo " ghc-options: -Werror=unused-packages" >> cabal.project ; fi + echo "package hpqtypes-effectful" >> cabal.project + echo " ghc-options: -Werror=unused-packages" >> cabal.project echo "package hpqtypes-effectful" >> cabal.project echo " ghc-options: -Werror=incomplete-patterns -Werror=incomplete-uni-patterns" >> cabal.project cat >> cabal.project <> cabal.project - fi $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(hpqtypes-effectful)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local @@ -251,7 +220,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 @@ -286,7 +255,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 diff --git a/CHANGELOG.md b/CHANGELOG.md index 0e1f9c4..9e5a8ec 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +# hpqtypes-effectful-2.0.0.0 (2026-??-??) +* Compatibility with `hpqtypes` >= 2.0.0.0. In line with the removal of the + `FromRow` class, the `GetQueryResult` constructor of the `DB` effect no longer + takes a `FromRow` constraint and `QueryResult` is no longer parameterized. + # hpqtypes-effectful-1.1.0.0 (2025-11-27) * Compatibility with `hpqtypes` >= 1.13.0.0. diff --git a/cabal.project b/cabal.project index e6fdbad..4681d1e 100644 --- a/cabal.project +++ b/cabal.project @@ -1 +1,6 @@ packages: . + +source-repository-package + type: git + location: https://github.com/scrive/hpqtypes + tag: a4785d18ff76ddb33d42d09d85d730cf6825ae39 diff --git a/examples/OuterJoins.hs b/examples/OuterJoins.hs index 9a3d418..839fe0b 100644 --- a/examples/OuterJoins.hs +++ b/examples/OuterJoins.hs @@ -10,6 +10,7 @@ import Data.Text qualified as T import Effectful import Effectful.Exception import Effectful.HPQTypes +import GHC.Generics -- | Generic 'putStrLn'. printLn :: IOE :> es => String -> Eff es () @@ -25,27 +26,17 @@ data Attribute = Attribute , attrKey :: !String , attrValues :: ![String] } - deriving (Show) + deriving (Generic, Show) + +instance FromSQL Attribute where + fromSQL = decodeComposite genericDecoder data Thing = Thing { thingID :: !Int64 , thingName :: !String , thingAttributes :: ![Attribute] } - deriving (Show) - -type instance CompositeRow Attribute = (Int64, String, Array1 String) - -instance PQFormat Attribute where - pqFormat = "%attribute_" - -instance CompositeFromSQL Attribute where - toComposite (aid, key, Array1 values) = - Attribute - { attrID = aid - , attrKey = key - , attrValues = values - } + deriving (Generic, Show) withDB :: IOE :> es => ConnectionSettings -> Eff es () -> Eff es () withDB cs = bracket_ createStructure dropStructure @@ -80,18 +71,9 @@ withDB cs = bracket_ createStructure dropStructure , ", FOREIGN KEY (attribute_id) REFERENCES attributes_ (id)" , ")" ] - runSQL_ $ - mconcat - [ "CREATE TYPE attribute_ AS (" - , " id BIGINT" - , ", key TEXT" - , ", value TEXT[]" - , ")" - ] dropStructure = runDB source defaultTransactionSettings $ do printLn "Dropping tables..." - runSQL_ "DROP TYPE attribute_" runSQL_ "DROP TABLE values_" runSQL_ "DROP TABLE attributes_" runSQL_ "DROP TABLE things_" @@ -102,13 +84,13 @@ insertThings = mapM_ $ \Thing {..} -> do rawSQL "INSERT INTO things_ (name) VALUES ($1) RETURNING id" (Identity thingName) - tid <- fetchOne (runIdentity @Int64) + tid <- fetchOne (fromSQL @Int64) forM_ thingAttributes $ \Attribute {..} -> do runQuery_ $ rawSQL "INSERT INTO attributes_ (key, thing_id) VALUES ($1, $2) RETURNING id" (attrKey, tid) - aid <- fetchOne (runIdentity @Int64) + aid <- fetchOne (fromSQL @Int64) forM_ attrValues $ \value -> runQuery_ $ rawSQL @@ -118,14 +100,9 @@ insertThings = mapM_ $ \Thing {..} -> do selectThings :: DB :> es => Eff es [Thing] selectThings = do runSQL_ $ "SELECT t.id, t.name, ARRAY(" <> attributes <> ") FROM things_ t ORDER BY t.id" - fetchMany $ \(tid, name, CompositeArray1 attrs) -> - Thing - { thingID = tid - , thingName = name - , thingAttributes = attrs - } + fetchMany genericDecoder where - attributes = "SELECT (a.id, a.key, ARRAY(" <> values <> "))::attribute_ FROM attributes_ a WHERE a.thing_id = t.id ORDER BY a.id" + attributes = "SELECT (a.id, a.key, ARRAY(" <> values <> ")) FROM attributes_ a WHERE a.thing_id = t.id ORDER BY a.id" values = "SELECT v.value FROM values_ v WHERE v.attribute_id = a.id ORDER BY v.value" runApp :: T.Text -> IO () @@ -134,7 +111,7 @@ runApp connInfo = runEff $ do withDB cs $ do ConnectionSource pool <- liftIO $ do poolSource - (cs {csComposites = ["attribute_"]}) + cs (\create destroy -> defaultPoolConfig create destroy 10 4) runDB pool defaultTransactionSettings $ do insertThings diff --git a/hpqtypes-effectful.cabal b/hpqtypes-effectful.cabal index a8cd086..fd84a66 100644 --- a/hpqtypes-effectful.cabal +++ b/hpqtypes-effectful.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 build-type: Simple name: hpqtypes-effectful -version: 1.1.0.0 +version: 2.0.0.0 license: BSD-3-Clause license-file: LICENSE category: Database @@ -16,7 +16,7 @@ extra-source-files: CHANGELOG.md README.md -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/haskell-effectful/hpqtypes-effectful/issues source-repository head @@ -57,9 +57,9 @@ common language library import: language - build-depends: base >= 4.16 && < 5 + build-depends: base >= 4.18 && < 5 , effectful-core >= 2.5.0.0 && < 3.0.0.0 - , hpqtypes >= 1.13.0.0 && < 1.14.0.0 + , hpqtypes >= 2.0.0.0 && < 2.1.0.0 hs-source-dirs: src diff --git a/src/Effectful/HPQTypes.hs b/src/Effectful/HPQTypes.hs index 87b8e08..334839f 100644 --- a/src/Effectful/HPQTypes.hs +++ b/src/Effectful/HPQTypes.hs @@ -29,7 +29,7 @@ data DB :: Effect where GetLastQuery :: DB m (BackendPid, SomeSQL) WithFrozenLastQuery :: m a -> DB m a GetConnectionStats :: DB m PQ.ConnectionStats - GetQueryResult :: FromRow row => DB m (Maybe (QueryResult row)) + GetQueryResult :: DB m (Maybe QueryResult) ClearQueryResult :: DB m () GetConnectionAcquisitionMode :: DB m ConnectionAcquisitionMode AcquireAndHoldConnection :: IsolationLevel -> Permissions -> DB m () diff --git a/test/Main.hs b/test/Main.hs index 3a52df1..20efa94 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -34,7 +34,7 @@ testGetLastQuery = do let sql = "SELECT 1" rowNo <- runSQL sql liftIO $ assertEqual "One row should be retrieved" 1 rowNo - result <- fetchMany (runIdentity @Int32) + result <- fetchMany (fromSQL @Int32) liftIO $ assertEqual "Result should be [1]" [1] result (_, SomeSQL lastQuery) <- getLastQuery liftIO $ assertEqual "SQL don't match" (show sql) (show lastQuery)