Use dynamic dispatch (#1)

scrive · May 20, 2024 · 36d5bde · 36d5bde
1 parent 6ffe292
commit 36d5bde
Show file tree

Hide file tree

Showing 7 changed files with 140 additions and 81 deletions.
diff --git a/.github/workflows/fourmolu.yaml b/.github/workflows/fourmolu.yaml
@@ -11,5 +11,7 @@ jobs:
     runs-on: ubuntu-22.04
     steps:
       # Note that you must checkout your code before running fourmolu/fourmolu-action
-      - uses: actions/checkout@v3
-      - uses: fourmolu/fourmolu-action@v4
+      - uses: actions/checkout@v4
+      - uses: fourmolu/fourmolu-action@v10
+        with:
+          vesion: "0.15.0.0"
diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml
@@ -1,46 +1,55 @@
 # This GitHub workflow config has been generated by a script via
 #
-#   haskell-ci 'github' 'hedis-effectful.cabal'
+#   haskell-ci 'github' '--config=cabal.haskell-ci' 'cabal.project'
 #
 # To regenerate the script (for example after adjusting tested-with) run
 #
 #   haskell-ci regenerate
 #
 # For more information, see https://github.com/haskell-CI/haskell-ci
 #
-# version: 0.16.6
+# version: 0.19.20240514
 #
-# REGENDATA ("0.16.6",["github","hedis-effectful.cabal"])
+# REGENDATA ("0.19.20240514",["github","--config=cabal.haskell-ci","cabal.project"])
 #
 name: Haskell-CI
 on:
-  - push
-  - pull_request
+  push:
+    branches:
+      - master
+  pull_request:
+    branches:
+      - master
 jobs:
   linux:
     name: Haskell-CI - Linux - ${{ matrix.compiler }}
-    runs-on: ubuntu-22.04
+    runs-on: ubuntu-20.04
     timeout-minutes:
       60
     container:
-      image: buildpack-deps:bionic
+      image: buildpack-deps:jammy
     continue-on-error: ${{ matrix.allow-failure }}
     strategy:
       matrix:
         include:
-          - compiler: ghc-9.6.1
+          - compiler: ghc-9.8.2
             compilerKind: ghc
-            compilerVersion: 9.6.1
+            compilerVersion: 9.8.2
             setup-method: ghcup
             allow-failure: false
-          - compiler: ghc-9.4.4
+          - compiler: ghc-9.6.5
             compilerKind: ghc
-            compilerVersion: 9.4.4
+            compilerVersion: 9.6.5
             setup-method: ghcup
             allow-failure: false
-          - compiler: ghc-9.2.7
+          - compiler: ghc-9.4.8
             compilerKind: ghc
-            compilerVersion: 9.2.7
+            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
           - compiler: ghc-9.0.2
@@ -53,32 +62,17 @@ jobs:
             compilerVersion: 8.10.7
             setup-method: ghcup
             allow-failure: false
-          - compiler: ghc-8.8.4
-            compilerKind: ghc
-            compilerVersion: 8.8.4
-            setup-method: hvr-ppa
-            allow-failure: false
       fail-fast: false
     steps:
       - name: apt
         run: |
           apt-get update
           apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
-          if [ "${{ matrix.setup-method }}" = ghcup ]; then
-            mkdir -p "$HOME/.ghcup/bin"
-            curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup"
-            chmod a+x "$HOME/.ghcup/bin/ghcup"
-            "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
-            "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
-          else
-            apt-add-repository -y 'ppa:hvr/ghc'
-            apt-get update
-            apt-get install -y "$HCNAME"
-            mkdir -p "$HOME/.ghcup/bin"
-            curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup"
-            chmod a+x "$HOME/.ghcup/bin/ghcup"
-            "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
-          fi
+          mkdir -p "$HOME/.ghcup/bin"
+          curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"
+          chmod a+x "$HOME/.ghcup/bin/ghcup"
+          "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
+          "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
         env:
           HCKIND: ${{ matrix.compilerKind }}
           HCNAME: ${{ matrix.compiler }}
@@ -90,20 +84,13 @@ jobs:
           echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
           echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
           HCDIR=/opt/$HCKIND/$HCVER
-          if [ "${{ matrix.setup-method }}" = ghcup ]; then
-            HC=$HOME/.ghcup/bin/$HCKIND-$HCVER
-            echo "HC=$HC" >> "$GITHUB_ENV"
-            echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV"
-            echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV"
-            echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV"
-          else
-            HC=$HCDIR/bin/$HCKIND
-            echo "HC=$HC" >> "$GITHUB_ENV"
-            echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"
-            echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"
-            echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV"
-          fi
-
+          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"
+          echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
           HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
           echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
           echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
@@ -150,6 +137,11 @@ jobs:
       - name: update cabal index
         run: |
           $CABAL v2-update -v
+      - name: cache (tools)
+        uses: actions/cache/restore@v4
+        with:
+          key: ${{ runner.os }}-${{ matrix.compiler }}-tools-655fd156
+          path: ~/.haskell-ci-tools
       - name: install cabal-plan
         run: |
           mkdir -p $HOME/.cabal/bin
@@ -159,8 +151,18 @@ jobs:
           rm -f cabal-plan.xz
           chmod a+x $HOME/.cabal/bin/cabal-plan
           cabal-plan --version
+      - name: install doctest
+        run: |
+          $CABAL --store-dir=$HOME/.haskell-ci-tools/store v2-install $ARG_COMPILER --ignore-project -j2 doctest --constraint='doctest ^>=0.22.0'
+          doctest --version
+      - name: save cache (tools)
+        uses: actions/cache/save@v4
+        if: always()
+        with:
+          key: ${{ runner.os }}-${{ matrix.compiler }}-tools-655fd156
+          path: ~/.haskell-ci-tools
       - name: checkout
-        uses: actions/checkout@v3
+        uses: actions/checkout@v4
         with:
           path: source
       - name: initial cabal.project for sdist
@@ -188,15 +190,15 @@ jobs:
           echo "    ghc-options: -Werror=missing-methods" >> cabal.project
           cat >> cabal.project <<EOF
           EOF
-          $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(hedis-effectful)$/; }' >> cabal.project.local
+          $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(hedis-effectful)$/; }' >> cabal.project.local
           cat cabal.project
           cat cabal.project.local
       - name: dump install plan
         run: |
           $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
           cabal-plan
       - name: restore cache
-        uses: actions/cache/restore@v3
+        uses: actions/cache/restore@v4
         with:
           key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
           path: ~/.cabal/store
@@ -211,6 +213,10 @@ jobs:
       - name: build
         run: |
           $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always
+      - name: doctest
+        run: |
+          cd ${PKGDIR_hedis_effectful} || false
+          doctest  -XHaskell2010 -XNoStarIsType -XBangPatterns -XConstraintKinds -XDataKinds -XFlexibleContexts -XImportQualifiedPost -XGADTs -XLambdaCase -XTypeFamilies -XTypeOperators src
       - name: cabal check
         run: |
           cd ${PKGDIR_hedis_effectful} || false
@@ -223,7 +229,7 @@ jobs:
           rm -f cabal.project.local
           $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
       - name: save cache
-        uses: actions/cache/save@v3
+        uses: actions/cache/save@v4
         if: always()
         with:
           key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}

diff --git a/README.md b/README.md
@@ -1,6 +1,6 @@
 # hedis-effectful
 
-[![Build Status](https://github.com/scrive/hedis-effectful/workflows/Haskell-CI/badge.svg?branch=master)](https://github.com/scrive/hedis-effectful/actions?query=branch%3Amaster)
+[![Build Status](https://github.com/scrive/hedis-effectful/actions/workflows/haskell-ci.yml/badge.svg?branch=master)](https://github.com/scrive/hedis-effectful/actions?query=branch%3Amaster)
 [![Hackage](https://img.shields.io/hackage/v/hedis-effectful.svg)](https://hackage.haskell.org/package/hedis-effectful)
 [![Dependencies](https://img.shields.io/hackage-deps/v/hedis-effectful.svg)](https://packdeps.haskellers.com/[email protected])
 [![Stackage LTS](https://www.stackage.org/package/hedis-effectful/badge/lts)](https://www.stackage.org/lts/package/hedis-effectful)

diff --git a/cabal.haskell-ci b/cabal.haskell-ci
@@ -0,0 +1,5 @@
+branches:       master
+
+doctest:        <9.9
+tests:          True
+benchmarks:     True
diff --git a/fourmolu.yaml b/fourmolu.yaml
@@ -1,11 +1,56 @@
+# Number of spaces per indentation step
 indentation: 2
-function-arrows: leading # where to place arrows in type signatures
-comma-style: leading # for lists, tuples etc. - can also be 'trailing'
+
+# Max line length for automatic line breaking
+column-limit: none
+
+# Styling of arrows in type signatures (choices: trailing, leading, or leading-args)
+function-arrows: leading
+
+# How to place commas in multi-line lists, records, etc. (choices: leading or trailing)
+comma-style: leading
+
+# Styling of import/export lists (choices: leading, trailing, or diff-friendly)
 import-export-style: leading
-indent-wheres: false # 'false' means save space by only half-indenting the 'where' keyword
-record-brace-space: true # rec {x = 1} vs. rec{x = 1}
-newlines-between-decls: 1 # number of newlines between top-level declarations
-haddock-style: single-line # '--' vs. '{-'
+
+# Whether to full-indent or half-indent 'where' bindings past the preceding body
+indent-wheres: true
+
+# Whether to leave a space before an opening record brace
+record-brace-space: true
+
+# Number of spaces between top-level declarations
+newlines-between-decls: 1
+
+# How to print Haddock comments (choices: single-line, multi-line, or multi-line-compact)
+haddock-style: single-line
+
+# How to print module docstring
+haddock-style-module: null
+
+# Styling of let blocks (choices: auto, inline, newline, or mixed)
 let-style: inline
-in-style: left-align
-respectful: false # be opinionated about newlines etc
+
+# How to align the 'in' keyword with respect to the 'let' keyword (choices: left-align, right-align, or no-space)
+in-style: no-space
+
+# Whether to put parentheses around a single constraint (choices: auto, always, or never)
+single-constraint-parens: never
+
+# Whether to put parentheses around a single deriving class (choices: auto, always, or never)
+single-deriving-parens: always
+
+# Output Unicode syntax (choices: detect, always, or never)
+unicode: never
+
+# Give the programmer more choice on where to insert blank lines
+respectful: true
+
+# Fixity information for operators
+fixities: []
+
+# Module reexports Fourmolu should know about
+reexports:
+- module Prelude exports Data.Function
+- module Prelude exports Control.Applicative
+- module Prelude exports Control.Monad
diff --git a/hedis-effectful.cabal b/hedis-effectful.cabal
@@ -17,34 +17,37 @@ extra-source-files:
   CHANGELOG.md
   README.md
 
-tested-with:
-  GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.7 || ==9.6.3
+tested-with: GHC == { 8.10.7, 9.0.2, 9.2.8, 9.4.8, 9.6.5, 9.8.2 }
 
-bug-reports:        https://github.com/scrive/hedis-effectful/issues
+bug-reports: https://github.com/scrive/hedis-effectful/issues
 
 source-repository head
   type:     git
   location: https://github.com/scrive/hedis-effectful.git
 
 common language
-  ghc-options:        -Wall -Wcompat -Wno-unticked-promoted-constructors
+  ghc-options: -Wall -Wcompat -Wno-unticked-promoted-constructors
+               -Wprepositive-qualified-module
+
   default-language:   Haskell2010
   default-extensions:
     NoStarIsType
     BangPatterns
     ConstraintKinds
     DataKinds
     FlexibleContexts
+    ImportQualifiedPost
+    GADTs
     LambdaCase
     TypeFamilies
     TypeOperators
 
 library
   import:          language
   build-depends:
-    , base            >=4.13    && <5
+    , base            <5
     , effectful-core  >=1.0.0.0 && <3.0.0.0
-    , hedis           ^>=0.15
+    , hedis           >=0.15
 
   hs-source-dirs:  src
   exposed-modules: Effectful.Redis
diff --git a/src/Effectful/Redis.hs b/src/Effectful/Redis.hs
@@ -4,32 +4,30 @@
 -- | Access to a Redis database via 'MonadRedis'.
 module Effectful.Redis
   ( -- * Effect
-    Redis
+    Redis (..)
 
     -- * Handler
   , runRedis
   )
 where
 
-import qualified Database.Redis as R
+import Database.Redis qualified as R
 import Effectful
-import Effectful.Dispatch.Static
+import Effectful.Dispatch.Dynamic
 
 -- | Provide the ability to use the 'R.MonadRedis' instance of 'Eff'.
-data Redis :: Effect
+data Redis :: Effect where
+  LiftRedis :: R.Redis a -> Redis m a
 
-type instance DispatchOf Redis = Static WithSideEffects
-
-newtype instance StaticRep Redis = Redis R.Connection
+type instance DispatchOf Redis = Dynamic
 
 -- | Run the redis effect.
-runRedis :: (IOE :> es) => R.Connection -> Eff (Redis : es) a -> Eff es a
-runRedis = evalStaticRep . Redis
+runRedis :: IOE :> es => R.Connection -> Eff (Redis : es) a -> Eff es a
+runRedis conn = interpret $ \_ -> \case
+  LiftRedis action -> liftIO $ R.runRedis conn action
 
 ----------------------------------------
 -- Orphan instance
 
-instance (IOE :> es, Redis :> es) => R.MonadRedis (Eff es) where
-  liftRedis redis = do
-    Redis connection <- getStaticRep
-    liftIO $ R.runRedis connection redis
+instance Redis :> es => R.MonadRedis (Eff es) where
+  liftRedis = send . LiftRedis