Fix ShellCmd String arguments (#221)

* Fix ShellCmd String arguments Fixes #143. Changelog: - Rework ShellCmd's instances to support String arguments. - Add some tests. - Remove the IncoherentInstances pragma as it's deprecated. - Bump the major version as CmdArg's method has changed. - Bump the resolver to lts-20.04 (the latest as of this writing). - Bump haskell-ci to 0.15.20221107 * Remove symlink * Cosmetics (stray character, whitespace) * - Change version to 1.12.0 - Bump haskell-ci to 0.15.20230128 - Drop support for ghc 8.0.2 - Update changelog * Add missing updated ChangeLog.md * Update ShellArg and ShellCommand to mirror CmdArg and ShellCmd respectively. * Update ChangeLog.md --------- Co-authored-by: Andreas Abel <andreas.abel@ifi.lmu.de>
gregwebs · Feb 27, 2023 · 900bb9f · 900bb9f
1 parent d0b16a6
commit 900bb9f
Show file tree

Hide file tree

Showing 11 changed files with 267 additions and 62 deletions.
diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml
@@ -8,9 +8,9 @@
 #
 # For more information, see https://github.com/haskell-CI/haskell-ci
 #
-# version: 0.15.20221225
+# version: 0.15.20230128
 #
-# REGENDATA ("0.15.20221225",["github","shelly.cabal"])
+# REGENDATA ("0.15.20230128",["github","shelly.cabal"])
 #
 name: Haskell-CI
 on:
@@ -72,11 +72,6 @@ jobs:
             compilerVersion: 8.2.2
             setup-method: hvr-ppa
             allow-failure: false
-          - compiler: ghc-8.0.2
-            compilerKind: ghc
-            compilerVersion: 8.0.2
-            setup-method: hvr-ppa
-            allow-failure: false
       fail-fast: false
     steps:
       - name: apt
@@ -87,16 +82,18 @@ jobs:
             mkdir -p "$HOME/.ghcup/bin"
             curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup"
             chmod a+x "$HOME/.ghcup/bin/ghcup"
+            "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml;
             "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
-            "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
+            "$HOME/.ghcup/bin/ghcup" install cabal 3.9.0.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.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup"
             chmod a+x "$HOME/.ghcup/bin/ghcup"
-            "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
+            "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml;
+            "$HOME/.ghcup/bin/ghcup" install cabal 3.9.0.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
           fi
         env:
           HCKIND: ${{ matrix.compilerKind }}
@@ -114,13 +111,13 @@ jobs:
             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.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
+            echo "CABAL=$HOME/.ghcup/bin/cabal-3.9.0.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.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
+            echo "CABAL=$HOME/.ghcup/bin/cabal-3.9.0.0 -vnormal+nowrap" >> "$GITHUB_ENV"
           fi
 
           HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
@@ -203,8 +200,8 @@ jobs:
           touch cabal.project
           touch cabal.project.local
           echo "packages: ${PKGDIR_shelly}" >> cabal.project
-          if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package shelly" >> cabal.project ; fi
-          if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "    ghc-options: -Werror=missing-methods" >> cabal.project ; fi
+          echo "package shelly" >> cabal.project
+          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 /^(shelly)$/; }' >> cabal.project.local
@@ -214,8 +211,8 @@ jobs:
         run: |
           $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
           cabal-plan
-      - name: cache
-        uses: actions/cache@v3
+      - name: restore cache
+        uses: actions/cache/restore@v3
         with:
           key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
           path: ~/.cabal/store
@@ -239,8 +236,14 @@ jobs:
           ${CABAL} -vnormal check
       - name: haddock
         run: |
-          $CABAL v2-haddock --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
+          $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
       - name: unconstrained build
         run: |
           rm -f cabal.project.local
           $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
+      - name: save cache
+        uses: actions/cache/save@v3
+        if: always()
+        with:
+          key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
+          path: ~/.cabal/store
diff --git a/ChangeLog.md b/ChangeLog.md
@@ -1,3 +1,15 @@
+# 1.12.0
+
+Cunning Defenstrator, 2023-02-12
+* Rework ShellCmd and ShellCommand instances to support String arguments.
+* Add some tests.
+* Remove the IncoherentInstances pragma as it's deprecated.
+* Bump the major version as CmdArg and ShellArg have changed.  Users must
+  migrate existing instances by replacing `toTextArg` with `toTextArgs` and
+  wrapping the old return value in a list.
+* Bump the resolver to lts-20.04.
+* Bump haskell-ci to 0.15.20230128.
+
 # 1.11.0
 
 Andreas Abel, 2023-01-24

diff --git a/shelly.cabal b/shelly.cabal
@@ -1,6 +1,6 @@
 Name:       shelly
 
-Version:     1.11.0
+Version:     1.12.0
 Synopsis:    shell-like (systems) programming in Haskell
 
 Description: Shelly provides convenient systems programming in Haskell,
@@ -38,7 +38,6 @@ tested-with:
   GHC == 8.6.5
   GHC == 8.4.4
   GHC == 8.2.2
-  GHC == 8.0.2
 
 -- for the sdist of the test suite
 extra-source-files:
@@ -124,6 +123,7 @@ Test-Suite shelly-testsuite
     Help
     LiftedSpec
     MoveSpec
+    PipeSpec
     ReadFileSpec
     RmSpec
     RunSpec

diff --git a/src/Shelly.hs b/src/Shelly.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE IncoherentInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -175,33 +174,34 @@ cmd fp args = run fp $ toTextArgs args
 
 -- | Argument converter for the variadic argument version of 'run' called 'cmd'.
 -- Useful for a type signature of a function that uses 'cmd'.
-class CmdArg a where toTextArg :: a -> Text
-instance CmdArg Text     where toTextArg = id
-instance CmdArg String   where toTextArg = T.pack
+class CmdArg a where toTextArgs :: a -> [Text]
+
+instance CmdArg Text   where
+  toTextArgs = (: []) . id
+
+instance CmdArg String where
+  toTextArgs = (: []) . T.pack
+
+instance {-# OVERLAPPABLE #-} CmdArg a => CmdArg [a] where
+  toTextArgs = concatMap toTextArgs
 
 -- | For the variadic function 'cmd'.
 --
 -- Partially applied variadic functions require type signatures.
 class ShellCmd t where
     cmdAll :: FilePath -> [Text] -> t
 
-instance ShellCmd (Sh Text) where
-    cmdAll = run
+-- This is the only candidate for `_ <- cmd path x y z` so marking it incoherent will return it and
+-- terminate the search immediately.  This also removes the warning for do { cmd path x y z ; .. }
+-- as GHC will infer `Sh ()` instead of `Sh Text` as before.
+instance {-# INCOHERENT #-} s ~ () => ShellCmd (Sh s) where
+    cmdAll = run_
 
-instance (s ~ Text, Show s) => ShellCmd (Sh s) where
+instance ShellCmd (Sh Text) where
     cmdAll = run
 
--- note that Sh () actually doesn't work for its case (_<- cmd) when there is no type signature
-instance ShellCmd (Sh ()) where
-    cmdAll = run_
-
 instance (CmdArg arg, ShellCmd result) => ShellCmd (arg -> result) where
-    cmdAll fp acc x = cmdAll fp (acc ++ [toTextArg x])
-
-instance (CmdArg arg, ShellCmd result) => ShellCmd ([arg] -> result) where
-    cmdAll fp acc x = cmdAll fp (acc ++ map toTextArg x)
-
-
+    cmdAll fp acc x = cmdAll fp (acc ++ toTextArgs x)
 
 -- | Variadic argument version of 'run'.
 -- Please see the documenation for 'run'.

diff --git a/src/Shelly/Pipe.hs b/src/Shelly/Pipe.hs
@@ -610,27 +610,23 @@ put = sh1 S.put
 -- polyvariadic vodoo
 
 -- | Converter for the variadic argument version of 'run' called 'cmd'.
-class ShellArg a where toTextArg :: a -> Text
-instance ShellArg Text     where toTextArg = id
-instance ShellArg FilePath where toTextArg = toTextIgnore
+class ShellArg a where toTextArgs :: a -> [Text]
+instance ShellArg Text where toTextArgs = (: []) . id
+instance ShellArg String where toTextArgs = (: []) . T.pack
+instance {-# OVERLAPPABLE #-} ShellArg a => ShellArg [a] where
+  toTextArgs = Prelude.concatMap toTextArgs
 
-
--- Voodoo to create the variadic function 'cmd'
 class ShellCommand t where
     cmdAll :: FilePath -> [Text] -> t
 
-instance ShellCommand (Sh Text) where
-    cmdAll fp args = run fp args
-
-instance (s ~ Text, Show s) => ShellCommand (Sh s) where
-    cmdAll fp args = run fp args
+instance {-# INCOHERENT #-} s ~ () => ShellCommand (Sh s) where
+    cmdAll = run_
 
--- note that Sh () actually doesn't work for its case (_<- cmd) when there is no type signature
-instance ShellCommand (Sh ()) where
-    cmdAll fp args = run_ fp args
+instance ShellCommand (Sh Text) where
+    cmdAll = run
 
 instance (ShellArg arg, ShellCommand result) => ShellCommand (arg -> result) where
-    cmdAll fp acc = \x -> cmdAll fp (acc ++ [toTextArg x])
+    cmdAll fp acc x = cmdAll fp (acc ++ toTextArgs x)
 
 -- | see 'S.cmd'
 cmd :: (ShellCommand result) => FilePath -> result

diff --git a/stack.yaml b/stack.yaml
@@ -2,5 +2,5 @@ flags: {}
 packages:
 - '.'
 - shelly-extra/
-resolver: lts-18.16
-extra-deps: []
+resolver: lts-20.04
+extra-deps: []
diff --git a/stack.yaml.lock b/stack.yaml.lock
@@ -6,7 +6,7 @@
 packages: []
 snapshots:
 - completed:
-    size: 586286
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/16.yaml
-    sha256: cdead65fca0323144b346c94286186f4969bf85594d649c49c7557295675d8a5
-  original: lts-18.16
+    sha256: 3770dfd79f5aed67acdcc65c4e7730adddffe6dba79ea723cfb0918356fc0f94
+    size: 648660
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/4.yaml
+  original: lts-20.4
diff --git a/test/src/FindSpec.hs b/test/src/FindSpec.hs
@@ -51,23 +51,23 @@ findSpec = do
       res <- shelly $ cd "test/src" >> ls "."
       sort res @?= map toWindowsStyleIfNecessary ["./CopySpec.hs", "./EnvSpec.hs", "./FailureSpec.hs",
                     "./FindSpec.hs", "./Help.hs", "./LiftedSpec.hs", "./LogWithSpec.hs", "./MoveSpec.hs",
-                    "./ReadFileSpec.hs", "./RmSpec.hs", "./RunSpec.hs", "./SshSpec.hs",
+                    "./PipeSpec.hs", "./ReadFileSpec.hs", "./RmSpec.hs", "./RunSpec.hs", "./SshSpec.hs",
                     "./TestInit.hs", "./TestMain.hs",
                     "./WhichSpec.hs", "./WriteSpec.hs", "./sleep.hs"]
 
     it "lists relative files in folder" $ do
       res <- shelly $ cd "test" >> ls "src"
       sort res @?=  map toWindowsStyleIfNecessary ["src/CopySpec.hs", "src/EnvSpec.hs", "src/FailureSpec.hs",
                     "src/FindSpec.hs", "src/Help.hs", "src/LiftedSpec.hs", "src/LogWithSpec.hs", "src/MoveSpec.hs",
-                    "src/ReadFileSpec.hs", "src/RmSpec.hs", "src/RunSpec.hs", "src/SshSpec.hs",
+                    "src/PipeSpec.hs", "src/ReadFileSpec.hs", "src/RmSpec.hs", "src/RunSpec.hs", "src/SshSpec.hs",
                     "src/TestInit.hs", "src/TestMain.hs",
                     "src/WhichSpec.hs", "src/WriteSpec.hs", "src/sleep.hs"]
 
     it "finds relative files" $ do
       res <- shelly $ cd "test/src" >> find "."
       sort res @?= map toWindowsStyleIfNecessary ["./CopySpec.hs", "./EnvSpec.hs", "./FailureSpec.hs",
                     "./FindSpec.hs", "./Help.hs", "./LiftedSpec.hs", "./LogWithSpec.hs", "./MoveSpec.hs",
-                    "./ReadFileSpec.hs", "./RmSpec.hs", "./RunSpec.hs", "./SshSpec.hs",
+                    "./PipeSpec.hs", "./ReadFileSpec.hs", "./RmSpec.hs", "./RunSpec.hs", "./SshSpec.hs",
                     "./TestInit.hs", "./TestMain.hs",
                     "./WhichSpec.hs", "./WriteSpec.hs", "./sleep.hs"]
 
@@ -86,13 +86,13 @@ findSpec = do
       if isWindows
         then sort res @?= ["test/src\\CopySpec.hs", "test/src\\EnvSpec.hs", "test/src\\FailureSpec.hs",
                     "test/src\\FindSpec.hs", "test/src\\Help.hs", "test/src\\LiftedSpec.hs",
-                    "test/src\\LogWithSpec.hs", "test/src\\MoveSpec.hs", "test/src\\ReadFileSpec.hs",
+                    "test/src\\LogWithSpec.hs", "test/src\\MoveSpec.hs", "test/src\\PipeSpec.hs", "test/src\\ReadFileSpec.hs",
                     "test/src\\RmSpec.hs", "test/src\\RunSpec.hs", "test/src\\SshSpec.hs",
                     "test/src\\TestInit.hs", "test/src\\TestMain.hs", "test/src\\WhichSpec.hs", "test/src\\WriteSpec.hs",
                     "test/src\\sleep.hs"]
         else sort res @?= ["test/src/CopySpec.hs", "test/src/EnvSpec.hs", "test/src/FailureSpec.hs",
                     "test/src/FindSpec.hs", "test/src/Help.hs", "test/src/LiftedSpec.hs",
-                    "test/src/LogWithSpec.hs", "test/src/MoveSpec.hs", "test/src/ReadFileSpec.hs",
+                    "test/src/LogWithSpec.hs", "test/src/MoveSpec.hs", "test/src/PipeSpec.hs", "test/src/ReadFileSpec.hs",
                     "test/src/RmSpec.hs", "test/src/RunSpec.hs", "test/src/SshSpec.hs",
                     "test/src/TestInit.hs", "test/src/TestMain.hs", "test/src/WhichSpec.hs", "test/src/WriteSpec.hs",
                     "test/src/sleep.hs"]
@@ -101,8 +101,8 @@ findSpec = do
       res <- shelly $ relPath "test/src" >>= find >>= mapM (relativeTo "test/src")
       sort res @?= ["CopySpec.hs", "EnvSpec.hs", "FailureSpec.hs", "FindSpec.hs",
                     "Help.hs", "LiftedSpec.hs", "LogWithSpec.hs", "MoveSpec.hs",
-                    "ReadFileSpec.hs", "RmSpec.hs", "RunSpec.hs", "SshSpec.hs",
-                    "TestInit.hs", "TestMain.hs",
+                    "PipeSpec.hs", "ReadFileSpec.hs", "RmSpec.hs", "RunSpec.hs",
+                    "SshSpec.hs", "TestInit.hs", "TestMain.hs",
                     "WhichSpec.hs", "WriteSpec.hs", "sleep.hs"]
 
     unless isWindows $ before createSymlinkForTest $ do