Merge pull request #6 from fused-effects/distributive-algebras-plus-plus

Distributive algebras (+ a bit)

.ghci.fused-effects-readline → .ghci.repl

@@ -1,4 +1,4 @@
--- GHCI settings for fused-effects, collected by running cabal repl -v and checking out the flags cabal passes to ghc.
+-- GHCI settings collected by running cabal repl -v and checking out the flags cabal passes to ghc.
 -- These live here instead of script/repl for ease of commenting.
 -- These live here instead of .ghci so cabal repl remains unaffected.
 -- These live here instead of script/ghci-flags so ghcide remains unaffected.
@@ -23,4 +23,18 @@
 :seti -Wno-name-shadowing
 :seti -Wno-safe
 :seti -Wno-unsafe
+
+-- ghc 8.6+
 :seti -Wno-star-is-type
+
+-- ghc 8.8+
+:seti -Wno-missing-deriving-strategies
+
+-- ghc 8.10+
+:seti -Wno-missing-safe-haskell-mode
+:seti -Wno-prepositive-qualified-module
+
+-- We have this one on in the project but not in the REPL to reduce noise
+:seti -Wno-type-defaults
+
+:load Control.Carrier.Readline.Haskeline

.github/workflows/haskell.yml → .github/workflows/ci.yml

@@ -1,27 +1,21 @@
 name: Haskell CI
 
-on:
-  # Trigger the workflow on push or pull request,
-  # but only for the master branch
-  push:
-    branches:
-      - master
-  pull_request:
+on: [pull_request]
 
 jobs:
   build:
     name: ghc ${{ matrix.ghc }}
     runs-on: ubuntu-16.04
     strategy:
       matrix:
-        ghc: ["8.6.5", "8.8.1"]
+        ghc: ["8.6.5", "8.8.3", "8.10.1"]
         cabal: ["3.0"]
 
     steps:
     - uses: actions/checkout@v2
       if: github.event.action == 'opened' || github.event.action == 'synchronize' || github.event.ref == 'refs/heads/master'
 
-    - uses: actions/setup-haskell@v1
+    - uses: actions/setup-haskell@v1.1
       name: Setup Haskell
       with:
         ghc-version: ${{ matrix.ghc }}
@@ -41,18 +35,18 @@ jobs:
       name: Cache dist-newstyle
       with:
         path: dist-newstyle
-        key: ${{ runner.os }}-${{ matrix.ghc }}-fused-effects-dist
+        key: ${{ runner.os }}-${{ matrix.ghc }}-fused-effects-readline-dist
 
     - name: Install dependencies
       run: |
         cabal v2-update
-        cabal v2-configure --enable-tests --write-ghc-environment-files=always -j2
-        cabal v2-build --only-dependencies
+        cabal v2-configure --project-file=cabal.project.ci --enable-benchmarks --enable-tests --write-ghc-environment-files=always -j2
+        cabal v2-build     --project-file=cabal.project.ci --only-dependencies all
 
     - name: Build & test
       run: |
-        cabal v2-build
-        cabal v2-run test
-        cabal v2-haddock
-        cabal v2-sdist
+        cabal v2-build   --project-file=cabal.project.ci
+        cabal v2-run     --project-file=cabal.project.ci test
+        cabal v2-haddock --project-file=cabal.project.ci
+        cabal v2-sdist   --project-file=cabal.project.ci
         cabal check

.stylish-haskell.yaml

@@ -0,0 +1,33 @@
+steps:
+  - simple_align:
+      cases: true
+      top_level_patterns: true
+      records: true
+
+  - imports:
+      align: file
+      list_align: after_alias
+      pad_module_names: false
+      long_list_align: new_line_multiline
+      empty_list_align: inherit
+      list_padding: 2
+      separate_lists: false
+      space_surround: false
+
+  - language_pragmas:
+      style: vertical
+      align: false
+      remove_redundant: true
+
+  - tabs:
+      spaces: 2
+
+  - trailing_whitespace: {}
+
+columns: 120
+
+newline: native
+
+language_extensions:
+- FlexibleContexts
+- MultiParamTypeClasses

cabal.project

@@ -0,0 +1 @@
+packages: .

cabal.project.ci

@@ -0,0 +1,4 @@
+packages: .
+
+package fused-effects-readline
+  ghc-options: -Werror

fused-effects-readline.cabal

@@ -13,8 +13,14 @@ maintainer:          rob.rix@me.com
 copyright:           2019 Rob Rix
 category:            Development
 extra-source-files:
+  README.md
   CHANGELOG.md
 
+tested-with:
+  GHC == 8.6.5
+  GHC == 8.8.3
+  GHC == 8.10.1
+
 common common
   default-language: Haskell2010
   ghc-options:
@@ -28,10 +34,14 @@ common common
     -Wno-name-shadowing
     -Wno-safe
     -Wno-unsafe
-  if (impl(ghc >= 8.6))
+  if impl(ghc >= 8.6)
     ghc-options: -Wno-star-is-type
-  if (impl(ghc >= 8.8))
+  if impl(ghc >= 8.8)
     ghc-options: -Wno-missing-deriving-strategies
+  if impl(ghc >= 8.10)
+    ghc-options:
+      -Wno-missing-safe-haskell-mode
+      -Wno-prepositive-qualified-module
 
 library
   import: common
@@ -40,15 +50,18 @@ library
     Control.Carrier.Readline.Haskeline
     Control.Effect.Readline
   build-depends:
-      base >= 4.12 && < 5
-    , directory ^>= 1.3.3.2
-    , filepath ^>= 1.4.2.1
-    , fused-effects ^>= 1
-    , haskeline ^>= 0.7
+    , base >= 4.12 && < 5
+    , directory ^>= 1.3
+    , filepath ^>= 1.4
+    , fused-effects ^>= 1.1
+    , haskeline >= 0.7 && < 0.9
     , prettyprinter >= 1.5 && <1.7
     , prettyprinter-ansi-terminal ^>= 1.1
     , terminal-size ^>= 0.3
     , transformers >= 0.4 && < 0.6
+  if impl(ghc >= 8.10)
+    build-depends:
+      , exceptions ^>= 0.10
 
 test-suite test
   import: common

script/ghci-flags

@@ -3,51 +3,65 @@
 
 set -e
 
-cd $(dirname "$0")/..
+cd "$(dirname "$0")/.."
 
-root="$(pwd)"
 ghc_version="$(ghc --numeric-version)"
 
-if [ "$1" == "--builddir" ]; then
-  repl_builddir="$2"
-  shift 2
-else
-  repl_builddir=dist-newstyle
-fi
+# recent hie-bios requires us to output to the file at $HIE_BIOS_OUTPUT, but older builds & script/repl don’t set that var, so we default it to stdout
+output_file="${HIE_BIOS_OUTPUT:-/dev/stdout}"
 
-echo "-O0"
-echo "-ignore-dot-ghci"
+build_dir="dist-newstyle/build/x86_64-osx/ghc-$ghc_version"
+build_products_dir="$build_dir/build-repl"
 
-echo "-outputdir $repl_builddir/build/x86_64-osx/ghc-$ghc_version/build"
-echo "-odir $repl_builddir/build/x86_64-osx/ghc-$ghc_version/build"
-echo "-hidir $repl_builddir/build/x86_64-osx/ghc-$ghc_version/build"
-echo "-stubdir $repl_builddir/build/x86_64-osx/ghc-$ghc_version/build"
+cores=$(sysctl -n machdep.cpu.core_count || echo 4)
 
-echo "-i$root/src"
-echo "-i$root/test"
+function flags {
+  # disable optimizations for faster loading
+  echo "-O0"
+  # don’t load .ghci files (for ghcide)
+  echo "-ignore-dot-ghci"
 
-echo "-optP-include"
-echo "-optP$root/$repl_builddir/build/x86_64-osx/ghc-$ghc_version/build/autogen/cabal_macros.h"
+  # use as many jobs as there are physical cores
+  echo "-j$((cores + 1))"
 
-echo "-hide-all-packages"
+  # where to put build products
+  echo "-outputdir $build_products_dir"
+  echo "-odir $build_products_dir"
+  echo "-hidir $build_products_dir"
+  echo "-stubdir $build_products_dir"
 
-# Emit package flags from the environment file, removing comments & prefixing with -
-cabal exec --builddir="$repl_builddir" -v0 bash -- -c 'cat $GHC_ENVIRONMENT' | grep -v '^--' | sed -e 's/^/-/'
+  # .hs source dirs
+  echo "-isrc"
+  echo "-ibenchmark"
+  echo "-iexamples"
+  echo "-itest"
 
-echo "-XHaskell2010"
+  # disable automatic selection of packages
+  echo "-hide-all-packages"
 
-echo "-Wwarn"
+  # run cabal and emit package flags from the environment file, removing comments & prefixing with -
+  cabal v2-exec -v0 bash -- -c 'cat "$GHC_ENVIRONMENT"' | grep -v '^--' | sed -e 's/^/-/'
 
-echo "-Weverything"
-echo "-Wno-all-missed-specialisations"
-echo "-Wno-implicit-prelude"
-echo "-Wno-missed-specialisations"
-echo "-Wno-missing-import-lists"
-echo "-Wno-missing-local-signatures"
-echo "-Wno-monomorphism-restriction"
-echo "-Wno-name-shadowing"
-echo "-Wno-safe"
-echo "-Wno-unsafe"
+  # default language extensions
+  echo "-XHaskell2010"
 
-[[ "$ghc_version" = 8.6.* ]] && echo "-Wno-star-is-type" || true
-[[ "$ghc_version" = 8.8.* ]] && echo "-Wno-missing-deriving-strategies" || true
+  # treat warnings as warnings
+  echo "-Wwarn"
+
+  # default warning flags
+  echo "-Weverything"
+  echo "-Wno-all-missed-specialisations"
+  echo "-Wno-implicit-prelude"
+  echo "-Wno-missed-specialisations"
+  echo "-Wno-missing-import-lists"
+  echo "-Wno-missing-local-signatures"
+  echo "-Wno-monomorphism-restriction"
+  echo "-Wno-name-shadowing"
+  echo "-Wno-safe"
+  echo "-Wno-unsafe"
+  [[ "$ghc_version" = 8.6.* ]] || [[ "$ghc_version" = 8.8.* ]] || [[ "$ghc_version" = 8.10.* ]] && echo "-Wno-star-is-type" || true
+  [[ "$ghc_version" = 8.8.* ]] || [[ "$ghc_version" = 8.10.* ]] && echo "-Wno-missing-deriving-strategies" || true
+  [[ "$ghc_version" = 8.10.* ]] && echo "-Wno-missing-safe-haskell-mode" && echo "-Wno-prepositive-qualified-module" && echo "-Wno-unused-packages"
+}
+
+flags > "$output_file"

script/repl

@@ -4,10 +4,9 @@
 
 set -e
 
-cd $(dirname "$0")/..
+cd "$(dirname "$0")/.."
 
-repl_builddir=dist-repl
+cabal v2-build all --only-dependencies
 
-cabal build --builddir="$repl_builddir" all --only-dependencies
-
-cabal exec --builddir="$repl_builddir" env -- -u GHC_ENVIRONMENT ghci -ghci-script=.ghci.fused-effects-readline $(script/ghci-flags --builddir "$repl_builddir") -no-ignore-dot-ghci $@
+cores=$(sysctl -n machdep.cpu.core_count || echo 4)
+cabal v2-exec env -- -u GHC_ENVIRONMENT ghci +RTS -N$((cores + 1)) -RTS -ghci-script=.ghci.repl $(script/ghci-flags) -no-ignore-dot-ghci $@

src/Control/Carrier/Readline/Haskeline.hs

@@ -1,4 +1,10 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, LambdaCase, MultiParamTypeClasses, ScopedTypeVariables, TypeApplications #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -Wno-redundant-constraints #-}
 module Control.Carrier.Readline.Haskeline
 ( -- * Readline carrier
   runReadline
@@ -12,10 +18,12 @@ import Control.Algebra
 import Control.Carrier.Lift
 import Control.Carrier.Reader
 import Control.Effect.Readline
+#if MIN_VERSION_haskeline(0, 8, 0)
+import Control.Monad.Catch (MonadMask(..))
+#endif
 import Control.Monad.Fix (MonadFix)
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Trans.Class (MonadTrans(..))
-import Data.Coerce (coerce)
 import Data.Text.Prettyprint.Doc
 import Data.Text.Prettyprint.Doc.Render.Terminal
 import System.Console.Haskeline
@@ -25,10 +33,18 @@ import System.Environment
 import System.FilePath
 import System.IO (stdout)
 
+#if MIN_VERSION_haskeline(0, 8, 0)
+runReadline :: (MonadIO m, MonadMask m) => Prefs -> Settings m -> ReadlineC m a -> m a
+#else
 runReadline :: MonadException m => Prefs -> Settings m -> ReadlineC m a -> m a
-runReadline prefs settings (ReadlineC m) = runInputTWithPrefs prefs (coerce settings) (runM (runReader (Line 0) m))
+#endif
+runReadline prefs settings (ReadlineC m) = runInputTWithPrefs prefs settings (runM (runReader (Line 0) m))
 
+#if MIN_VERSION_haskeline(0, 8, 0)
+runReadlineWithHistory :: (MonadIO m, MonadMask m) => ReadlineC m a -> m a
+#else
 runReadlineWithHistory :: MonadException m => ReadlineC m a -> m a
+#endif
 runReadlineWithHistory block = do
   homeDir <- liftIO getHomeDirectory
   prefs   <- liftIO $ readPrefs (homeDir </> ".haskeline")
@@ -43,24 +59,29 @@ runReadlineWithHistory block = do
 
   runReadline prefs settings block
 
-newtype ReadlineC m a = ReadlineC { runReadlineC :: ReaderC Line (LiftC (InputT m)) a }
+newtype ReadlineC m a = ReadlineC (ReaderC Line (LiftC (InputT m)) a)
   deriving (Applicative, Functor, Monad, MonadFix, MonadIO)
 
 instance MonadTrans ReadlineC where
   lift = ReadlineC . lift . lift . lift
 
+#if MIN_VERSION_haskeline(0, 8, 0)
+instance (MonadIO m, MonadMask m) => Algebra Readline (ReadlineC m) where
+#else
 instance MonadException m => Algebra Readline (ReadlineC m) where
-  alg = \case
-    Prompt prompt k -> ReadlineC $ do
+#endif
+  alg _ sig ctx = case sig of
+    Prompt prompt -> ReadlineC $ do
       str <- sendM (getInputLine @m (cyan <> prompt <> plain))
       Line line <- ask
-      local increment (runReadlineC (k line str))
+      local increment $ pure ((line, str) <$ ctx)
       where cyan = "\ESC[1;36m\STX"
             plain = "\ESC[0m\STX"
-    Print doc k -> do
+    Print doc -> do
       s <- maybe 80 Size.width <$> liftIO size
-      liftIO (renderIO stdout (layoutSmart defaultLayoutOptions { layoutPageWidth = AvailablePerLine s 0.8 } (doc <> line)))
-      k
+      let docstream = layoutSmart (layoutOptions s) (doc <> line)
+      (<$ ctx) <$> (liftIO . renderIO stdout $ docstream)
+      where layoutOptions s = defaultLayoutOptions { layoutPageWidth = AvailablePerLine s 0.8 }
 
 
 newtype Line = Line Int