shelly 1.6.9 → 1.12.1.1
raw patch · 33 files changed
Files
- ChangeLog.md +160/−8
- README.md +53/−50
- shelly.cabal +141/−103
- src/Shelly.hs +349/−308
- src/Shelly/Base.hs +74/−85
- src/Shelly/Directory.hs +23/−0
- src/Shelly/Find.hs +52/−40
- src/Shelly/Lifted.hs +45/−44
- src/Shelly/Pipe.hs +76/−79
- src/Shelly/Unix.hs +1/−1
- test/data/hello.sh +3/−0
- test/data/symlinked_dir/hoge_file +0/−0
- test/examples/color.hs +2/−2
- test/examples/drain.hs +2/−2
- test/examples/run-handles.hs +1/−1
- test/src/CopySpec.hs +1/−6
- test/src/EnvSpec.hs +4/−6
- test/src/FindSpec.hs +77/−19
- test/src/Help.hs +0/−5
- test/src/LiftedSpec.hs +1/−1
- test/src/LogWithSpec.hs +0/−1
- test/src/MoveSpec.hs +6/−6
- test/src/PipeSpec.hs +97/−0
- test/src/PrintCommandsFnSpec.hs +14/−0
- test/src/ReadFileSpec.hs +1/−7
- test/src/RmSpec.hs +4/−3
- test/src/RunSpec.hs +117/−5
- test/src/ShowCommandSpec.hs +37/−0
- test/src/SshSpec.hs +24/−3
- test/src/TestInit.hs +6/−3
- test/src/TestMain.hs +6/−0
- test/src/WhichSpec.hs +1/−1
- test/src/WriteSpec.hs +0/−1
ChangeLog.md view
@@ -1,33 +1,185 @@+# 1.12.1.1++Andreas Abel, 2025-08-25+* Drop obsolete `deriving Typeable` everywhere.+* Tested with GHC 8.2 - 9.14 alpha1 (cabal) and GHC 8.10 - 9.12 (stack).++# 1.12.1++Andreas Abel, 2023-04-03+* Add `print_commands_with` and `echoWith` which can be used to override+ the default printing functions (e.g. to add color).+ (Chris Wendt, PR [#228](https://github.com/gregwebs/Shelly.hs/pull/228).)+* Tested with GHC 8.2 - 9.6 (cabal) and GHC 8.10 - 9.6 (stack).++# 1.12.0.1++Andreas Abel, 2023-04-02+* Make `show_command` more robust to special characters+ and only quote when necessary.+ (Chris Wendt, PR [#229](https://github.com/gregwebs/Shelly.hs/pull/229).)+* Tested with GHC 8.2 - 9.6 (cabal) and GHC 8.10 - 9.6 (stack).++# 1.12.0++Andreas Abel, 2023-02-27+* Rework `ShellCmd` and `ShellCommand` instances to support `String` arguments:+ Issue [#143](https://github.com/gregwebs/Shelly.hs/issues/143)+ fixed by Cunning Defenstrator in+ PR [#221](https://github.com/gregwebs/Shelly.hs/pull/221).++ This involves a **breaking change** in classes `CmdArg` and `ShellArg`:+ Method `toTextArg` has been replaced by `toTextArgs`.++ Sample migration:+ ```haskell+ #if MIN_VERSION_shelly(1,12,0)+ -- new+ import Shelly (toTextArgs)+ snoc opts arg = opts ++ toTextArgs arg+ #else+ -- old+ import Shelly (toTextArg)+ snoc opts arg = opts ++ [ toTextArg arg ]+ #endif+ ```+* Dropped GHC 8.0 to get rid of deprecated `LANGUAGE IncoherentInstances`.+* Builds with GHC 8.2 - 9.6.++# 1.11.0++Andreas Abel, 2023-01-24+* Restore running of local scripts, e.g. `cmd "./foo.sh"`:+ Issue [#107](https://github.com/gregwebs/Shelly.hs/issues/107)+ fixed by Alfredo di Napoli in PR+ [#216](https://github.com/gregwebs/Shelly.hs/pull/216).+* Builds with GHC 8.0 - 9.4.++# 1.10.0.1++Andreas Abel, 2023-01-24+* Allow `unix-compat-0.6`.+* Builds `-Wall` warning-free with GHC 8.0 - 9.4.++# 1.10.0++Andreas Abel, 2022-01-30+* Allow `transformers-0.6`:+ - Replace `ErrorT` by `ExceptT`.+ - Remove `MonadSh` and `MonadShControl` instance for `ListT`.+ [#211](https://github.com/gregwebs/Shelly.hs/pull/211)+* Bump lower bounds of dependencies, keeping all versions that build with GHC >= 8.0.+* Remove unused `unix` dependency.+* Allow `time-1.12`.+* Builds warning-free with GHC 8.0 - 9.2.1.++# 1.9.0++Greg Weber, 2019-08-29+* Drop dependencies `system-fileio` and `system-filepath` in favor of `filepath`:+ The `FilePath` type changed to a synonym of `String`.+* Allow `time >= 1.9`.+* Builds with GHC >= 8.0 (tested up to 9.2).++# 1.8.1++Greg Weber, 2018-05-30+* New function `cp_should_follow_symlinks` to specify whether a copy should follow symlinks.++# 1.8.0++Greg Weber, 2018-05-09+* `cp_r` now uses upper case R: `cp -R`.++# 1.7.2++Greg Weber, 2018-03-17+* Fix handling of case-insensitive environment variables on Windows.+ [#166](https://github.com/yesodweb/Shelly.hs/issues/166)++# 1.7.1++Greg Weber, 2018-03-06+* Support `exceptions-0.9`.++# 1.7.0.1++Greg Weber, 2018-01-23+* Fix `FindSpec.hs` tests.+ Fixes [#150](https://github.com/yesodweb/Shelly.hs/issues/150)+ and [#162](https://github.com/yesodweb/Shelly.hs/issues/162).++# 1.7.0++Greg Weber, 2017-12-10+* Quote `ssh` remote commands aggressively with single quotes.+ [#160](https://github.com/yesodweb/Shelly.hs/issues/160)++# 1.6.9++Greg Weber, 2017-12-07+* Strongly escape `ssh` commands.+* Add `sshPairsP`: parallel execution of `ssh` commands.+ # 1.6.8.7 -* Relax unix-compat constraints+Sibi Prabakaran, 2017-11-26+* Relax `unix-compat` constraints. # 1.6.8.6 +Sibi Prabakaran, 2017-11-19 * Fix Build issue [#156](https://github.com/yesodweb/Shelly.hs/issues/156) # 1.6.8.5 +Sibi Prabakaran, 2017-11-12 * Fix Windows build [#155](https://github.com/yesodweb/Shelly.hs/pull/155) +# 1.6.8.4++Greg Weber, 2017-08-07+* Option `followSymlink` for find-command.+* Allow `time-1.7/8`.++# 1.6.8.3++Greg Weber, 2017-03-03+* Support GHC 8.0.2++# 1.6.8.2++Greg Weber, 2017-03-03+* Allow `time-1.6`and `directory-1.3`++# 1.6.8.1++Greg Weber, 2016-10-02+* _changelog missing_+ # 1.6.8 -* added sshPairsWithOptions function+Greg Weber, 2016-06-26+* Added `sshPairsWithOptions` function. # 1.6.7 -* flush stdout when using `echo`, not just `echo_n`-* fix should be able to silence stderr when using `runHandle`-* expose RunFailed+Greg Weber, 2016-06-24+* Flush `stdout` when using `echo`, not just `echo_n`.+* Fix should be able to silence `stderr` when using `runHandle`.+* Expose `RunFailed`. # 1.6.6 -* add prependToPath function+Greg Weber, 2016-04-21+* Add `prependToPath` function. # 1.6.5 -* expose MonadShControl+Greg Weber, 2015-12-10+* Expose `MonadShControl`. # 1.6.4.1 -* add writeBinary function+Greg Weber, 2015-12-01+* Add `writeBinary` function.
README.md view
@@ -1,32 +1,33 @@ # Shelly -Shelly provides a single module for convenient systems programming in Haskell.+[](https://github.com/gregwebs/Shelly.hs/actions/workflows/haskell-ci.yml)+[](https://github.com/gregwebs/Shelly.hs/actions/workflows/mac-win-ci.yml)+[](https://hackage.haskell.org/package/shelly)+[](http://stackage.org/nightly/package/shelly)+[](http://stackage.org/lts/package/shelly) -* is aimed at convenience and getting things done rather than being a demonstration of elegance.-* has detailed and useful error messages-* maintains its own environment, making it thread-safe-* is modern, using Text and system-filepath/system-fileio-* has low memory usage- * `run_` and other underscore variants that don't return stdout- * `runFoldLines` to run a fold operation over each line rather than loading all of stdout into memory- * `runHandle` and `runHandles` for complete control over handles+Shelly provides a single module for convenient systems programming in Haskell. -Looking to put your Haskell learning to immediate practical use? You don't have to create artifical intelligence, try just automating some of your boring tasks.+* Shelly is aimed at convenience and getting things done rather than being a demonstration of elegance.+* It has detailed and useful error messages.+* It maintains its own environment, making it thread-safe.+* It has low memory usage: It has+ * `run_` and other underscore variants that do not return stdout,+ * `runFoldLines` to run a fold operation over each line rather than loading all of stdout into memory,+ * `runHandle` and `runHandles` for complete control over handles. The focus of this library on convenience combined with good error messages should make shelly approachable for newer users of Haskell.-I have published [an introductory article to scripting with shelly, targeted towards those not familiar with Haskell](http://www.linux-magazin.de/Online-Artikel/Shell-scripting-with-type-safety-using-Haskell/). There is a paid version in German from Linux Magazin.-That article uses the version `shelly < 1.0` which uses lazy text. `shelly > 1.0` uses strict text. ## More shelly packages -The [shelly-extra](http://hackage.haskell.org/package/shelly-extra) package has some additional functionality that requires additional dependencies, currently including a convenient concurrency/futures implementation. If you are following along the above article you need to install it.+The [shelly-extra](https://hackage.haskell.org/package/shelly-extra) package has some additional functionality that requires additional dependencies, currently including a convenient concurrency/futures implementation. ## Examples -* [A small deployment script](http://www.alfredodinapoli.com/posts/2015-11-03-how-i-deploy-haskell-code.html)+* [A small deployment script](https://adinapoli.github.io/alfredodinapoli.com/posts/2015-11-03-how-i-deploy-haskell-code.html) * [Yesod development installer](https://github.com/yesodweb/scripts/blob/master/install.hs) * [cabal-meta, a haskell install tool](https://github.com/yesodweb/cabal-meta/blob/master/main.hs) * [antigen-hs, a zsh plugin manager](https://github.com/Tarrasch/antigen-hs)@@ -34,12 +35,12 @@ ### Blog Posts -* [Shelly automation with Literate Haskell](http://www.scholarslab.org/dh-developer/shell-programming-in-haskell-converting-s5-slides-to-pdf/)+* [Shelly automation with Literate Haskell](https://scholarslab.lib.virginia.edu/blog/shell-programming-in-haskell-converting-s5-slides-to-pdf/) ### Testimonials -* [a beginning Haskeller does automation](http://www.reddit.com/r/haskell/comments/w86gu/my_current_job_task_is_boring_so_i_wrote_a_simple/)+* [A beginning Haskeller does automation](https://www.reddit.com/r/haskell/comments/w86gu/my_current_job_task_is_boring_so_i_wrote_a_simple/) ### Help @@ -50,15 +51,16 @@ ### Haskell shell scripting libraries -* [HSH](http://hackage.haskell.org/package/HSH) - A good alternative if you want to mixup usage of String and ByteString rather than just use Text.-* [HsShellScript](http://hackage.haskell.org/packages/archive/hsshellscript/3.1.0/doc/html/HsShellScript.html) - Has extensive low-level shell capabilities.-* [shell-conduit](http://hackage.haskell.org/package/shell-conduit) - efficient streaming via conduits. Makes some portability sacrifices by- * encouraging one to just use the shell instead of cross-platform Haskell code- * encouraging one to use a convenience function that searches the PATH at compile-time-* [shell-monad](http://hackage.haskell.org/package/shell-monad) - compile Haskell code down to shell script. This is a different approach from all the rest of the libraries. Writing your script is not as user-friendly as the other Haskell libraries, but it nicely solves the deployment issue.-* [turtle](http://hackage.haskell.org/package/turtle) - In some sense a [redesign of Shelly designed for beginner-friendliness](http://www.reddit.com/r/haskell/comments/2u6b8m/use_haskell_for_shell_scripting/co5ucq9)+* [HSH](https://hackage.haskell.org/package/HSH): A good alternative if you want to mixup usage of `String` and `ByteString` rather than just use `Text`.+* [HsShellScript](https://hackage.haskell.org/packages/archive/hsshellscript/3.1.0/doc/html/HsShellScript.html): Has extensive low-level shell capabilities.+* [shell-conduit](https://hackage.haskell.org/package/shell-conduit): Efficient streaming via conduits. Makes some portability sacrifices by+ * encouraging one to just use the shell instead of cross-platform Haskell code, and+ * encouraging one to use a convenience function that searches the `PATH` at compile-time.+* [shell-monad](https://hackage.haskell.org/package/shell-monad): Compile Haskell code down to shell script. This is a different approach from all the rest of the libraries. Writing your script is not as user-friendly as the other Haskell libraries, but it nicely solves the deployment issue.+* [shh](https://hackage.haskell.org/package/shh): Shell-like syntax with native piping. Can be used from GHCi as an interactive shell replacement.+* [turtle](https://hackage.haskell.org/package/turtle): In some sense a [redesign of Shelly designed for beginner-friendliness](https://www.reddit.com/r/haskell/comments/2u6b8m/use_haskell_for_shell_scripting/co5ucq9). -HSH and HsShellScript (unlike Shelly currently) implement very efficient mechanisms for piping/redirecting in the system.+HSH, HsShellScript and shh (unlike Shelly currently) implement very efficient mechanisms for piping/redirecting in the system. turtle, like Shelly offers folding as a way to efficiently deal with a stream. None of the alternatives to Shelly offer command tracing.@@ -67,8 +69,8 @@ ### Haskell file-finding supplements -* [find-conduit](http://hackage.haskell.org/package/find-conduit) - uses conduits, similar speed to GNU find-* [FileManip](hackage.haskell.org/package/FileManip) - uses Lazy IO+* [find-conduit](https://hackage.haskell.org/package/find-conduit): Uses conduits, similar speed to GNU find.+* [FileManip](https://hackage.haskell.org/package/FileManip): Uses Lazy IO. Shelly's finders load all files into memory. This is simpler to use if you control the filesystem structure and know the system is bounded in size. However, if the filesystem structure is unbounded it consumes unbounded memory. @@ -78,9 +80,9 @@ Shelly does not change the nature of shell scripting (text in, text out). If you want something more revolutionary you might try these: -* PowerShell is probably the best known.-* [Haskell project](https://github.com/pkamenarsky/ytools) using typed JSON-* [RecordStream](https://github.com/benbernard/RecordStream) untyped JSON]+* [PowerShell](https://github.com/PowerShell/PowerShell) is probably the best known.+* A [Haskell project](https://github.com/pkamenarsky/ytools) using typed JSON.+* [RecordStream](https://github.com/benbernard/RecordStream) using untyped JSON. ## Usage@@ -89,28 +91,31 @@ There should be a primitive for every shell operation you need so you can easily build abstractions, so there are many of the usual file and environment operations. There are 2 main entry points for running arbitrary commands: `run` and `cmd`.-They take a FilePath as their first argument. `run` takes a [Text] as its second argument.-`cmd` takes a variadic number of arguments, and they can be either Text or FilePath.+They take a FilePath as their first argument. `run` takes a `[Text]` as its second argument.+`cmd` takes a variadic number of arguments, and they can be either `Text` or `FilePath`. -Fun Example: shows an infectious script: it uploads itself to a server and runs itself over ssh.+Fun Example: shows an infectious script: it uploads itself to a server and runs itself over `ssh`. Of course, the development machine may need to be exactly the same OS as the server. I recommend using the boilerplate at the top of this example in your projects. This includes setting line buffering if you are dealing with text and not binary data. -~~~~~ {.haskell}+```haskell {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ExtendedDefaultRules #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-}+ import Shelly+ import System.IO import Data.Text as T default (T.Text) + main :: IO () main = do hSetBuffering stdout LineBuffering shelly $ verbosely $ do host <- run "uname" ["-n"]- if T.stripEnd host === "local-machine"+ if T.stripEnd host == "local-machine" then do d <- cmd "date" c <- escaping False $ cmd "git" "log -1 | head -1 | awk '{print $2}'" appendfile "log/deploy.log" $ T.intercalate " - " [T.stripEnd d, c]@@ -124,8 +129,9 @@ uploads :: Text -> [Text] -> Sh () uploads remote locals = rsync $ ["--relative"] ++ locals ++ [remote] + rsync :: [Text] -> Sh () rsync args = run_ "rsync" $ ["--delete", "-avz", "--no-g"] ++ args-~~~~~+``` ### Variadic arguments to cmd @@ -133,33 +139,35 @@ I find `cmd` to be more convenient, but I often use `run` and `command` variants when I am building up abstractions. Building up abstractions with cmd will require type signatures. +```haskell -- easy signature, but only allows one argument let cabal = cmd "cabal" :: Text -> Sh Text -- more complex signature that allows partial application of cmd let cabal = cmd "cabal" :: Shelly.ShellCmd result => result-+``` ### Escaping By default, all commands are shell escaped.-If you want the shell to interpret special characters such as `*`, just use `escaping False $ do ...`+If you want the shell to interpret special characters such as `*`, just use `escaping False $ do ...`. ### Using Text and FilePath together -Shelly's usage of system-filepath means you may need to convert between Text and FilePath sometimes.-This should be infrequent though because+Shelly's usage of `Text` means you may need to convert between `Text` and `FilePath` sometimes.+This should be infrequent though because: -* `cmd` will convert FilePath to Text-* The `</>` and `<.>` combinators convert String/Text into a FilePath automatically+* `cmd` will convert `FilePath` to `Text`.+* The `</>` and `<.>` combinators convert `Text` into a `FilePath` automatically. Manual conversion is done through `toTextIgnore` or `toTextWarn`. ### Thread-safe working directory and relative paths -`cd` does not change the process working directory (essentially a global variable), but instead changes the shelly state (which is thread safe).+Command `cd` does not change the process working directory (essentially a global variable),+but instead changes the shelly state (which is thread safe). All of the Shelly API takes this into account, internally shelly converts all paths to absolute paths. You can turn a relative path into an absolute with `absPath` or `canonic` or you can make a path relative to the Shelly working directory with `relPath`. @@ -168,15 +176,10 @@ Haskell's #1 weakness for IO code is a lack of stack traces. Shelly gives you something different: detailed logging. In most cases this should be more useful than a stack trace.-Shelly keeps a log of API usage and saves it to a .shelly directory on failure.-If you use `shellyNoDir`, the log will instead be printed to stderr.+Shelly keeps a log of API usage and saves it to a `.shelly` directory on failure.+If you use `shellyNoDir`, the log will instead be printed to `stderr`. This is in addition to the `verbosely` settings that will print out commands and their output as the program is running. Shelly's own error messages are detailed and in some cases it will catch Haskell exceptions and re-throw them with better messages. -If you make your own primitive functions that don't use the existing Shelly API, you can create a wrapper in the Sh monad that use `trace` or `tag` to log what they are doing.+If you make your own primitive functions that do not use the existing Shelly API, you can create a wrapper in the Sh monad that use `trace` or `tag` to log what they are doing. You can turn tracing off (not generally recommended) by setting `tracing False`.---## Future plans--* Don't use the filepath library
shelly.cabal view
@@ -1,94 +1,130 @@-Name: shelly+cabal-version: 2.0 -Version: 1.6.9-Synopsis: shell-like (systems) programming in Haskell+Name: shelly+Version: 1.12.1.1 -Description: Shelly provides convenient systems programming in Haskell,- similar in spirit to POSIX shells. Shelly:- .- * is aimed at convenience and getting things done rather than- being a demonstration of elegance.- .- * has detailed and useful error messages- .- * maintains its own environment, making it thread-safe.- .- * is modern, using Text and system-filepath/system-fileio- .- Shelly is originally forked from the Shellish package.- .- See the shelly-extra package for additional functionality.- .- An overview is available in the README: <https://github.com/yesodweb/Shelly.hs/blob/master/README.md>+Synopsis: shell-like (systems) programming in Haskell +Description: Shelly provides convenient systems programming in Haskell,+ similar in spirit to POSIX shells. Shelly:+ .+ * is aimed at convenience and getting things done rather than+ being a demonstration of elegance,+ .+ * has detailed and useful error messages,+ .+ * maintains its own environment, making it thread-safe.+ .+ Shelly is originally forked from the Shellish package.+ .+ See the shelly-extra package for additional functionality.+ .+ An overview is available in the README: <https://github.com/gregwebs/Shelly.hs/blob/master/README.md> -Homepage: https://github.com/yesodweb/Shelly.hs-License: BSD3-License-file: LICENSE-Author: Greg Weber, Petr Rockai-Maintainer: Greg Weber <greg@gregweber.info>-Category: Development-Build-type: Simple-Cabal-version: >=1.8+Homepage: https://github.com/gregwebs/Shelly.hs+License: BSD3+License-file: LICENSE+Author: Greg Weber, Petr Rockai+Maintainer: Andreas Abel+Category: Development+Build-type: Simple +tested-with:+ GHC == 9.14.1+ GHC == 9.12.2+ GHC == 9.10.2+ GHC == 9.8.4+ GHC == 9.6.7+ GHC == 9.4.8+ GHC == 9.2.8+ GHC == 9.0.2+ GHC == 8.10.7+ GHC == 8.8.4+ GHC == 8.6.5+ GHC == 8.4.4+ GHC == 8.2.2++extra-doc-files:+ README.md+ ChangeLog.md+ -- for the sdist of the test suite-extra-source-files: test/src/*.hs- test/examples/*.sh- test/examples/*.hs- test/data/zshrc- test/data/nonascii.txt- test/testall- README.md- ChangeLog.md+extra-source-files:+ test/src/*.hs+ test/examples/*.sh+ test/examples/*.hs+ test/data/zshrc+ test/data/nonascii.txt+ test/data/symlinked_dir/hoge_file+ test/data/hello.sh+ test/testall Library- Exposed-modules: Shelly, Shelly.Lifted, Shelly.Pipe, Shelly.Unix- other-modules: Shelly.Base, Shelly.Find+ Exposed-modules:+ Shelly+ Shelly.Lifted+ Shelly.Pipe+ Shelly.Unix++ other-modules:+ Shelly.Base+ Shelly.Find+ Shelly.Directory+ hs-source-dirs: src + -- Andreas Abel, 2021-11-20, 2023-02-27:+ -- Unless other constraints exist, lower bounds (lb) are chosen+ -- as suggested by `cabal gen-bounds` with GHC 8.2, with some fixes:+ -- * lb version should exist on hackage+ -- * need to respect the ghc-shipped version (e.g. containers).+ -- Upper bounds should be omitted in general,+ -- unless breakage with major version bumps is expected.+ -- Upper bounds can always be added after the fact via (bulk) hackage revisions. Build-depends:- containers >= 0.4.2.0,- time >= 1.3 && < 1.9,- directory >= 1.1.0.0 && < 1.4.0.0,- mtl >= 2,- process >= 1.0,- unix-compat < 0.6,- system-filepath >= 0.4.7 && < 0.5,- system-fileio < 0.4,- monad-control >= 0.3.2 && < 1.1,- lifted-base,- lifted-async,- exceptions >= 0.6 && < 0.9,- enclosed-exceptions,- text, bytestring, async, transformers, transformers-base-- if impl(ghc >= 7.6.1)- build-depends:- base >= 4.6 && < 5- else- build-depends:- base >= 4 && < 5+ base >= 4.10 && < 5+ -- support GHC >= 8.2+ , async >= 2.2.3+ , bytestring >= 0.10.8.0+ , containers >= 0.5.10.2+ , directory >= 1.3.0.0 && < 1.4+ , enclosed-exceptions >= 1.0.1+ , exceptions >= 0.10.0+ , filepath >= 1.4.1.1+ , lifted-base >= 0.2.3.2+ , monad-control >= 0.3.2 && < 1.1+ , mtl >= 2.2.2+ , process >= 1.6.1.0+ , text >= 1.2.3.1+ , time >= 1.3+ , transformers >= 0.5.2.0+ , transformers-base >= 0.4.5+ , unix-compat >= 0.4.1.1 && < 0.8 - ghc-options: -Wall+ ghc-options:+ -Wall+ -Wcompat - if impl(ghc >= 7.6.1)- CPP-Options: -DNO_PRELUDE_CATCH+ cpp-options:+ -DNO_PRELUDE_CATCH - extensions:+ default-language: Haskell2010+ default-extensions: CPP+ TypeOperators source-repository head type: git- location: https://github.com/yesodweb/Shelly.hs+ location: https://github.com/gregwebs/Shelly.hs Flag lifted Description: run the tests against Shelly.Lifted Default: False Test-Suite shelly-testsuite- type: exitcode-stdio-1.0- hs-source-dirs: src test/src- main-is: TestMain.hs+ type: exitcode-stdio-1.0+ hs-source-dirs: test/src+ main-is: TestMain.hs other-modules: CopySpec EnvSpec@@ -97,51 +133,50 @@ Help LiftedSpec MoveSpec+ PipeSpec+ PrintCommandsFnSpec ReadFileSpec RmSpec RunSpec+ ShowCommandSpec SshSpec- Shelly- Shelly.Base- Shelly.Find- Shelly.Lifted TestInit WhichSpec WriteSpec - ghc-options: -O2 -Wall -fwarn-tabs -funbox-strict-fields -threaded- -fno-warn-unused-do-bind -fno-warn-type-defaults-+ ghc-options:+ -threaded+ -Wall+ -Wcompat+ -fwarn-tabs+ -funbox-strict-fields+ -fno-warn-type-defaults - extensions: OverloadedStrings, ExtendedDefaultRules+ default-language: Haskell2010+ default-extensions:+ OverloadedStrings+ ExtendedDefaultRules if flag(lifted) cpp-options: -DLIFTED build-depends:- base >= 4.6,- text >= 0.11,- async,- bytestring >= 0.10,- containers >= 0.5.0.0,- directory >= 1.1.0.0 && < 1.4.0.0,- process >= 1.1.0,- unix-compat < 0.6,- system-filepath >= 0.4.7 && < 0.5,- system-fileio < 0.4,- time >= 1.3 && < 1.9,- mtl >= 2,- HUnit >= 1.2,- hspec >= 1.5,- transformers,- transformers-base,- monad-control,- lifted-base,- lifted-async,- enclosed-exceptions,- exceptions+ shelly+ , base+ , bytestring+ , directory+ , filepath+ , lifted-async+ , mtl+ , text+ , transformers+ , unix-compat+ -- additional dependencies+ , hspec >= 2.2.2+ , hspec-contrib+ , HUnit >= 1.2.5.2 - extensions:+ default-extensions: CPP Flag build-examples@@ -149,19 +184,20 @@ Default: False Manual: True --- demonstarated that command output in Shellish was not shown until after the command finished+-- demonstrated that command output in Shellish was not shown until after the command finished -- not necessary anymore Executable drain hs-source-dirs: test/examples main-is: drain.hs+ default-language: Haskell2010 if flag(build-examples) buildable: True - build-depends: base >= 4.6+ build-depends: base , shelly , text - extensions:+ default-extensions: CPP else buildable: False@@ -169,14 +205,15 @@ Executable run-handles hs-source-dirs: test/examples main-is: run-handles.hs+ default-language: Haskell2010 if flag(build-examples) buildable: True - build-depends: base >= 4.6+ build-depends: base , shelly , text - extensions:+ default-extensions: CPP else buildable: False@@ -184,10 +221,11 @@ Executable Color hs-source-dirs: test/examples main-is: color.hs+ default-language: Haskell2010 if flag(build-examples) buildable: True - build-depends: base >= 4.6+ build-depends: base , process , shelly , text
src/Shelly.hs view
@@ -1,6 +1,8 @@-{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, OverloadedStrings,- FlexibleInstances, IncoherentInstances,- TypeFamilies, ExistentialQuantification #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-} -- | A module for shell-like programming in Haskell. -- Shelly's focus is entirely on ease of use for those coming from shell scripting.@@ -20,16 +22,17 @@ -- > import Shelly -- > import qualified Data.Text as T -- > default (T.Text)+ module Shelly (- -- * Entering Sh.+ -- * Entering Sh Sh, ShIO, shelly, shellyNoDir, shellyFailDir, asyncSh, sub- , silently, verbosely, escaping, print_stdout, print_stderr, print_commands+ , silently, verbosely, escaping, print_stdout, print_stderr, print_commands, print_commands_with , onCommandHandles , tracing, errExit , log_stdout_with, log_stderr_with - -- * Running external commands.+ -- * Running external commands , run, run_, runFoldLines, cmd, FoldCallback , bash, bash_, bashPipeFail , (-|-), lastStderr, setStdin, lastExitCode@@ -45,24 +48,24 @@ -- * Handle manipulation , HandleInitializer, StdInit(..), initOutputHandles, initAllHandles - -- * Modifying and querying environment.+ -- * Modifying and querying environment , setenv, get_env, get_env_text, getenv, get_env_def, get_env_all, get_environment, appendToPath, prependToPath -- * Environment directory , cd, chdir, chdir_p, pwd -- * Printing- , echo, echo_n, echo_err, echo_n_err, inspect, inspect_err+ , echo, echo_n, echo_err, echo_n_err, echoWith, inspect, inspect_err , tag, trace, show_command - -- * Querying filesystem.+ -- * Querying filesystem , ls, lsT, test_e, test_f, test_d, test_s, test_px, which -- * Filename helpers , absPath, (</>), (<.>), canonic, canonicalize, relPath, relativeTo, path , hasExt - -- * Manipulating filesystem.+ -- * Manipulating filesystem , mv, rm, rm_f, rm_rf, cp, cp_r, mkdir, mkdir_p, mkdirTree -- * reading/writing Files@@ -77,7 +80,7 @@ , RunFailed(..) -- * convert between Text and FilePath- , toTextIgnore, toTextWarn, FP.fromText+ , toTextIgnore, toTextWarn, fromText -- * Utility Functions , whenM, unlessM, time, sleep@@ -94,127 +97,97 @@ ) where import Shelly.Base+import Shelly.Directory import Shelly.Find-import Control.Monad ( when, unless, void, forM, filterM, liftM2 )++import Control.Applicative+import Control.Concurrent+import Control.Concurrent.Async (async, wait, Async)+import Control.Exception+import Control.Monad ( when, unless, void, liftM2 ) import Control.Monad.Trans ( MonadIO ) import Control.Monad.Reader (ask)-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706-import Prelude hiding ( readFile, FilePath, catch)-#else-import Prelude hiding ( readFile, FilePath)++import Data.ByteString ( ByteString )+import Data.Char ( isAlphaNum, isDigit, isSpace, isPrint )+#if defined(mingw32_HOST_OS)+import Data.Char ( toLower ) #endif-import Data.Char ( isAlphaNum, isSpace )-import Data.Typeable+import Data.Foldable ( toList ) import Data.IORef-import Data.Sequence (Seq, (|>))-import Data.Foldable (toList) import Data.Maybe-import System.IO ( hClose, stderr, stdout, openTempFile)-import System.IO.Error (isPermissionError, catchIOError, isEOFError, isIllegalOperation)-import System.Exit-import System.Environment-import Control.Applicative-import Control.Exception-import Control.Concurrent-import Control.Concurrent.Async (async, wait, Async)-import Data.Time.Clock( getCurrentTime, diffUTCTime )+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup ( (<>) )+#endif+import Data.Sequence ( Seq, (|>) )+import Data.Time.Clock ( getCurrentTime, diffUTCTime )+import Data.Tree ( Tree(..) ) +import qualified Data.ByteString as BS+import qualified Data.Set as Set+import qualified Data.Text as T import qualified Data.Text.IO as TIO import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding.Error as TE-import System.Process( CmdSpec(..), StdStream(CreatePipe, UseHandle), CreateProcess(..), createProcess, waitForProcess, terminateProcess, ProcessHandle, StdStream(..) ) -import qualified Data.Text as T-import qualified Data.ByteString as BS-import Data.ByteString (ByteString)--import Data.Monoid (Monoid, mempty, mappend)-#if __GLASGOW_HASKELL__ < 704-infixr 5 <>-(<>) :: Monoid m => m -> m -> m-(<>) = mappend-#else-import Data.Monoid ((<>))-#endif--import Filesystem.Path.CurrentOS hiding (concat, fromText, (</>), (<.>))-import Filesystem hiding (canonicalizePath)-import qualified Filesystem.Path.CurrentOS as FP--import System.Directory ( setPermissions, getPermissions, Permissions(..), getTemporaryDirectory )-import Data.Char (isDigit)--import Data.Tree(Tree(..))-import qualified Data.Set as S-import qualified Data.List as L--searchPathSeparator :: Char-#if defined(mingw32_HOST_OS)-searchPathSeparator = ';'-#else-searchPathSeparator = ':'-#endif+import System.Directory+ ( setPermissions, getPermissions, Permissions(..), getTemporaryDirectory, pathIsSymbolicLink+ , copyFile, removeFile, doesFileExist, doesDirectoryExist+ , renameFile, renameDirectory, removeDirectoryRecursive, createDirectoryIfMissing+ , getCurrentDirectory+ )+import System.Environment+import System.Exit+import System.FilePath hiding ((</>), (<.>))+import qualified System.FilePath as FP+import System.IO ( Handle, hClose, stderr, stdout, openTempFile)+import System.IO.Error (isPermissionError, catchIOError, isEOFError, isIllegalOperation)+import System.Process+ ( CmdSpec(..), StdStream(CreatePipe, UseHandle), CreateProcess(..)+ , createProcess, waitForProcess, terminateProcess+ , ProcessHandle, StdStream(..)+ ) -{- GHC won't default to Text with this, even with extensions!- - see: http://hackage.haskell.org/trac/ghc/ticket/6030-class CmdArgs a where+-- | 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+ -- | @since 1.12.0 toTextArgs :: a -> [Text] -instance CmdArgs Text where toTextArgs t = [t]-instance CmdArgs FilePath where toTextArgs t = [toTextIgnore t]-instance CmdArgs [Text] where toTextArgs = id-instance CmdArgs [FilePath] where toTextArgs = map toTextIgnore--instance CmdArgs (Text, Text) where- toTextArgs (t1,t2) = [t1, t2]-instance CmdArgs (FilePath, FilePath) where- toTextArgs (fp1,fp2) = [toTextIgnore fp1, toTextIgnore fp2]-instance CmdArgs (Text, FilePath) where- toTextArgs (t1, fp1) = [t1, toTextIgnore fp1]-instance CmdArgs (FilePath, Text) where- toTextArgs (fp1,t1) = [toTextIgnore fp1, t1]+instance CmdArg Text where+ toTextArgs = (: []) -cmd :: (CmdArgs args) => FilePath -> args -> Sh Text-cmd fp args = run fp $ toTextArgs args--}+instance CmdArg String where+ toTextArgs = (: []) . T.pack --- | 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 FilePath where toTextArg = toTextIgnore-instance CmdArg String where toTextArg = T.pack+instance {-# OVERLAPPABLE #-} CmdArg a => CmdArg [a] where+ toTextArgs = concatMap toTextArgs --- | For the variadic function 'cmd'+-- | For the variadic function 'cmd'. ----- partially applied variadic functions require type signatures+-- 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'.+-- | Variadic argument version of 'run'. -- Please see the documenation for 'run'. ----- The syntax is more convenient, but more importantly it also allows the use of a FilePath as a command argument.--- So an argument can be a Text or a FilePath without manual conversions.--- a FilePath is automatically converted to Text with 'toTextIgnore'.+-- The syntax is more convenient, but more importantly+-- it also allows the use of a 'FilePath' as a command argument.+-- So an argument can be a 'Text' or a 'FilePath' without manual conversions.+-- a 'FilePath' is automatically converted to 'Text' with 'toTextIgnore'. -- -- Convenient usage of 'cmd' requires the following: --@@ -228,34 +201,37 @@ cmd :: (ShellCmd result) => FilePath -> result cmd fp = cmdAll fp [] +-- | Convert 'Text' to a 'FilePath'.+fromText :: Text -> FilePath+fromText = T.unpack+ -- | Helper to convert a Text to a FilePath. Used by '(</>)' and '(<.>)' class ToFilePath a where toFilePath :: a -> FilePath instance ToFilePath FilePath where toFilePath = id-instance ToFilePath Text where toFilePath = FP.fromText-instance ToFilePath String where toFilePath = FP.fromText . T.pack+instance ToFilePath Text where toFilePath = T.unpack --- | uses System.FilePath.CurrentOS, but can automatically convert a Text+-- | Uses "System.FilePath", but can automatically convert a 'Text'. (</>) :: (ToFilePath filepath1, ToFilePath filepath2) => filepath1 -> filepath2 -> FilePath x </> y = toFilePath x FP.</> toFilePath y --- | uses System.FilePath.CurrentOS, but can automatically convert a Text+-- | Uses "System.FilePath", but can automatically convert a 'Text'. (<.>) :: (ToFilePath filepath) => filepath -> Text -> FilePath-x <.> y = toFilePath x FP.<.> y+x <.> y = toFilePath x FP.<.> T.unpack y toTextWarn :: FilePath -> Sh Text-toTextWarn efile = case toText efile of- Left f -> encodeError f >> return f- Right f -> return f+toTextWarn efile = do+ when (not $ isValid efile) $ encodeError (T.pack $ makeValid efile)+ return (T.pack $ makeValid efile) where encodeError f = echo ("non-unicode file name: " <> f) -- | Transfer from one handle to another -- For example, send contents of a process output to stdout.--- does not close the write handle.+-- Does not close the write handle. -- -- Also, return the complete contents being streamed line by line. transferLinesAndCombine :: Handle -> (Text -> IO ()) -> IO Text@@ -271,9 +247,9 @@ -- | Transfer from one handle to another -- For example, send contents of a process output to stdout.--- does not close the write handle.+-- Does not close the write handle. ----- Also, fold over the contents being streamed line by line+-- Also, fold over the contents being streamed line by line. transferFoldHandleLines :: a -> FoldCallback a -> Handle -> (Text -> IO ()) -> IO a transferFoldHandleLines start foldLine readHandle putWrite = go start where@@ -299,7 +275,7 @@ Nothing -> return acc Just line -> go $ foldLine acc line --- | same as 'trace', but use it combinator style+-- | Same as 'trace', but for use in combinator style: @action `tag` message@. tag :: Sh a -> Text -> Sh a tag action msg = do trace msg@@ -317,11 +293,11 @@ runCommand :: [StdHandle] -> State -> FilePath -> [Text] -> Sh (Handle, Handle, Handle, ProcessHandle) runCommand handles st exe args = findExe exe >>= \fullExe -> liftIO $ shellyProcess handles st $- RawCommand (encodeString fullExe) (map T.unpack args)+ RawCommand fullExe (map T.unpack args) where findExe :: FilePath -> Sh FilePath findExe-#if defined(mingw32_HOST_OS) || (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 708)+#if defined(mingw32_HOST_OS) fp #else _fp@@ -336,40 +312,32 @@ -- non-Windows < 7.8 has a bug for read-only file systems -- https://github.com/yesodweb/Shelly.hs/issues/56 -- it would be better to specifically detect that bug-#if defined(mingw32_HOST_OS) || (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 708)+#if defined(mingw32_HOST_OS) Left _ -> return fp #else Left err -> liftIO $ throwIO $ userError err #endif -+-- process >= 1.4 is used shellyProcess :: [StdHandle] -> State -> CmdSpec -> IO (Handle, Handle, Handle, ProcessHandle) shellyProcess reusedHandles st cmdSpec = do (createdInH, createdOutH, createdErrorH, pHandle) <- createProcess CreateProcess { cmdspec = cmdSpec- , cwd = Just $ encodeString $ sDirectory st+ , cwd = Just $ sDirectory st , env = Just $ sEnvironment st , std_in = createUnless mInH , std_out = createUnless mOutH , std_err = createUnless mErrorH , close_fds = False-#if MIN_VERSION_process(1,1,0) , create_group = False-#endif-#if MIN_VERSION_process(1,2,0) , delegate_ctlc = False-#endif-#if MIN_VERSION_process(1,3,0) , detach_console = False , create_new_console = False , new_session = False-#endif-#if MIN_VERSION_process(1,4,0) , child_group = Nothing , child_user = Nothing-#endif #if MIN_VERSION_process(1,5,0) , use_process_jobs = False #endif@@ -387,6 +355,7 @@ toHandle (Just (UseHandle h)) = Just h toHandle (Just CreatePipe) = error "shelly process creation failure CreatePipe" toHandle (Just Inherit) = error "cannot access an inherited pipe"+ toHandle (Just NoStream) = error "shelly process creation failure NoStream" toHandle Nothing = error "error in shelly creating process" createUnless Nothing = CreatePipe@@ -459,16 +428,16 @@ toHandler :: (Sh a -> IO a) -> ShellyHandler a -> Handler a toHandler runner (ShellyHandler handler) = Handler (\e -> runner (handler e)) --- | Catch any exception in the Sh monad.+-- | Catch any exception in the 'Sh' monad. catchany_sh :: Sh a -> (SomeException -> Sh a) -> Sh a catchany_sh = catch_sh --- | Handle any exception in the Sh monad.+-- | Handle any exception in the 'Sh' monad. handleany_sh :: (SomeException -> Sh a) -> Sh a -> Sh a handleany_sh = handle_sh --- | Change current working directory of Sh. This does *not* change the--- working directory of the process we are running it. Instead, Sh keeps+-- | Change current working directory of 'Sh'. This does /not/ change the+-- working directory of the process we are running it. Instead, 'Sh' keeps -- track of its own working directory and builds absolute paths internally -- instead of passing down relative paths. cd :: FilePath -> Sh ()@@ -480,84 +449,83 @@ where tdir = toTextIgnore dir --- | 'cd', execute a Sh action in the new directory and then pop back to the original directory+-- | 'cd', execute a 'Sh' action in the new directory+-- and then pop back to the original directory. chdir :: FilePath -> Sh a -> Sh a chdir dir action = do d <- gets sDirectory cd dir action `finally_sh` cd d --- | 'chdir', but first create the directory if it does not exit+-- | 'chdir', but first create the directory if it does not exit. chdir_p :: FilePath -> Sh a -> Sh a chdir_p d action = mkdir_p d >> chdir d action --- | apply a String IO operations to a Text FilePath-{--liftStringIO :: (String -> IO String) -> FilePath -> Sh FilePath-liftStringIO f = liftIO . f . unpack >=> return . pack---- | @asString f = pack . f . unpack@-asString :: (String -> String) -> FilePath -> FilePath-asString f = pack . f . unpack--}- pack :: String -> FilePath-pack = decodeString+pack = id -- | Move a file. The second path could be a directory, in which case the -- original file is moved into that directory.--- wraps system-fileio 'FileSystem.rename', which may not work across FS boundaries+-- wraps directory 'System.Directory.renameFile', which may not work across FS boundaries mv :: FilePath -> FilePath -> Sh () mv from' to' = do trace $ "mv " <> toTextIgnore from' <> " " <> toTextIgnore to' from <- absPath from'+ from_dir <- test_d from to <- absPath to' to_dir <- test_d to- let to_loc = if not to_dir then to else to FP.</> filename from- liftIO $ rename from to_loc- `catchany` (\e -> throwIO $- ReThrownException e (extraMsg to_loc from)- )+ let to_loc = if not to_dir then to else to FP.</> (FP.takeFileName from)+ liftIO $ createDirectoryIfMissing True (takeDirectory to_loc)+ if not from_dir+ then liftIO $ renameFile from to_loc+ `catchany` (\e -> throwIO $+ ReThrownException e (extraMsg to_loc from)+ )+ else liftIO $ renameDirectory from to_loc+ `catchany` (\e -> throwIO $+ ReThrownException e (extraMsg to_loc from)+ ) where- extraMsg t f = "during copy from: " ++ encodeString f ++ " to: " ++ encodeString t+ extraMsg :: String -> String -> String+ extraMsg t f = "during copy from: " ++ f ++ " to: " ++ t --- | Get back [Text] instead of [FilePath]+-- | Get back @[Text]@ instead of @[FilePath]@. lsT :: FilePath -> Sh [Text] lsT = ls >=> mapM toTextWarn --- | Obtain the current (Sh) working directory.+-- | Obtain the current 'Sh' working directory. pwd :: Sh FilePath pwd = gets sDirectory `tag` "pwd" --- | exit 0 means no errors, all other codes are error conditions+-- | @'exit' 0@ means no errors, all other codes are error conditions. exit :: Int -> Sh a exit 0 = liftIO exitSuccess `tag` "exit 0" exit n = liftIO (exitWith (ExitFailure n)) `tag` ("exit " <> T.pack (show n)) --- | echo a message and exit with status 1+-- | Echo a message and 'exit' with status 1. errorExit :: Text -> Sh a errorExit msg = echo msg >> exit 1 --- | for exiting with status > 0 without printing debug information+-- | For exiting with status > 0 without printing debug information. quietExit :: Int -> Sh a quietExit 0 = exit 0 quietExit n = throw $ QuietExit n --- | fail that takes a Text+-- | 'fail' that takes a 'Text'. terror :: Text -> Sh a terror = fail . T.unpack -- | Create a new directory (fails if the directory exists). mkdir :: FilePath -> Sh () mkdir = traceAbsPath ("mkdir " <>) >=>- liftIO . createDirectory False+ liftIO . createDirectoryIfMissing False -- | Create a new directory, including parents (succeeds if the directory -- already exists). mkdir_p :: FilePath -> Sh () mkdir_p = traceAbsPath ("mkdir -p " <>) >=>- liftIO . createTree+ liftIO . createDirectoryIfMissing True -- | Create a new directory tree. You can describe a bunch of directories as -- a tree and this function will create all subdirectories. An example:@@ -588,7 +556,7 @@ isExecutable :: FilePath -> IO Bool-isExecutable f = (executable `fmap` getPermissions (encodeString f)) `catch` (\(_ :: IOError) -> return False)+isExecutable f = (executable `fmap` getPermissions f) `catch` (\(_ :: IOError) -> return False) -- | Get a full path to an executable by looking at the @PATH@ environement -- variable. Windows normally looks in additional places besides the@@ -602,9 +570,9 @@ whichEith :: FilePath -> Sh (Either String FilePath) whichEith originalFp = whichFull #if defined(mingw32_HOST_OS)- $ case extension originalFp of- Nothing -> originalFp <.> "exe"- Just _ -> originalFp+ $ case takeExtension originalFp of+ "" -> originalFp <.> "exe"+ _ -> originalFp #else originalFp #endif@@ -612,20 +580,38 @@ whichFull fp = do (trace . mappend "which " . toTextIgnore) fp >> whichUntraced where- whichUntraced | absolute fp = checkFile- | dotSlash splitOnDirs = checkFile- | length splitOnDirs > 0 = lookupPath >>= leftPathError- | otherwise = lookupCache >>= leftPathError+ whichUntraced | isAbsolute fp = checkFile+ | startsWithDot splitOnDirs = checkFile+ | otherwise = lookupPath >>= leftPathError splitOnDirs = splitDirectories fp- dotSlash ("./":_) = True- dotSlash _ = False + -- 'startsWithDot' receives as input the result of 'splitDirectories',+ -- which will include the dot (\".\") as its first element only if this+ -- is a path of the form \"./foo/bar/baz.sh\". Check for example:+ --+ -- > import System.FilePath as FP+ -- > FP.splitDirectories "./test/data/hello.sh"+ -- [".","test","data","hello.sh"]+ -- > FP.splitDirectories ".hello.sh"+ -- [".hello.sh"]+ -- > FP.splitDirectories ".test/hello.sh"+ -- [".test","hello.sh"]+ -- > FP.splitDirectories ".foo"+ -- [".foo"]+ --+ -- Note that earlier versions of Shelly used+ -- \"system-filepath\" which also has a 'splitDirectories'+ -- function, but it returns \"./\" as its first argument,+ -- so we pattern match on both for backward-compatibility.+ startsWithDot (".":_) = True+ startsWithDot _ = False+ checkFile :: Sh (Either String FilePath) checkFile = do- exists <- liftIO $ isFile fp+ exists <- liftIO $ doesFileExist fp return $ if exists then Right fp else- Left $ "did not find file: " <> encodeString fp+ Left $ "did not find file: " <> fp leftPathError :: Maybe FilePath -> Sh (Either String FilePath) leftPathError Nothing = Left <$> pathLookupError@@ -635,7 +621,7 @@ pathLookupError = do pATH <- get_env_text "PATH" return $- "shelly did not find " `mappend` encodeString fp `mappend`+ "shelly did not find " `mappend` fp `mappend` " in the PATH: " `mappend` T.unpack pATH lookupPath :: Sh (Maybe FilePath)@@ -644,32 +630,7 @@ res <- liftIO $ isExecutable fullFp return $ if res then Just fullFp else Nothing - lookupCache :: Sh (Maybe FilePath)- lookupCache = do- pathExecutables <- cachedPathExecutables- return $ fmap (flip (</>) fp . fst) $- L.find (S.member fp . snd) pathExecutables--- pathDirs = mapM absPath =<< ((map FP.fromText . filter (not . T.null) . T.split (== searchPathSeparator)) `fmap` get_env_text "PATH")-- cachedPathExecutables :: Sh [(FilePath, S.Set FilePath)]- cachedPathExecutables = do- mPathExecutables <- gets sPathExecutables- case mPathExecutables of- Just pExecutables -> return pExecutables- Nothing -> do- dirs <- pathDirs- executables <- forM dirs (\dir -> do- files <- (liftIO . listDirectory) dir `catch_sh` (\(_ :: IOError) -> return [])- exes <- fmap (map snd) $ liftIO $ filterM (isExecutable . fst) $- map (\f -> (f, filename f)) files- return $ S.fromList exes- )- let cachedExecutables = zip dirs executables- modify $ \x -> x { sPathExecutables = Just cachedExecutables }- return $ cachedExecutables-+ pathDirs = mapM absPath =<< ((map T.unpack . filter (not . T.null) . T.split (== searchPathSeparator)) `fmap` get_env_text "PATH") -- | A monadic findMap, taken from MissingM package findMapM :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b)@@ -688,12 +649,12 @@ test_e :: FilePath -> Sh Bool test_e = absPath >=> \f -> liftIO $ do- file <- isFile f- if file then return True else isDirectory f+ file <- doesFileExist f+ if file then return True else doesDirectoryExist f -- | Does a path point to an existing file? test_f :: FilePath -> Sh Bool-test_f = absPath >=> liftIO . isFile+test_f = absPath >=> liftIO . doesFileExist -- | Test that a file is in the PATH and also executable test_px :: FilePath -> Sh Bool@@ -706,17 +667,17 @@ -- | A swiss army cannon for removing things. Actually this goes farther than a -- normal rm -rf, as it will circumvent permission problems for the files we -- own. Use carefully.--- Uses 'removeTree'+-- Uses 'removeDirectoryRecursive' rm_rf :: FilePath -> Sh () rm_rf infp = do f <- traceAbsPath ("rm -rf " <>) infp isDir <- (test_d f) if not isDir then whenM (test_f f) $ rm_f f else- (liftIO_ $ removeTree f) `catch_sh` (\(e :: IOError) ->+ (liftIO_ $ removeDirectoryRecursive f) `catch_sh` (\(e :: IOError) -> when (isPermissionError e) $ do- find f >>= mapM_ (\file -> liftIO_ $ fixPermissions (encodeString file) `catchany` \_ -> return ())- liftIO $ removeTree f+ find f >>= mapM_ (\file -> liftIO_ $ fixPermissions file `catchany` \_ -> return ())+ liftIO $ removeDirectoryRecursive f ) where fixPermissions file = do permissions <- liftIO $ getPermissions file@@ -733,7 +694,7 @@ -- Does fail if the file does not exist (use 'rm_f' instead) or is not a file. rm :: FilePath -> Sh () rm = traceAbsPath ("rm " <>) >=>- -- TODO: better error message for removeFile (give filename)+ -- TODO: better error message for removeFile (give takeFileName) liftIO . removeFile -- | Set an environment variable. The environment is maintained in Sh@@ -744,7 +705,8 @@ setenvRaw :: Text -> Text -> Sh () setenvRaw k v = modify $ \x -> x { sEnvironment = wibble $ sEnvironment x } where- (kStr, vStr) = (T.unpack k, T.unpack v)+ normK = normalizeEnvVarNameText k+ (kStr, vStr) = (T.unpack normK, T.unpack v) wibble environment = (kStr, vStr) : filter ((/=kStr) . fst) environment setPath :: Text -> Sh ()@@ -753,17 +715,17 @@ setenvRaw path_env newPath path_env :: Text-path_env = "PATH"+path_env = normalizeEnvVarNameText "PATH" --- | add the filepath onto the PATH env variable+-- | Add the filepath onto the PATH env variable. appendToPath :: FilePath -> Sh () appendToPath = traceAbsPath ("appendToPath: " <>) >=> \filepath -> do tp <- toTextWarn filepath pe <- get_env_text path_env setPath $ pe <> T.singleton searchPathSeparator <> tp --- | prepend the filepath to the PATH env variable--- similar to `appendToPath` but gives high priority to the filepath instead of low priority.+-- | Prepend the filepath to the PATH env variable.+-- Similar to 'appendToPath' but gives high priority to the filepath instead of low priority. prependToPath :: FilePath -> Sh () prependToPath = traceAbsPath ("prependToPath: " <>) >=> \filepath -> do tp <- toTextWarn filepath@@ -774,20 +736,34 @@ get_environment = gets sEnvironment {-# DEPRECATED get_environment "use get_env_all" #-} --- | get the full environment+-- | Get the full environment. get_env_all :: Sh [(String, String)] get_env_all = gets sEnvironment +normalizeEnvVarNameText :: Text -> Text+#if defined(mingw32_HOST_OS)+-- On Windows, normalize all environment variable names (to lowercase)+-- to account for case insensitivity.+normalizeEnvVarNameText = T.toLower+#else+-- On other systems, keep the variable names as-is.+normalizeEnvVarNameText = id+#endif+ -- | Fetch the current value of an environment variable.--- if non-existant or empty text, will be Nothing+-- If non-existant or empty text, will be 'Nothing'. get_env :: Text -> Sh (Maybe Text) get_env k = do- mval <- return . fmap T.pack . lookup (T.unpack k) =<< gets sEnvironment+ mval <- return+ . fmap T.pack+ . lookup (T.unpack normK)+ =<< gets sEnvironment return $ case mval of Nothing -> Nothing Just val -> if (not $ T.null val) then Just val else Nothing+ where+ normK = normalizeEnvVarNameText k --- | deprecated getenv :: Text -> Sh Text getenv k = get_env_def k "" {-# DEPRECATED getenv "use get_env or get_env_text" #-}@@ -798,16 +774,16 @@ get_env_text = get_env_def "" -- | Fetch the current value of an environment variable. Both empty and--- non-existent variables give the default Text value as a result+-- non-existent variables give the default 'Text' value as a result. get_env_def :: Text -> Text -> Sh Text get_env_def d = get_env >=> return . fromMaybe d {-# DEPRECATED get_env_def "use fromMaybe DEFAULT get_env" #-} --- | Apply a single initializer to the two output process handles (stdout and stderr)+-- | Apply a single initializer to the two output process handles (stdout and stderr). initOutputHandles :: HandleInitializer -> StdInit initOutputHandles f = StdInit (const $ return ()) f f --- | Apply a single initializer to all three standard process handles (stdin, stdout and stderr)+-- | Apply a single initializer to all three standard process handles (stdin, stdout and stderr). initAllHandles :: HandleInitializer -> StdInit initAllHandles f = StdInit f f f @@ -873,6 +849,13 @@ print_commands :: Bool -> Sh a -> Sh a print_commands shouldPrint a = sub $ modify (\st -> st { sPrintCommands = shouldPrint }) >> a ++-- | Create a sub-Sh in which commands are sent to the user-defined function.+--+-- @since 1.12.1+print_commands_with :: (Text -> IO ()) -> Sh a -> Sh a+print_commands_with fn a = sub $ modify (\st -> st { sPrintCommandsFn = fn }) >> a+ -- | Enter a sub-Sh that inherits the environment -- The original state will be restored when the sub-Sh completes. -- Exceptions are propagated normally.@@ -895,8 +878,8 @@ } -- | Create a sub-Sh where commands are not traced--- Defaults to True.--- You should only set to False temporarily for very specific reasons+-- Defaults to @True@.+-- You should only set to @False@ temporarily for very specific reasons. tracing :: Bool -> Sh a -> Sh a tracing shouldTrace action = sub $ do modify $ \st -> st { sTracing = shouldTrace }@@ -946,6 +929,17 @@ shellyFailDir :: MonadIO m => Sh a -> m a shellyFailDir = shelly' ReadOnlyState { rosFailToDir = True } +getNormalizedEnvironment :: IO [(String, String)]+getNormalizedEnvironment =+#if defined(mingw32_HOST_OS)+ -- On Windows, normalize all environment variable names (to lowercase)+ -- to account for case insensitivity.+ fmap (\(a, b) -> (map toLower a, b)) <$> getEnvironment+#else+ -- On other systems, keep the environment as-is.+ getEnvironment+#endif+ -- | Enter a Sh from (Monad)IO. The environment and working directories are -- inherited from the current process-wide values. Any subsequent changes in -- processwide working directory or environment are not reflected in the@@ -955,8 +949,8 @@ shelly' :: MonadIO m => ReadOnlyState -> Sh a -> m a shelly' ros action = do- environment <- liftIO getEnvironment- dir <- liftIO getWorkingDirectory+ environment <- liftIO getNormalizedEnvironment+ dir <- liftIO getCurrentDirectory let def = State { sCode = 0 , sStdin = Nothing , sStderr = T.empty@@ -965,6 +959,7 @@ , sPrintStdout = True , sPrintStderr = True , sPrintCommands = False+ , sPrintCommandsFn = TIO.hPutStrLn stdout , sInitCommandHandles = initAllHandles (const $ return ()) , sCommandEscaping = True , sEnvironment = environment@@ -998,7 +993,7 @@ d <- pwd sf <- shellyFile let logFile = d</>shelly_dir</>sf- (writefile logFile trc >> return ("log of commands saved to: " <> encodeString logFile))+ (writefile logFile trc >> return ("log of commands saved to: " <> logFile)) `catchany_sh` (\_ -> ranCommands) where@@ -1012,7 +1007,7 @@ nextNum :: [FilePath] -> Int nextNum [] = 1- nextNum fs = (+ 1) . maximum . map (readDef 1 . filter isDigit . encodeString . filename) $ fs+ nextNum fs = (+ 1) . maximum . map (readDef 1 . filter isDigit . takeFileName) $ fs -- from safe package readDef :: Read a => a -> String -> a@@ -1023,7 +1018,7 @@ [x] -> Just x _ -> Nothing -data RunFailed = RunFailed FilePath [Text] Int Text deriving (Typeable)+data RunFailed = RunFailed FilePath [Text] Int Text instance Show RunFailed where show (RunFailed exe args code errs) =@@ -1037,43 +1032,74 @@ show_command :: FilePath -> [Text] -> Text show_command exe args =- T.intercalate " " $ map quote (toTextIgnore exe : args)- where- quote t | T.any (== '\'') t = t- quote t | T.any isSpace t = surround '\'' t- quote t | otherwise = t+ let escape char | char `Set.member` specialsInQuotes = T.pack ['\\', char]+ escape char = T.singleton char+ quote arg = surround '"' $ T.concatMap escape arg+ isSafe c = all ($ c) [isPrint, not . isSpace, (`Set.notMember` specials)]+ showArg "" = surround '"' ""+ showArg arg | T.all isSafe arg = arg+ showArg arg = quote arg+ in T.intercalate " " $ map showArg (toTextIgnore exe : args) +-- | Characters that need to be escaped or quoted to retain their literal value.+specials :: Set.Set Char+specials = Set.fromList "\\'\"`$&|;(){}<>"++-- | When inside quotes, characters that need to be escaped to retain their+-- literal value.+specialsInQuotes :: Set.Set Char+specialsInQuotes = Set.fromList "\\\"`$"++-- quote one argument+quoteOne :: Text -> Text+quoteOne t =+ surround '\'' $ T.replace "'" "'\\''" t+++-- returns a string that can be executed by a shell.+-- NOTE: all parts are treated literally, which means that+-- things like variable expansion will not be available.+quoteCommand :: FilePath -> [Text] -> Text+quoteCommand exe args =+ T.intercalate " " $ map quoteOne (toTextIgnore exe : args)+ surround :: Char -> Text -> Text surround c t = T.cons c $ T.snoc t c data SshMode = ParSsh | SeqSsh --- | same as 'sshPairs', but returns ()+-- | Same as 'sshPairs', but returns @()@. sshPairs_ :: Text -> [(FilePath, [Text])] -> Sh () sshPairs_ _ [] = return () sshPairs_ server cmds = sshPairs' run_ server cmds --- | same as 'sshPairsP', but returns ()-+-- | Same as 'sshPairsPar', but returns @()@. sshPairsPar_ :: Text -> [(FilePath, [Text])] -> Sh () sshPairsPar_ _ [] = return () sshPairsPar_ server cmds = sshPairsPar' run_ server cmds --- | run commands over SSH.--- An ssh executable is expected in your path.+-- | Run commands over SSH.+-- An @ssh@ executable is expected in your path. -- Commands are in the same form as 'run', but given as pairs -- -- > sshPairs "server-name" [("cd", "dir"), ("rm",["-r","dir2"])] -- -- This interface is crude, but it works for now. ----- Please note this sets 'escaping' to False: the commands will not be shell escaped.--- Internally the list of commands are combined with the string @&&@ before given to ssh.+-- Please note this sets 'escaping' to False, and the remote commands are+-- quoted with single quotes, in a way such that the remote commands will see+-- the literal values you passed, this means that no variable expansion and+-- alike will done on either the local shell or the remote shell, and that+-- if there are a single or double quotes in your arguments, they need not+-- to be quoted manually.+--+-- Internally the list of commands are combined with the string @&&@ before given to @ssh@. sshPairs :: Text -> [(FilePath, [Text])] -> Sh Text sshPairs _ [] = return "" sshPairs server cmds = sshPairsWithOptions' run server [] cmds SeqSsh --- | Same as sshPairs, but combines commands with the string @&@, so they will be started in parallell.+-- | Same as 'sshPairs', but combines commands with the string @&@,+-- so they will be started in parallel. sshPairsPar :: Text -> [(FilePath, [Text])] -> Sh Text sshPairsPar _ [] = return "" sshPairsPar server cmds = sshPairsWithOptions' run server [] cmds ParSsh@@ -1084,9 +1110,9 @@ sshPairs' :: (FilePath -> [Text] -> Sh a) -> Text -> [(FilePath, [Text])] -> Sh a sshPairs' run' server actions = sshPairsWithOptions' run' server [] actions SeqSsh --- | Like 'sshPairs', but allows for arguments to the call to ssh.+-- | Like 'sshPairs', but allows for arguments to the call to @ssh@. sshPairsWithOptions :: Text -- ^ Server name.- -> [Text] -- ^ Arguments to ssh (e.g. ["-p","22"]).+ -> [Text] -- ^ Arguments to @ssh@ (e.g. @["-p","22"]@). -> [(FilePath, [Text])] -- ^ Pairs of commands to run on the remote. -> Sh Text -- ^ Returns the standard output. sshPairsWithOptions _ _ [] = return ""@@ -1098,18 +1124,17 @@ sshCommandText :: [(FilePath, [Text])] -> SshMode -> Text sshCommandText actions mode =- surround '"' (foldl1 joiner (map toSSH actions))+ quoteOne (foldl1 joiner (map (uncurry quoteCommand) actions)) where- toSSH (exe,args) = show_command exe args joiner memo next = case mode of SeqSsh -> memo <> " && " <> next ParSsh -> memo <> " & " <> next -data QuietExit = QuietExit Int deriving (Show, Typeable)+data QuietExit = QuietExit Int deriving (Show) instance Exception QuietExit -- | Shelly's wrapper around exceptions thrown in its monad-data ReThrownException e = ReThrownException e String deriving (Typeable)+data ReThrownException e = ReThrownException e String instance Exception e => Exception (ReThrownException e) instance Exception e => Show (ReThrownException e) where show (ReThrownException ex msg) = "\n" ++@@ -1123,7 +1148,7 @@ -- -- 'stdout' and 'stderr' are collected. The 'stdout' is returned as -- a result of 'run', and complete stderr output is available after the fact using--- 'lastStderr'+-- 'lastStderr'. If the output does not end with a newline, it is automatically added. -- -- All of the stdout output will be loaded into memory. -- You can avoid this if you don't need stdout by using 'run_',@@ -1138,12 +1163,12 @@ -- given, Shelly cannot look in the @PATH@ for it. -- a @PATH@ modified by setenv is not taken into account when finding the exe name. -- Instead the original Haskell program @PATH@ is used.--- On a Posix system the @env@ command can be used to make the 'setenv' PATH used when 'escaping' is set to False. @env echo hello@ instead of @echo hello@+-- On a Posix system the @env@ command can be used to make the 'setenv' PATH used when 'escaping' is set to False. @env echo hello@ instead of @echo hello@. -- run :: FilePath -> [Text] -> Sh Text run fp args = return . lineSeqToText =<< runFoldLines mempty (|>) fp args --- | Like `run`, but it invokes the user-requested program with _bash_.+-- | Like 'run', but it invokes the user-requested program with @bash@. bash :: FilePath -> [Text] -> Sh Text bash fp args = escaping False $ run "bash" $ bashArgs fp args @@ -1155,40 +1180,42 @@ where sanitise = T.replace "'" "\'" . T.intercalate " " --- | Use this with `bash` to set _pipefail_+-- | Use this with 'bash' to set @pipefail@. -- -- > bashPipeFail $ bash "echo foo | echo" bashPipeFail :: (FilePath -> [Text] -> Sh a) -> FilePath -> [Text] -> Sh a bashPipeFail runner fp args = runner "set -o pipefail;" (toTextIgnore fp : args) --- | bind some arguments to run for re-use. Example:+-- | Bind some arguments to 'run' for re-use. Example: -- -- > monit = command "monit" ["-c", "monitrc"] -- > monit ["stop", "program"] command :: FilePath -> [Text] -> [Text] -> Sh Text command com args more_args = run com (args ++ more_args) --- | bind some arguments to 'run_' for re-use. Example:+-- | Bind some arguments to 'run_' for re-use. Example: -- -- > monit_ = command_ "monit" ["-c", "monitrc"] -- > monit_ ["stop", "program"] command_ :: FilePath -> [Text] -> [Text] -> Sh () command_ com args more_args = run_ com (args ++ more_args) --- | bind some arguments to run for re-use, and require 1 argument. Example:+-- | Bind some arguments to 'run' for re-use, and require 1 argument. Example: ----- > git = command1 "git" []; git "pull" ["origin", "master"]+-- > git = command1 "git" []+-- > git "pull" ["origin", "master"] command1 :: FilePath -> [Text] -> Text -> [Text] -> Sh Text command1 com args one_arg more_args = run com (args ++ [one_arg] ++ more_args) --- | bind some arguments to run for re-use, and require 1 argument. Example:+-- | Bind some arguments to 'run_' for re-use, and require 1 argument. Example: ----- > git_ = command1_ "git" []; git "pull" ["origin", "master"]+-- > git_ = command1_ "git" []+-- > git "pull" ["origin", "master"] command1_ :: FilePath -> [Text] -> Text -> [Text] -> Sh () command1_ com args one_arg more_args = run_ com (args ++ [one_arg] ++ more_args) --- | the same as 'run', but return @()@ instead of the stdout content--- stdout will be read and discarded line-by-line+-- | The same as 'run', but return @()@ instead of the stdout content.+-- The stdout will be read and discarded line-by-line. run_ :: FilePath -> [Text] -> Sh () run_ exe args = do state <- get@@ -1213,9 +1240,9 @@ -- | Similar to 'run' but gives the raw stdout handle in a callback. -- If you want even more control, use 'runHandles'.-runHandle :: FilePath -- ^ command- -> [Text] -- ^ arguments- -> (Handle -> Sh a) -- ^ stdout handle+runHandle :: FilePath -- ^ Command.+ -> [Text] -- ^ Arguments.+ -> (Handle -> Sh a) -- ^ 'stdout' handle. -> Sh a runHandle exe args withHandle = runHandles exe args [] $ \_ outH errH -> do state <- get@@ -1229,13 +1256,14 @@ -- | Similar to 'run' but gives direct access to all input and output handles. -- -- Be careful when using the optional input handles.--- If you specify Inherit for a handle then attempting to access the handle in your--- callback is an error-runHandles :: FilePath -- ^ command- -> [Text] -- ^ arguments- -> [StdHandle] -- ^ optionally connect process i/o handles to existing handles- -> (Handle -> Handle -> Handle -> Sh a) -- ^ stdin, stdout and stderr- -> Sh a+-- If you specify 'Inherit' for a handle then attempting to access the handle in your+-- callback is an error.+runHandles+ :: FilePath -- ^ Command.+ -> [Text] -- ^ Arguments.+ -> [StdHandle] -- ^ Optionally connect process i/o handles to existing handles.+ -> (Handle -> Handle -> Handle -> Sh a) -- ^ 'stdin', 'stdout' and 'stderr'.+ -> Sh a runHandles exe args reusedHandles withHandles = do -- clear stdin before beginning command execution origstate <- get@@ -1244,7 +1272,7 @@ state <- get let cmdString = show_command exe args- when (sPrintCommands state) $ echo cmdString+ when (sPrintCommands state) $ echoWith (sPrintCommandsFn state) cmdString trace cmdString let doRun = if sCommandEscaping state then runCommand else runCommandNoEscape@@ -1287,8 +1315,8 @@ ) --- | used by 'run'. fold over stdout line-by-line as it is read to avoid keeping it in memory--- stderr is still being placed in memory under the assumption it is always relatively small+-- | Used by 'run'. Folds over 'stdout' line-by-line as it is read to avoid keeping it in memory.+-- 'stderr' is still being placed in memory under the assumption it is always relatively small. runFoldLines :: a -> FoldCallback a -> FilePath -> [Text] -> Sh a runFoldLines start cb exe args = runHandles exe args [] $ \inH outH errH -> do@@ -1303,11 +1331,12 @@ liftIO $ wait outVar -putHandleIntoMVar :: a -> FoldCallback a- -> Handle -- ^ out handle- -> (Text -> IO ()) -- ^ in handle- -> Bool -- ^ should it be printed while transfered?- -> IO (Async a)+putHandleIntoMVar+ :: a -> FoldCallback a+ -> Handle -- ^ Out handle.+ -> (Text -> IO ()) -- ^ In handle.+ -> Bool -- ^ Should it be printed while transfered?+ -> IO (Async a) putHandleIntoMVar start cb outH putWrite shouldPrint = liftIO $ async $ do if shouldPrint then transferFoldHandleLines start cb outH putWrite@@ -1323,11 +1352,11 @@ lastExitCode :: Sh Int lastExitCode = gets sCode --- | set the stdin to be used and cleared by the next 'run'.+-- | Set the 'stdin' to be used and cleared by the next 'run'. setStdin :: Text -> Sh () setStdin input = modify $ \st -> st { sStdin = Just input } --- | Pipe operator. set the stdout the first command as the stdin of the second.+-- | Pipe operator. Set the 'stdout' the first command as the 'stdin' of the second. -- This does not create a shell-level pipe, but hopefully it will in the future. -- To create a shell level pipe you can set @escaping False@ and use a pipe @|@ character in a command. (-|-) :: Sh Text -> Sh b -> Sh b@@ -1337,43 +1366,55 @@ two -- | Copy a file, or a directory recursively.--- uses 'cp'+-- Uses 'cp'. cp_r :: FilePath -> FilePath -> Sh () cp_r from' to' = do from <- absPath from' fromIsDir <- (test_d from)- if not fromIsDir then cp from' to' else do- trace $ "cp -r " <> toTextIgnore from <> " " <> toTextIgnore to'+ if not fromIsDir then cp_should_follow_symlinks False from' to' else do+ trace $ "cp_r " <> toTextIgnore from <> " " <> toTextIgnore to' to <- absPath to' toIsDir <- test_d to when (from == to) $ liftIO $ throwIO $ userError $ show $ "cp_r: " <> toTextIgnore from <> " and " <> toTextIgnore to <> " are identical" - finalTo <- if not toIsDir then mkdir to >> return to else do- let d = to </> dirname (addTrailingSlash from)- mkdir_p d >> return d-- ls from >>= mapM_ (\item -> cp_r (from FP.</> filename item) (finalTo FP.</> filename item))+ finalTo <- if not toIsDir then do+ mkdir to+ return to+ else do+ -- this takes the name of the from directory+ -- because filepath has no builtin function like `dirname`+ let d = to </> (last . splitPath $ takeDirectory (addTrailingPathSeparator from))+ mkdir_p d >> return d+ ls from >>= mapM_ (\item -> do+ cp_r (from FP.</> takeFileName item) (finalTo FP.</> takeFileName item)) -- | Copy a file. The second path could be a directory, in which case the -- original file name is used, in that directory. cp :: FilePath -> FilePath -> Sh ()-cp from' to' = do+cp = cp_should_follow_symlinks True++cp_should_follow_symlinks :: Bool -> FilePath -> FilePath -> Sh ()+cp_should_follow_symlinks shouldFollowSymlinks from' to' = do from <- absPath from' to <- absPath to' trace $ "cp " <> toTextIgnore from <> " " <> toTextIgnore to to_dir <- test_d to- let to_loc = if to_dir then to FP.</> filename from else to- liftIO $ copyFile from to_loc `catchany` (\e -> throwIO $- ReThrownException e (extraMsg to_loc from)- )+ let to_loc = if to_dir then to FP.</> takeFileName from else to+ if shouldFollowSymlinks then copyNormal from to_loc else do+ isSymlink <- liftIO $ pathIsSymbolicLink from+ if not isSymlink then copyNormal from to_loc else do+ target <- liftIO $ getSymbolicLinkTarget from+ liftIO $ createFileLink target to_loc where- extraMsg t f = "during copy from: " ++ encodeString f ++ " to: " ++ encodeString t--+ extraMsg :: String -> String -> String+ extraMsg t f = "during copy from: " ++ f ++ " to: " ++ t+ copyNormal from to = liftIO $ copyFile from to `catchany` (\e -> throwIO $+ ReThrownException e (extraMsg to from)+ ) --- | Create a temporary directory and pass it as a parameter to a Sh+-- | Create a temporary directory and pass it as a parameter to a 'Sh' -- computation. The directory is nuked afterwards. withTmpDir :: (FilePath -> Sh a) -> Sh a withTmpDir act = do@@ -1387,43 +1428,43 @@ mkdir p act p `finally_sh` rm_rf p --- | Write a Text to a file.+-- | Write a 'Text' to a file. writefile :: FilePath -> Text -> Sh () writefile f' bits = do f <- traceAbsPath ("writefile " <>) f'- liftIO (TIO.writeFile (encodeString f) bits)+ liftIO (TIO.writeFile f bits) writeBinary :: FilePath -> ByteString -> Sh () writeBinary f' bytes = do f <- traceAbsPath ("writeBinary " <>) f'- liftIO (BS.writeFile (encodeString f) bytes)+ liftIO (BS.writeFile f bytes) -- | Update a file, creating (a blank file) if it does not exist. touchfile :: FilePath -> Sh () touchfile = traceAbsPath ("touch " <>) >=> flip appendfile "" --- | Append a Text to a file.+-- | Append a 'Text' to a file. appendfile :: FilePath -> Text -> Sh () appendfile f' bits = do f <- traceAbsPath ("appendfile " <>) f'- liftIO (TIO.appendFile (encodeString f) bits)+ liftIO (TIO.appendFile f bits) readfile :: FilePath -> Sh Text readfile = traceAbsPath ("readfile " <>) >=> \fp -> readBinary fp >>= return . TE.decodeUtf8With TE.lenientDecode --- | wraps ByteSting readFile+-- | Wraps 'BS.readFile'. readBinary :: FilePath -> Sh ByteString readBinary = traceAbsPath ("readBinary " <>)- >=> liftIO . BS.readFile . encodeString+ >=> liftIO . BS.readFile --- | flipped hasExtension for Text+-- | Flipped 'hasExtension' for 'Text'. hasExt :: Text -> FilePath -> Bool-hasExt = flip hasExtension+hasExt ext fp = T.pack (FP.takeExtension fp) == ext --- | Run a Sh computation and collect timing information.--- The value returned is the amount of _real_ time spent running the computation+-- | Run a 'Sh' computation and collect timing information.+-- The value returned is the amount of *real* time spent running the computation -- in seconds, as measured by the system clock. -- The precision is determined by the resolution of `getCurrentTime`. time :: Sh a -> Sh (Double, a)@@ -1434,11 +1475,11 @@ t' <- liftIO getCurrentTime return (realToFrac $ diffUTCTime t' t, res) --- | threadDelay wrapper that uses seconds+-- | 'threadDelay' wrapper that uses seconds. sleep :: Int -> Sh () sleep = liftIO . threadDelay . (1000 * 1000 *) --- | spawn an asynchronous action with a copy of the current state+-- | Spawn an asynchronous action with a copy of the current state. asyncSh :: Sh a -> Sh (Async a) asyncSh proc = do state <- get
src/Shelly/Base.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -6,10 +7,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE DeriveDataTypeable #-}--- | I started exposing multiple module (starting with one for finding)--- Base prevented circular dependencies--- However, Shelly went back to exposing a single module+{-# LANGUAGE InstanceSigs#-}+ module Shelly.Base ( Sh(..), ShIO, runSh, State(..), ReadOnlyState(..), StdHandle(..),@@ -20,7 +19,7 @@ unpack, gets, get, modify, trace, ls, lsRelAbs, toTextIgnore,- echo, echo_n, echo_err, echo_n_err, inspect, inspect_err,+ echo, echo_n, echo_err, echo_n_err, echoWith, inspect, inspect_err, catchany, liftIO, (>=>), eitherRelativeTo, relativeTo, maybeRelativeTo,@@ -29,29 +28,24 @@ , addTrailingSlash ) where -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706-import Prelude hiding (FilePath, catch)-#else-import Prelude hiding (FilePath)-#endif- import Data.Text (Text)-import System.Process( ProcessHandle, StdStream(..) )+import System.Process( StdStream(..) ) import System.IO ( Handle, hFlush, stderr, stdout ) -import Control.Monad (when, (>=>),- liftM- )+import Control.Monad ( when, (>=>) )+#if !MIN_VERSION_base(4,13,0)+import Control.Monad.Fail (MonadFail)+import Control.Applicative (Applicative, (<$>))+import Data.Monoid (mappend)+#endif import Control.Monad.Base import Control.Monad.Trans.Control-import Control.Applicative (Applicative, (<$>))-import Filesystem (isDirectory, listDirectory)+import System.Directory( doesDirectoryExist, listDirectory) import System.PosixCompat.Files( getSymbolicLinkStatus, isSymbolicLink )-import Filesystem.Path.CurrentOS (FilePath, encodeString, relative)-import qualified Filesystem.Path.CurrentOS as FP-import qualified Filesystem as FS+import System.FilePath ( isRelative)+import qualified System.FilePath as FP+import qualified System.Directory as FS import Data.IORef (readIORef, modifyIORef, IORef)-import Data.Monoid (mappend) import qualified Data.Text as T import qualified Data.Text.IO as TIO import Control.Exception (SomeException, catch, throwIO, Exception)@@ -61,7 +55,6 @@ import Control.Monad.Reader.Class (MonadReader, ask) import Control.Monad.Trans.Reader (runReaderT, ReaderT(..)) import qualified Data.Set as S-import Data.Typeable (Typeable) -- | ShIO is Deprecated in favor of 'Sh', which is easier to type. type ShIO a = Sh a@@ -69,7 +62,7 @@ newtype Sh a = Sh { unSh :: ReaderT (IORef State) IO a- } deriving (Applicative, Monad, MonadIO, MonadReader (IORef State), Functor)+ } deriving (Applicative, Monad, MonadFail, MonadIO, MonadReader (IORef State), Functor, Catch.MonadMask) instance MonadBase IO Sh where liftBase = Sh . ReaderT . const@@ -96,13 +89,6 @@ catch (Sh (ReaderT m)) c = Sh $ ReaderT $ \r -> m r `Catch.catch` \e -> runSh (c e) r -instance Catch.MonadMask Sh where- mask a = Sh $ ReaderT $ \e -> Catch.mask $ \u -> runSh (a $ q u) e- where q u (Sh (ReaderT b)) = Sh (ReaderT (u . b))- uninterruptibleMask a =- Sh $ ReaderT $ \e -> Catch.uninterruptibleMask $ \u -> runSh (a $ q u) e- where q u (Sh (ReaderT b)) = Sh (ReaderT (u . b))- runSh :: Sh a -> IORef State -> IO a runSh = runReaderT . unSh @@ -117,6 +103,7 @@ , sPutStderr :: Text -> IO () -- ^ by default, hPutStrLn stderr , sPrintStderr :: Bool -- ^ print stderr of command that is executed , sPrintCommands :: Bool -- ^ print command that is executed+ , sPrintCommandsFn :: Text -> IO () -- ^ how to print commands, default is hputStrLn stdout , sInitCommandHandles :: StdInit -- ^ initializers for the standard process handles -- when running a command , sCommandEscaping :: Bool -- ^ when running a command, escape shell characters such as '*' rather@@ -134,10 +121,10 @@ | OutHandle StdStream | ErrorHandle StdStream --- | Initialize a handle before using it+-- | Initialize a handle before using it. type HandleInitializer = Handle -> IO () --- | A collection of initializers for the three standard process handles+-- | A collection of initializers for the three standard process handles. data StdInit = StdInit { inInit :: HandleInitializer,@@ -145,13 +132,13 @@ errInit :: HandleInitializer } --- | A monadic-conditional version of the "when" guard.+-- | A monadic-conditional version of the 'when' guard. whenM :: Monad m => m Bool -> m () -> m () whenM c a = c >>= \res -> when res a --- | Makes a relative path relative to the current Sh working directory.+-- | Makes a relative path relative to the current 'Sh' working directory. -- An absolute path is returned as is.--- To create an absolute path, use 'absPath'+-- To create an absolute path, use 'absPath'. relPath :: FilePath -> Sh FilePath relPath fp = do wd <- gets sDirectory@@ -160,9 +147,10 @@ Right p -> p Left p -> p -eitherRelativeTo :: FilePath -- ^ anchor path, the prefix- -> FilePath -- ^ make this relative to anchor path- -> Sh (Either FilePath FilePath) -- ^ Left is canonic of second path+eitherRelativeTo+ :: FilePath -- ^ Anchor path, the prefix.+ -> FilePath -- ^ Make this relative to anchor path.+ -> Sh (Either FilePath FilePath) -- ^ 'Left' is canonic of second path. eitherRelativeTo relativeFP fp = do let fullFp = relativeFP FP.</> fp let relDir = addTrailingSlash relativeFP@@ -174,23 +162,27 @@ fpCan <- canonic fullFp stripIt relCan fpCan $ return $ Left fpCan where+ stripIt+ :: FilePath+ -> FilePath+ -> Sh (Either FilePath FilePath)+ -> Sh (Either FilePath FilePath) stripIt rel toStrip nada =- case FP.stripPrefix rel toStrip of- Just stripped ->- if stripped == toStrip then nada- else return $ Right stripped- Nothing -> nada+ let stripped = FP.makeRelative rel toStrip+ in if stripped == toStrip+ then nada+ else return $ Right stripped --- | make the second path relative to the first--- Uses 'Filesystem.stripPrefix', but will canonicalize the paths if necessary-relativeTo :: FilePath -- ^ anchor path, the prefix- -> FilePath -- ^ make this relative to anchor path+-- | Make the second path relative to the first.+-- Will canonicalize the paths if necessary.+relativeTo :: FilePath -- ^ Anchor path, the prefix.+ -> FilePath -- ^ Make this relative to anchor path. -> Sh FilePath relativeTo relativeFP fp = fmap (fromMaybe fp) $ maybeRelativeTo relativeFP fp -maybeRelativeTo :: FilePath -- ^ anchor path, the prefix- -> FilePath -- ^ make this relative to anchor path+maybeRelativeTo :: FilePath -- ^ Anchor path, the prefix.+ -> FilePath -- ^ Make this relative to anchor path. -> Sh (Maybe FilePath) maybeRelativeTo relativeFP fp = do epath <- eitherRelativeTo relativeFP fp@@ -199,31 +191,29 @@ Left _ -> Nothing --- | add a trailing slash to ensure the path indicates a directory+-- | Add a trailing slash to ensure the path indicates a directory. addTrailingSlash :: FilePath -> FilePath-addTrailingSlash p =- if FP.null (FP.filename p) then p else- p FP.</> FP.empty+addTrailingSlash = FP.addTrailingPathSeparator --- | makes an absolute path.--- Like 'canonicalize', but on an exception returns 'absPath'+-- | Make an absolute path.+-- Like 'canonicalize', but on an exception returns 'absPath'. canonic :: FilePath -> Sh FilePath canonic fp = do p <- absPath fp liftIO $ canonicalizePath p `catchany` \_ -> return p -- | Obtain a (reasonably) canonic file path to a filesystem object. Based on--- "canonicalizePath" in system-fileio.+-- 'canonicalizePath'. canonicalize :: FilePath -> Sh FilePath canonicalize = absPath >=> liftIO . canonicalizePath --- | bugfix older version of canonicalizePath (system-fileio <= 0.3.7) loses trailing slash+-- | Version of 'FS.canonicalizePath' that keeps a trailing slash. canonicalizePath :: FilePath -> IO FilePath-canonicalizePath p = let was_dir = FP.null (FP.filename p) in+canonicalizePath p = let was_dir = null (FP.takeFileName p) in if not was_dir then FS.canonicalizePath p else addTrailingSlash `fmap` FS.canonicalizePath p -data EmptyFilePathError = EmptyFilePathError deriving Typeable+data EmptyFilePathError = EmptyFilePathError instance Show EmptyFilePathError where show _ = "Empty filepath" instance Exception EmptyFilePathError@@ -232,27 +222,28 @@ -- An absolute path is returned as is. -- To create a relative path, use 'relPath'. absPath :: FilePath -> Sh FilePath-absPath p | FP.null p = liftIO $ throwIO EmptyFilePathError- | relative p = (FP.</> p) <$> gets sDirectory+absPath p | null p = liftIO $ throwIO EmptyFilePathError+ | isRelative p = do+ cwd <- gets sDirectory+ return (cwd FP.</> p) | otherwise = return p --- | deprecated path :: FilePath -> Sh FilePath path = absPath {-# DEPRECATED path "use absPath, canonic, or relPath instead" #-} -- | Does a path point to an existing directory? test_d :: FilePath -> Sh Bool-test_d = absPath >=> liftIO . isDirectory+test_d = absPath >=> liftIO . doesDirectoryExist -- | Does a path point to a symlink? test_s :: FilePath -> Sh Bool test_s = absPath >=> liftIO . \f -> do- stat <- getSymbolicLinkStatus (encodeString f)+ stat <- getSymbolicLinkStatus f return $ isSymbolicLink stat unpack :: FilePath -> String-unpack = encodeString+unpack = id gets :: (State -> a) -> Sh a gets f = f <$> get@@ -267,14 +258,14 @@ state <- ask liftIO (modifyIORef state f) --- | internally log what occurred.+-- | Internally log what occurred. -- Log will be re-played on failure. trace :: Text -> Sh () trace msg = whenM (gets sTracing) $ modify $ \st -> st { sTrace = sTrace st `mappend` msg `mappend` "\n" } --- | List directory contents. Does *not* include \".\" and \"..\", but it does+-- | List directory contents. Does /not/ include @.@ and @..@, but it does -- include (other) hidden files. ls :: FilePath -> Sh [FilePath] -- it is important to use path and not absPath so that the listing can remain relative@@ -284,34 +275,29 @@ lsRelAbs :: FilePath -> Sh ([FilePath], [FilePath]) lsRelAbs f = absPath f >>= \fp -> do- filt <- if not (relative f) then return return- else do- wd <- gets sDirectory- return (relativeTo wd)- absolute <- liftIO $ listDirectory fp- relativized <- mapM filt absolute+ files <- liftIO $ listDirectory fp+ let absolute = map (fp FP.</>) files+ let relativized = map (\p -> FP.joinPath [f, p]) files return (relativized, absolute) --- | silently uses the Right or Left value of "Filesystem.Path.CurrentOS.toText" toTextIgnore :: FilePath -> Text-toTextIgnore fp = case FP.toText fp of- Left f -> f- Right f -> f+toTextIgnore = T.pack --- | a print lifted into 'Sh'-inspect :: (Show s) => s -> Sh ()+-- | 'print' lifted into 'Sh'.+inspect :: Show s => s -> Sh () inspect x = do- (trace . T.pack . show) x- liftIO $ print x+ trace $ T.pack s+ liftIO $ putStrLn s+ where s = show x --- | a print lifted into 'Sh' using stderr-inspect_err :: (Show s) => s -> Sh ()+-- | A 'print' lifted into 'Sh' using stderr.+inspect_err :: Show s => s -> Sh () inspect_err x = do let shown = T.pack $ show x trace shown echo_err shown --- | Echo text to standard (error, when using _err variants) output. The _n+-- | Echo text to standard (error, when using @_err@ variants) output. The @_n@ -- variants do not print a final newline. echo, echo_n, echo_err, echo_n_err :: Text -> Sh () echo msg = traceEcho msg >> liftIO (TIO.putStrLn msg >> hFlush stdout)@@ -319,6 +305,10 @@ echo_err msg = traceEcho msg >> liftIO (TIO.hPutStrLn stderr msg >> hFlush stdout) echo_n_err msg = traceEcho msg >> liftIO (TIO.hPutStr stderr msg >> hFlush stderr) +-- | @since 1.12.1+echoWith :: (Text -> IO ()) -> Text -> Sh ()+echoWith f msg = traceEcho msg >> liftIO (f msg >> hFlush stdout)+ traceEcho :: Text -> Sh () traceEcho msg = trace ("echo " `mappend` "'" `mappend` msg `mappend` "'") @@ -326,4 +316,3 @@ -- @... `catch` \(e :: SomeException) -> ...@). catchany :: IO a -> (SomeException -> IO a) -> IO a catchany = catch-
+ src/Shelly/Directory.hs view
@@ -0,0 +1,23 @@+{-# OPTIONS -Wall #-}+module Shelly.Directory where++import System.IO.Error (modifyIOError, ioeSetLocation, ioeGetLocation)++import qualified System.PosixCompat as Posix++createFileLink :: String -> String -> IO ()+createFileLink target link =+ (`ioeAddLocation` "createFileLink") `modifyIOError` do+ Posix.createSymbolicLink target link++getSymbolicLinkTarget :: String -> IO String+getSymbolicLinkTarget path =+ (`ioeAddLocation` "getSymbolicLinkTarget") `modifyIOError` do+ Posix.readSymbolicLink path++ioeAddLocation :: IOError -> String -> IOError+ioeAddLocation e loc = do+ ioeSetLocation e newLoc+ where+ newLoc = loc ++ if Prelude.null oldLoc then "" else ":" ++ oldLoc+ oldLoc = ioeGetLocation e
src/Shelly/Find.hs view
@@ -1,20 +1,29 @@ {-# LANGUAGE OverloadedStrings #-}+ -- | File finding utiliites for Shelly -- The basic 'find' takes a dir and gives back a list of files. -- If you don't just want a list, use the folding variants like 'findFold'. -- If you want to avoid traversing certain directories, use the directory filtering variants like 'findDirFilter'+ module Shelly.Find- (- find, findWhen, findFold, findDirFilter, findDirFilterWhen, findFoldDirFilter- ) where+ ( find+ , findWhen+ , findFold+ , findDirFilter+ , findDirFilterWhen+ , findFoldDirFilter+ )+where -import Prelude hiding (FilePath)-import Shelly.Base-import Control.Monad (foldM)-import Data.Monoid (mappend)-import System.PosixCompat.Files( getSymbolicLinkStatus, isSymbolicLink )-import Filesystem (isDirectory)-import Filesystem.Path.CurrentOS (encodeString)+import Shelly.Base+import Control.Monad ( foldM )+#if !MIN_VERSION_base(4,13,0)+import Data.Monoid ( mappend )+#endif+import System.PosixCompat.Files ( getSymbolicLinkStatus+ , isSymbolicLink+ )+import System.Directory ( doesDirectoryExist ) -- | List directory recursively (like the POSIX utility "find"). -- listing is relative if the path given is relative.@@ -31,46 +40,49 @@ -- | Fold an arbitrary folding function over files froma a 'find'. -- Like 'findWhen' but use a more general fold rather than a filter. findFold :: (a -> FilePath -> Sh a) -> a -> FilePath -> Sh a-findFold folder startValue = findFoldDirFilter folder startValue (const $ return True)+findFold folder startValue =+ findFoldDirFilter folder startValue (const $ return True) --- | 'find' that filters out directories as it finds+-- | 'find' that filters out directories as it finds. -- Filtering out directories can make a find much more efficient by avoiding entire trees of files. findDirFilter :: (FilePath -> Sh Bool) -> FilePath -> Sh [FilePath] findDirFilter filt = findDirFilterWhen filt (const $ return True) --- | similar 'findWhen', but also filter out directories--- Alternatively, similar to 'findDirFilter', but also filter out files--- Filtering out directories makes the find much more efficient-findDirFilterWhen :: (FilePath -> Sh Bool) -- ^ directory filter- -> (FilePath -> Sh Bool) -- ^ file filter- -> FilePath -- ^ directory- -> Sh [FilePath]+-- | Similar to 'findWhen', but also filter out directories.+-- Alternatively, similar to 'findDirFilter', but also filter out files.+-- Filtering out directories makes the find much more efficient.+findDirFilterWhen+ :: (FilePath -> Sh Bool) -- ^ directory filter+ -> (FilePath -> Sh Bool) -- ^ file filter+ -> FilePath -- ^ directory+ -> Sh [FilePath] findDirFilterWhen dirFilt fileFilter = findFoldDirFilter filterIt [] dirFilt- where- filterIt paths fp = do- yes <- fileFilter fp- return $ if yes then paths ++ [fp] else paths+ where+ filterIt paths fp = do+ yes <- fileFilter fp+ return $ if yes then paths ++ [fp] else paths --- | like 'findDirFilterWhen' but use a folding function rather than a filter--- The most general finder: you likely want a more specific one-findFoldDirFilter :: (a -> FilePath -> Sh a) -> a -> (FilePath -> Sh Bool) -> FilePath -> Sh a+-- | Like 'findDirFilterWhen' but use a folding function rather than a filter.+-- The most general finder: you likely want a more specific one.+findFoldDirFilter+ :: (a -> FilePath -> Sh a) -> a -> (FilePath -> Sh Bool) -> FilePath -> Sh a findFoldDirFilter folder startValue dirFilter dir = do absDir <- absPath dir trace ("find " `mappend` toTextIgnore absDir) filt <- dirFilter absDir- if not filt then return startValue+ if not filt+ then return startValue -- use possible relative path, not absolute so that listing will remain relative else do- (rPaths, aPaths) <- lsRelAbs dir - foldM traverse startValue (zip rPaths aPaths)- where- traverse acc (relativePath, absolutePath) = do- -- optimization: don't use Shelly API since our path is already good- isDir <- liftIO $ isDirectory absolutePath- sym <- liftIO $ fmap isSymbolicLink $ getSymbolicLinkStatus (encodeString absolutePath)- newAcc <- folder acc relativePath- follow <- fmap sFollowSymlink get- if isDir && (follow || not sym)- then findFoldDirFilter folder newAcc - dirFilter relativePath- else return newAcc+ (rPaths, aPaths) <- lsRelAbs dir+ foldM traverse' startValue (zip rPaths aPaths)+ where+ traverse' acc (relativePath, absolutePath) = do+ -- optimization: don't use Shelly API since our path is already good+ isDir <- liftIO $ doesDirectoryExist absolutePath+ sym <- liftIO $ fmap isSymbolicLink $ getSymbolicLinkStatus absolutePath+ newAcc <- folder acc relativePath+ follow <- fmap sFollowSymlink get+ if isDir && (follow || not sym)+ then findFoldDirFilter folder newAcc dirFilter relativePath+ else return newAcc
src/Shelly/Lifted.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, OverloadedStrings,+{-# LANGUAGE ScopedTypeVariables, OverloadedStrings, FlexibleInstances, FlexibleContexts, IncoherentInstances, TypeFamilies, ExistentialQuantification, RankNTypes, ImpredicativeTypes #-}@@ -32,13 +32,13 @@ -- please make the same updates here and implements the corresponding -- lifted functions. - -- * Entering Sh.+ -- * Entering Sh Sh, ShIO, S.shelly, S.shellyNoDir, S.shellyFailDir, sub- , silently, verbosely, escaping, print_stdout, print_stderr, print_commands+ , silently, verbosely, escaping, print_stdout, print_stderr, print_commands, print_commands_with , tracing, errExit , log_stdout_with, log_stderr_with - -- * Running external commands.+ -- * Running external commands , run, run_, runFoldLines, S.cmd, S.FoldCallback , (-|-), lastStderr, setStdin, lastExitCode , command, command_, command1, command1_@@ -50,24 +50,24 @@ , S.StdHandle(..), S.StdStream(..) - -- * Modifying and querying environment.+ -- * Modifying and querying environment , setenv, get_env, get_env_text, get_env_all, appendToPath, prependToPath -- * Environment directory , cd, chdir, chdir_p, pwd -- * Printing- , echo, echo_n, echo_err, echo_n_err, inspect, inspect_err+ , echo, echo_n, echo_err, echo_n_err, echoWith, inspect, inspect_err , tag, trace, S.show_command - -- * Querying filesystem.+ -- * Querying filesystem , ls, lsT, test_e, test_f, test_d, test_s, test_px, which -- * Filename helpers , absPath, (S.</>), (S.<.>), canonic, canonicalize, relPath, relativeTo , S.hasExt - -- * Manipulating filesystem.+ -- * Manipulating filesystem , mv, rm, rm_f, rm_rf, cp, cp_r, mkdir, mkdir_p, mkdirTree -- * reading/writing Files@@ -80,7 +80,7 @@ , bracket_sh, catchany, catch_sh, handle_sh, handleany_sh, finally_sh, catches_sh, catchany_sh -- * convert between Text and FilePath- , S.toTextIgnore, toTextWarn, FP.fromText+ , S.toTextIgnore, toTextWarn, S.fromText -- * Utility Functions , S.whenM, S.unlessM, time, sleep@@ -96,26 +96,23 @@ , followSymlink ) where -import qualified Shelly as S-import Shelly.Base (Sh(..), ShIO, Text, (>=>), FilePath)+import qualified Shelly as S import qualified Shelly.Base as S-import Control.Monad ( liftM )-import Prelude hiding ( FilePath )+import Shelly.Base ( Sh(..), ShIO, Text, (>=>) )++import Control.Monad ( liftM ) import Data.ByteString ( ByteString )-import Data.Monoid-import System.IO ( Handle )-import Data.Tree ( Tree )-import qualified Filesystem.Path.CurrentOS as FP+import Data.Tree ( Tree )+import System.IO ( Handle ) import Control.Exception.Lifted import Control.Exception.Enclosed import Control.Monad.IO.Class import Control.Monad.Trans.Control import Control.Monad.Trans.Identity-import Control.Monad.Trans.List import Control.Monad.Trans.Maybe import Control.Monad.Trans.Cont-import Control.Monad.Trans.Error+import Control.Monad.Trans.Except import Control.Monad.Trans.Reader import Control.Monad.Trans.State import qualified Control.Monad.Trans.State.Strict as Strict@@ -132,40 +129,46 @@ instance MonadSh m => MonadSh (IdentityT m) where liftSh = IdentityT . liftSh-instance MonadSh m => MonadSh (ListT m) where- liftSh m = ListT $ do- a <- liftSh m- return [a]+ instance MonadSh m => MonadSh (MaybeT m) where liftSh = MaybeT . liftM Just . liftSh+ instance MonadSh m => MonadSh (ContT r m) where liftSh m = ContT (liftSh m >>=)-instance (Error e, MonadSh m) => MonadSh (ErrorT e m) where- liftSh m = ErrorT $ do++instance (MonadSh m) => MonadSh (ExceptT e m) where+ liftSh m = ExceptT $ do a <- liftSh m return (Right a)+ instance MonadSh m => MonadSh (ReaderT r m) where liftSh = ReaderT . const . liftSh+ instance MonadSh m => MonadSh (StateT s m) where liftSh m = StateT $ \s -> do a <- liftSh m return (a, s)+ instance MonadSh m => MonadSh (Strict.StateT s m) where liftSh m = Strict.StateT $ \s -> do a <- liftSh m return (a, s)+ instance (Monoid w, MonadSh m) => MonadSh (WriterT w m) where liftSh m = WriterT $ do a <- liftSh m return (a, mempty :: w)+ instance (Monoid w, MonadSh m) => MonadSh (Strict.WriterT w m) where liftSh m = Strict.WriterT $ do a <- liftSh m return (a, mempty :: w)+ instance (Monoid w, MonadSh m) => MonadSh (RWS.RWST r w s m) where liftSh m = RWS.RWST $ \_ s -> do a <- liftSh m return (a, s, mempty :: w)+ instance (Monoid w, MonadSh m) => MonadSh (Strict.RWST r w s m) where liftSh m = Strict.RWST $ \_ s -> do a <- liftSh m@@ -181,7 +184,7 @@ cmdAll = (liftSh .) . S.run_ class Monad m => MonadShControl m where- data ShM m a :: *+ data ShM m a liftShWith :: ((forall x. m x -> Sh (ShM m x)) -> Sh a) -> m a restoreSh :: ShM m a -> m a @@ -192,15 +195,6 @@ {-# INLINE liftShWith #-} {-# INLINE restoreSh #-} -instance MonadShControl m => MonadShControl (ListT m) where- newtype ShM (ListT m) a = ListTShM (ShM m [a])- liftShWith f =- ListT $ liftM return $ liftShWith $ \runInSh -> f $ \k ->- liftM ListTShM $ runInSh $ runListT k- restoreSh (ListTShM m) = ListT . restoreSh $ m- {-# INLINE liftShWith #-}- {-# INLINE restoreSh #-}- instance MonadShControl m => MonadShControl (MaybeT m) where newtype ShM (MaybeT m) a = MaybeTShM (ShM m (Maybe a)) liftShWith f =@@ -240,13 +234,12 @@ {-# INLINE liftShWith #-} {-# INLINE restoreSh #-} -instance (MonadShControl m, Error e)- => MonadShControl (ErrorT e m) where- newtype ShM (ErrorT e m) a = ErrorTShM (ShM m (Either e a))+instance MonadShControl m => MonadShControl (ExceptT e m) where+ newtype ShM (ExceptT e m) a = ExceptTShM (ShM m (Either e a)) liftShWith f =- ErrorT $ liftM return $ liftShWith $ \runInSh -> f $ \k ->- liftM ErrorTShM $ runInSh $ runErrorT k- restoreSh (ErrorTShM m) = ErrorT . restoreSh $ m+ ExceptT $ liftM return $ liftShWith $ \runInSh -> f $ \k ->+ liftM ExceptTShM $ runInSh $ runExceptT k+ restoreSh (ExceptTShM m) = ExceptT . restoreSh $ m {-# INLINE liftShWith #-} {-# INLINE restoreSh #-} @@ -331,6 +324,10 @@ print_commands :: MonadShControl m => Bool -> m a -> m a print_commands shouldPrint a = controlSh $ \runInSh -> S.print_commands shouldPrint (runInSh a) +-- | @since 1.12.1+print_commands_with :: MonadShControl m => (Text -> IO ()) -> m a -> m a+print_commands_with fn a = controlSh $ \runInSh -> S.print_commands_with fn (runInSh a)+ sub :: MonadShControl m => m a -> m a sub a = controlSh $ \runInSh -> S.sub (runInSh a) @@ -375,11 +372,11 @@ put :: MonadSh m => S.State -> m () put = liftSh . S.put -catch_sh :: (Exception e) => Sh a -> (e -> Sh a) -> Sh a+catch_sh :: Exception e => Sh a -> (e -> Sh a) -> Sh a catch_sh = Control.Exception.Lifted.catch {-# DEPRECATED catch_sh "use Control.Exception.Lifted.catch instead" #-} -handle_sh :: (Exception e) => (e -> Sh a) -> Sh a -> Sh a+handle_sh :: Exception e => (e -> Sh a) -> Sh a -> Sh a handle_sh = handle {-# DEPRECATED handle_sh "use Control.Exception.Lifted.handle instead" #-} @@ -561,6 +558,10 @@ echo_err = liftSh . S.echo_err echo_n_err = liftSh . S.echo_n_err +-- | @since 1.12.1+echoWith :: MonadSh m => (Text -> IO ()) -> Text -> m ()+echoWith f msg = liftSh $ S.echoWith f msg+ relPath :: MonadSh m => FilePath -> m FilePath relPath = liftSh . S.relPath @@ -573,7 +574,7 @@ canonic = liftSh . canonic -- | Obtain a (reasonably) canonic file path to a filesystem object. Based on--- "canonicalizePath" in system-fileio.+-- "canonicalizePath". canonicalize :: MonadSh m => FilePath -> m FilePath canonicalize = liftSh . S.canonicalize
src/Shelly/Pipe.hs view
@@ -1,14 +1,15 @@-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, +{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, TypeFamilies, ExistentialQuantification #-}--- | This module is a wrapper for the module "Shelly". --- The only difference is a main type 'Sh'. In this module ++-- | This module is a wrapper for the module "Shelly".+-- The only difference is a main type 'Sh'. In this module -- 'Sh' contains a list of results. Actual definition of the type 'Sh' is: -- -- > import qualified Shelly as S -- > -- > newtype Sh a = Sh { unSh :: S.Sh [a] } ----- This definition can simplify some filesystem commands. +-- This definition can simplify some filesystem commands. -- A monad bind operator becomes a pipe operator and we can write -- -- > findExt ext = findWhen (pure . hasExt ext)@@ -17,13 +18,9 @@ -- > main = shs $ do -- > mkdir "new" -- > findExt "hs" "." >>= flip cp "new"--- > findExt "cpp" "." >>= rm_f +-- > findExt "cpp" "." >>= rm_f -- > liftIO $ putStrLn "done" ----- Monad methods "return" and ">>=" behave like methods for--- @ListT Shelly.Sh@, but ">>" forgets the number of --- the empty effects. So the last line prints @\"done\"@ only once. --- -- Documentation in this module mostly just reference documentation from -- the main "Shelly" module. --@@ -33,20 +30,21 @@ -- > import Shelly -- > import Data.Text as T -- > default (T.Text)+ module Shelly.Pipe (- -- * Entering Sh.+ -- * Entering Sh Sh, shs, shelly, shellyFailDir, shsFailDir, sub, silently, verbosely, escaping, print_stdout, print_commands, tracing, errExit, log_stdout_with, log_stderr_with -- * List functions , roll, unroll, liftSh- -- * Running external commands.+ -- * Running external commands , FoldCallback , run, run_, runFoldLines, cmd , (-|-), lastStderr, setStdin, lastExitCode , command, command_, command1, command1_ , sshPairs, sshPairs_ - -- * Modifying and querying environment.+ -- * Modifying and querying environment , setenv, get_env, get_env_text, get_env_def, appendToPath, prependToPath -- * Environment directory@@ -56,14 +54,14 @@ , echo, echo_n, echo_err, echo_n_err, inspect, inspect_err , tag, trace, show_command - -- * Querying filesystem.+ -- * Querying filesystem , ls, lsT, test_e, test_f, test_d, test_s, which -- * Filename helpers , absPath, (</>), (<.>), canonic, canonicalize, relPath, relativeTo , hasExt - -- * Manipulating filesystem.+ -- * Manipulating filesystem , mv, rm, rm_f, rm_rf, cp, cp_r, mkdir, mkdir_p, mkdirTree -- * reading/writing Files@@ -73,14 +71,14 @@ , exit, errorExit, quietExit, terror -- * Exceptions- , catchany, catch_sh, finally_sh + , catchany, catch_sh, finally_sh , ShellyHandler(..), catches_sh , catchany_sh -- * convert between Text and FilePath- , toTextIgnore, toTextWarn, fromText+ , toTextIgnore, toTextWarn, S.fromText - -- * Utilities.+ -- * Utilities , (<$>), whenM, unlessM, time -- * Re-exported for your convenience@@ -89,54 +87,50 @@ -- * internal functions for writing extensions , get, put - -- * find functions + -- * find functions , find, findWhen, findFold , findDirFilter, findDirFilterWhen, findFoldDirFilter , followSymlink ) where -import Prelude hiding (FilePath)--import Control.Applicative-import Control.Monad-import Control.Monad.Trans-import Control.Exception hiding (handle)--import Filesystem.Path(FilePath)- import qualified Shelly as S -import Shelly(- (</>), (<.>), hasExt+import Shelly+ ( (</>), (<.>), hasExt , whenM, unlessM, toTextIgnore- , fromText, catchany- , FoldCallback)--import Data.Maybe(fromMaybe)-import Shelly.Base(State)-import Data.ByteString (ByteString)+ , catchany+ , FoldCallback+ )+import Shelly.Base (State) -import Data.Tree(Tree)+import Control.Applicative+import Control.Monad+import Control.Monad.Trans+import Control.Exception +import Data.Maybe ( fromMaybe )+import Data.ByteString ( ByteString )+import Data.Tree ( Tree ) import Data.Text as T hiding (concat, all, find, cons) - -- | This type is a simple wrapper for a type @Shelly.Sh@.--- 'Sh' contains a list of results. +-- 'Sh' contains a list of results.+ newtype Sh a = Sh { unSh :: S.Sh [a] } instance Functor Sh where- fmap f = Sh . fmap (fmap f) . unSh --instance Monad Sh where- return = Sh . return . return - a >>= f = Sh $ fmap concat $ mapM (unSh . f) =<< unSh a- a >> b = Sh $ unSh a >> unSh b+ fmap f = Sh . fmap (fmap f) . unSh instance Applicative Sh where- pure = return+ pure = Sh . pure . pure (<*>) = ap+ a *> b = Sh $ unSh a *> unSh b +instance Monad Sh where+ return = pure+ a >>= f = Sh $ fmap concat $ mapM (unSh . f) =<< unSh a+ (>>) = (*>)+ instance Alternative Sh where empty = mzero (<|>) = mplus@@ -154,29 +148,29 @@ sh0 :: S.Sh a -> Sh a sh0 = Sh . fmap return -sh1 :: (a -> S.Sh b) -> (a -> Sh b) +sh1 :: (a -> S.Sh b) -> (a -> Sh b) sh1 f = \a -> sh0 (f a) -sh2 :: (a1 -> a2 -> S.Sh b) -> (a1 -> a2 -> Sh b) +sh2 :: (a1 -> a2 -> S.Sh b) -> (a1 -> a2 -> Sh b) sh2 f = \a b -> sh0 (f a b) -sh3 :: (a1 -> a2 -> a3 -> S.Sh b) -> (a1 -> a2 -> a3 -> Sh b) +sh3 :: (a1 -> a2 -> a3 -> S.Sh b) -> (a1 -> a2 -> a3 -> Sh b) sh3 f = \a b c -> sh0 (f a b c) -sh4 :: (a1 -> a2 -> a3 -> a4 -> S.Sh b) -> (a1 -> a2 -> a3 -> a4 -> Sh b) +sh4 :: (a1 -> a2 -> a3 -> a4 -> S.Sh b) -> (a1 -> a2 -> a3 -> a4 -> Sh b) sh4 f = \a b c d -> sh0 (f a b c d) sh0s :: S.Sh [a] -> Sh a sh0s = Sh -sh1s :: (a -> S.Sh [b]) -> (a -> Sh b) +sh1s :: (a -> S.Sh [b]) -> (a -> Sh b) sh1s f = \a -> sh0s (f a) {- Just in case ...-sh2s :: (a1 -> a2 -> S.Sh [b]) -> (a1 -> a2 -> Sh b) +sh2s :: (a1 -> a2 -> S.Sh [b]) -> (a1 -> a2 -> Sh b) sh2s f = \a b -> sh0s (f a b) -sh3s :: (a1 -> a2 -> a3 -> S.Sh [b]) -> (a1 -> a2 -> a3 -> Sh b) +sh3s :: (a1 -> a2 -> a3 -> S.Sh [b]) -> (a1 -> a2 -> a3 -> Sh b) sh3s f = \a b c -> sh0s (f a b c) -} @@ -188,19 +182,19 @@ where f' = \x y -> f (return x) (return y) mapM2 :: Monad m => (a -> b -> m c)-> [a] -> [b] -> m [c]-mapM2 f as bs = sequence $ liftA2 f as bs +mapM2 f as bs = sequence $ liftA2 f as bs ----------------------------------------------------------- -- | Unpack list of results. unroll :: Sh a -> Sh [a]-unroll = Sh . fmap return . unSh +unroll = Sh . fmap return . unSh -- | Pack list of results. It performs @concat@ inside 'Sh'. roll :: Sh [a] -> Sh a roll = Sh . fmap concat . unSh --- | Transform result as list. It can be useful for filtering. +-- | Transform result as list. It can be useful for filtering. liftSh :: ([a] -> [b]) -> Sh a -> Sh b liftSh f = Sh . fmap f . unSh @@ -211,7 +205,7 @@ shelly :: MonadIO m => Sh a -> m [a] shelly = S.shelly . unSh --- | Performs 'shelly' and then an empty action @return ()@. +-- | Performs 'shelly' and then an empty action @return ()@. shs :: MonadIO m => Sh () -> m () shs x = shelly x >> return () @@ -289,7 +283,7 @@ -- | see 'S.setStdin' setStdin :: Text -> Sh ()-setStdin = sh1 S.setStdin +setStdin = sh1 S.setStdin -- | see 'S.lastExitCode' lastExitCode :: Sh Int@@ -358,7 +352,7 @@ pwd = sh0 S.pwd -------------------------------------------------------------------- Printing +-- Printing -- | Echo text to standard (error, when using _err variants) output. The _n -- variants do not print a final newline.@@ -528,15 +522,15 @@ -- | see 'S.findDirFilter' findDirFilter :: (FilePath -> Sh Bool) -> FilePath -> Sh FilePath findDirFilter p a = Sh $ S.findDirFilter (fmap and . unSh . p) a- + -- | see 'S.findDirFilterWhen' findDirFilterWhen :: (FilePath -> Sh Bool) -- ^ directory filter -> (FilePath -> Sh Bool) -- ^ file filter -> FilePath -- ^ directory -> Sh FilePath-findDirFilterWhen dirPred filePred a = - Sh $ S.findDirFilterWhen - (fmap and . unSh . dirPred) +findDirFilterWhen dirPred filePred a =+ Sh $ S.findDirFilterWhen+ (fmap and . unSh . dirPred) (fmap and . unSh . filePred) a @@ -547,9 +541,9 @@ where p' = fmap and . unSh . p nil' = return nil cons' as dir = unSh $ roll $ mapM (flip cons dir) as- + -------------------------------------------------------------- exiting the program +-- exiting the program -- | see 'S.exit' exit :: Int -> Sh ()@@ -597,14 +591,14 @@ convert (ShellyHandler f) = S.ShellyHandler (unSh . f) --------------------------------------------------------------- convert between Text and FilePath +-- convert between Text and FilePath -- | see 'S.toTextWarn' toTextWarn :: FilePath -> Sh Text toTextWarn = sh1 S.toTextWarn ---------------------------------------------------------------- internal functions for writing extension +-- internal functions for writing extension get :: Sh State get = sh0 S.get@@ -616,27 +610,30 @@ -- 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+ -- | @since 1.12.0+ toTextArgs :: a -> [Text] +instance ShellArg Text where+ toTextArgs = (: []) --- Voodoo to create the variadic function 'cmd'+instance ShellArg String where+ toTextArgs = (: []) . T.pack++instance {-# OVERLAPPABLE #-} ShellArg a => ShellArg [a] where+ toTextArgs = Prelude.concatMap toTextArgs+ 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
src/Shelly/Unix.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} --- | commands that only work on Unix+-- | Commands that only work on Unix. module Shelly.Unix ( kill ) where
+ test/data/hello.sh view
@@ -0,0 +1,3 @@+#!/usr/bin/env bash++echo -n "Hello!"
+ test/data/symlinked_dir/hoge_file view
test/examples/color.hs view
@@ -8,5 +8,5 @@ default (Text) main = shelly $ do- void $ liftIO $ rawSystem "ls" ["--color=auto", "../dist"]- run_ "ls" ["--color=auto", "../dist"]+ void $ liftIO $ rawSystem "ls" ["--color=auto", "test"]+ run_ "ls" ["--color=auto", "test"]
test/examples/drain.hs view
@@ -1,5 +1,5 @@ {-# Language OverloadedStrings, ExtendedDefaultRules #-}-import Prelude hiding (FilePath)+ import Shelly import Control.Monad (void) import Data.Text (Text)@@ -8,7 +8,7 @@ main :: IO () main = do- let exDir = "./examples"+ let exDir = "./test/examples" void $ shelly $ do let strs = ["a", "b"] :: [String] let texts = ["a", "b"] :: [Text]
test/examples/run-handles.hs view
@@ -3,6 +3,6 @@ -- This test runs, but causes this error to show up: -- Exception: cannot access an inherited pipe main = shelly $- runHandles "bash" ["examples/test.sh"] handles doNothing+ runHandles "bash" ["test/examples/test.sh"] handles doNothing where handles = [InHandle Inherit, OutHandle Inherit, ErrorHandle Inherit] doNothing _ _ _ = return ""
test/src/CopySpec.hs view
@@ -3,18 +3,13 @@ import TestInit -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706-import Prelude hiding ( FilePath, catch)-#else-import Prelude hiding ( FilePath)-#endif import Control.Monad (forM_) import System.IO.Error import Help copySpec :: Spec copySpec = do- let b = "b" + let b = "b" let c = "c" describe "cp file" $ do it "cp to same dir" $
test/src/EnvSpec.hs view
@@ -2,11 +2,6 @@ module EnvSpec ( envSpec ) where import TestInit-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706-import Prelude hiding ( FilePath, catch)-#else-import Prelude hiding ( FilePath)-#endif import Data.Maybe envSpec :: Spec@@ -32,5 +27,8 @@ setenv "SHELLY" "test" get_env_text "SHELLY" assert $ res == "test"- + describe "get_env \"PATH\" (OS compatibility test)" $ do+ it "get_env" $ do+ res <- shelly $ get_env "PATH"+ assert $ isJust res
test/src/FindSpec.hs view
@@ -2,7 +2,29 @@ import TestInit import Data.List (sort)+import Data.Text (replace, pack, unpack)+import System.Directory (createDirectoryIfMissing)+import System.PosixCompat.Files (createSymbolicLink, fileExist)+import qualified System.FilePath as SF +createSymlinkForTest :: IO ()+createSymlinkForTest = do+ createDirectoryIfMissing True symDir+ fexist <- fileExist (symDir SF.</> "symlinked_dir")+ if fexist+ then return ()+ else createSymbolicLink+ (".." SF.</> "symlinked_dir")+ (symDir SF.</> "symlinked_dir")+ where+ rootDir = "test" SF.</> "data"+ symDir = rootDir SF.</> "dir"++toWindowsStyleIfNecessary :: String -> String+toWindowsStyleIfNecessary s+ | isWindows = unpack . replace "/" "\\" . pack $ s+ | otherwise = s+ findSpec :: Spec findSpec = do describe "relativeTo" $ do@@ -27,17 +49,25 @@ describe "relative listing" $ do it "lists relative files" $ do res <- shelly $ cd "test/src" >> ls "."- sort res @?= ["./CopySpec.hs", "./EnvSpec.hs", "./FailureSpec.hs",+ 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", "./PrintCommandsFnSpec.hs", "./ReadFileSpec.hs", "./RmSpec.hs", "./RunSpec.hs", "./ShowCommandSpec.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/PipeSpec.hs", "src/PrintCommandsFnSpec.hs", "src/ReadFileSpec.hs", "src/RmSpec.hs", "src/RunSpec.hs", "src/ShowCommandSpec.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 @?= ["./CopySpec.hs", "./EnvSpec.hs", "./FailureSpec.hs",+ 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", "./PrintCommandsFnSpec.hs", "./ReadFileSpec.hs", "./RmSpec.hs", "./RunSpec.hs", "./ShowCommandSpec.hs", "./SshSpec.hs", "./TestInit.hs", "./TestMain.hs", "./WhichSpec.hs", "./WriteSpec.hs", "./sleep.hs"] @@ -52,11 +82,18 @@ res @?= [] it "lists relative files" $ do- res <- shelly $ find "test/src"- sort res @?= ["test/src/CopySpec.hs", "test/src/EnvSpec.hs", "test/src/FailureSpec.hs",+ res <- shelly $ verbosely $ find "test/src"+ 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\\PipeSpec.hs", "test/src\\PrintCommandsFnSpec.hs", "test/src\\ReadFileSpec.hs",+ "test/src\\RmSpec.hs", "test/src\\RunSpec.hs", "test/src\\ShowCommandSpec.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/RmSpec.hs", "test/src/RunSpec.hs", "test/src/SshSpec.hs",+ "test/src/LogWithSpec.hs", "test/src/MoveSpec.hs", "test/src/PipeSpec.hs", "test/src/PrintCommandsFnSpec.hs", "test/src/ReadFileSpec.hs",+ "test/src/RmSpec.hs", "test/src/RunSpec.hs", "test/src/ShowCommandSpec.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"] @@ -64,16 +101,37 @@ 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", "PrintCommandsFnSpec.hs", "ReadFileSpec.hs", "RmSpec.hs", "RunSpec.hs",+ "ShowCommandSpec.hs", "SshSpec.hs", "TestInit.hs", "TestMain.hs", "WhichSpec.hs", "WriteSpec.hs", "sleep.hs"] - it "follow symlinks" $ do- res <- shelly $ followSymlink True $ relPath "test/data" >>= find >>= mapM (relativeTo "test/data")- sort res @?= ["dir","nonascii.txt","symlinked_dir","zshrc","dir/symlinked_dir",- "dir/symlinked_dir/hoge_file","symlinked_dir/hoge_file"]-- it "not follow symlinks" $ do- res <- shelly $ followSymlink False $ relPath "test/data" >>= find >>= mapM (relativeTo "test/data")- sort res @?= ["dir","nonascii.txt","symlinked_dir","zshrc","dir/symlinked_dir",- "symlinked_dir/hoge_file"]+ unless isWindows $ before createSymlinkForTest $ do+ it "follow symlinks" $+ do res <-+ shelly $+ followSymlink True $+ relPath "test/data" >>= find >>= mapM (relativeTo "test/data")+ sort res @?=+ [ "dir"+ , "dir/symlinked_dir"+ , "dir/symlinked_dir/hoge_file"+ , "hello.sh"+ , "nonascii.txt"+ , "symlinked_dir"+ , "symlinked_dir/hoge_file"+ , "zshrc"+ ]+ it "not follow symlinks" $+ do res <-+ shelly $+ followSymlink False $+ relPath "test/data" >>= find >>= mapM (relativeTo "test/data")+ sort res @?=+ [ "dir"+ , "dir/symlinked_dir"+ , "hello.sh"+ , "nonascii.txt"+ , "symlinked_dir"+ , "symlinked_dir/hoge_file"+ , "zshrc"+ ]
test/src/Help.hs view
@@ -4,11 +4,6 @@ ) where import Shelly-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706-import Prelude hiding ( catch, FilePath )-#else-import Prelude hiding ( FilePath )-#endif import Test.HUnit import Control.Monad.Trans ( MonadIO )
test/src/LiftedSpec.hs view
@@ -7,7 +7,7 @@ import Shelly.Lifted import Control.Concurrent.Async.Lifted import Control.Monad.Trans.Maybe-import Test.Hspec.HUnit ()+import Test.Hspec.Contrib.HUnit () liftedSpec :: Spec liftedSpec =
test/src/LogWithSpec.hs view
@@ -2,7 +2,6 @@ module LogWithSpec ( logWithSpec ) where import TestInit-import Prelude hiding (FilePath) import Control.Concurrent (newEmptyMVar, takeMVar, putMVar) import Data.Text (Text)
test/src/MoveSpec.hs view
@@ -5,7 +5,7 @@ moveSpec :: Spec moveSpec = do- let b = "b" + let b = "b" let c = "c" describe "mv file" $ do it "to same dir" $ do@@ -15,7 +15,7 @@ mv b c readfile c res @?= "testing"- + it "to other dir" $ do res <- shelly $ within_dir "test/a" $ do@@ -24,7 +24,7 @@ mv b c readfile "c/b" res @?= "testing"- + describe "mv dir" $ do it "to dir does not exist: create the to dir" $ do res <- shelly $@@ -36,7 +36,7 @@ liftIO $ assert cIsDir test_f "c/d" assert res- + it "to dir exists: creates a nested directory, full to path given" $ do res <- shelly $ within_dir "test/a" $ do@@ -50,7 +50,7 @@ liftIO $ assert bIsDir test_f "c/b/d" assert res- + it "to dir exists: creates a nested directory, partial to path given" $ do res <- shelly $ within_dir "test/a" $ do@@ -64,7 +64,7 @@ liftIO $ assert bIsDir test_f "c/b/d" assert res- + {- it "mv the same dir" $ do shelly $ do
+ test/src/PipeSpec.hs view
@@ -0,0 +1,97 @@+module PipeSpec ( pipeSpec ) where++import TestInit++import Data.Text (Text)+import qualified Shelly.Pipe as P++pipeSpec :: Spec+pipeSpec = do+ describe "P.cmd" $ do+ let shouldBeTxt res t = res @?= [t :: Text]++ it "with Text" $ do+ res <- P.shelly $ P.cmd "echo" ("wibble" :: Text)+ res `shouldBeTxt` "wibble\n"++ it "with String" $ do+ res <- P.shelly $ P.cmd "echo" "wibble"+ res `shouldBeTxt` "wibble\n"++ it "with [Text]" $ do+ res <- P.shelly $ P.cmd "echo" (["wibble"] :: [Text])+ res `shouldBeTxt` "wibble\n"++ it "with [String]" $ do+ res <- P.shelly $ P.cmd "echo" ["wibble"]+ res `shouldBeTxt` "wibble\n"++ -- Check all two argument permutations (with replacement) of { Text, String, [Text], [String] }.+ it "with Text and Text" $ do+ res <- P.shelly $ P.cmd "echo" ("wibble" :: Text) ("wobble" :: Text)+ res `shouldBeTxt` "wibble wobble\n"++ it "with Text and String" $ do+ res <- P.shelly $ P.cmd "echo" ("wibble" :: Text) "wobble"+ res `shouldBeTxt` "wibble wobble\n"++ it "with Text and [Text]" $ do+ res <- P.shelly $ P.cmd "echo" ("wibble" :: Text) (["wobble", "wurble"] :: [Text])+ res `shouldBeTxt` "wibble wobble wurble\n"++ it "with Text and [String]" $ do+ res <- P.shelly $ P.cmd "echo" ("wibble" :: Text) ["wobble", "wurble"]+ res `shouldBeTxt` "wibble wobble wurble\n"++ it "with String and Text" $ do+ res <- P.shelly $ P.cmd "echo" "wibble" ("wobble" :: Text)+ res `shouldBeTxt` "wibble wobble\n"++ it "with String and String" $ do+ res <- P.shelly $ P.cmd "echo" "wibble" "wobble"+ res `shouldBeTxt` "wibble wobble\n"++ it "with String and [Text]" $ do+ res <- P.shelly $ P.cmd "echo" "wibble" (["wobble", "wurble"] :: [Text])+ res `shouldBeTxt` "wibble wobble wurble\n"++ it "with [Text] and Text" $ do+ res <- P.shelly $ P.cmd "echo" (["wibble", "wobble"] :: [Text]) ("wurble" :: Text)+ res `shouldBeTxt` "wibble wobble wurble\n"++ it "with [Text] and String" $ do+ res <- P.shelly $ P.cmd "echo" (["wibble", "wobble"] :: [Text]) "wurble"+ res `shouldBeTxt` "wibble wobble wurble\n"++ it "with [Text] and [Text]" $ do+ res <- P.shelly $ P.cmd "echo" (["wibble", "wobble"] :: [Text]) (["wurble"] :: [Text])+ res `shouldBeTxt` "wibble wobble wurble\n"++ it "with [Text] and [String]" $ do+ res <- P.shelly $ P.cmd "echo" (["wibble", "wobble"] :: [Text]) ["wurble"]+ res `shouldBeTxt` "wibble wobble wurble\n"++ it "with [String] and Text " $ do+ res <- P.shelly $ P.cmd "echo" ["wibble", "wobble"] ("wurble" :: Text)+ res `shouldBeTxt` "wibble wobble wurble\n"++ it "with [String] and String " $ do+ res <- P.shelly $ P.cmd "echo" ["wibble", "wobble"] "wurble"+ res `shouldBeTxt` "wibble wobble wurble\n"++ it "with [String] and [Text] " $ do+ res <- P.shelly $ P.cmd "echo" ["wibble", "wobble"] (["wurble"] :: [Text])+ res `shouldBeTxt` "wibble wobble wurble\n"++ it "with [String] and [String] " $ do+ res <- P.shelly $ P.cmd "echo" ["wibble", "wobble"] ["wurble"]+ res `shouldBeTxt` "wibble wobble wurble\n"++ -- Check unit cases+ it "returns [()]" $ do+ res <- P.shelly $ P.cmd "echo" "wibble" "wobble"+ res @?= [()]++ it "works with underscore" $ do+ _ <- P.shelly $ P.cmd "echo" "wibble" "wobble"+ True `shouldBe` True
+ test/src/PrintCommandsFnSpec.hs view
@@ -0,0 +1,14 @@+module PrintCommandsFnSpec (printCommandsFnSpec) where++import TestInit+import Data.IORef++printCommandsFnSpec :: Spec+printCommandsFnSpec = do+ describe "sPrintCommandsFn" $ do+ it "calls the custom print function" $ do+ calledRef <- newIORef False+ let printFn = \_ -> writeIORef calledRef True+ _ <- shelly $ print_commands True $ print_commands_with printFn $ run "echo" []+ called <- readIORef calledRef+ called @?= True
test/src/ReadFileSpec.hs view
@@ -3,11 +3,6 @@ module ReadFileSpec (readFileSpec) where import TestInit-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706-import Prelude hiding ( FilePath, catch)-#else-import Prelude hiding ( FilePath)-#endif import qualified Data.ByteString as BS import qualified Data.Text as T @@ -16,8 +11,7 @@ it "readBinary" $ do res <- shelly $ readBinary "test/data/zshrc" assert (BS.length res > 0)- + it "readfile" $ do res <- shelly $ readfile "test/data/zshrc" assert (T.length res > 0)-
test/src/RmSpec.hs view
@@ -1,6 +1,7 @@ module RmSpec (rmSpec) where import TestInit+import Data.Text as T import Help rmSpec :: Spec@@ -56,7 +57,7 @@ it "rm" $ do res <- shelly $ do writefile b "b"- cmd "ln" "-s" b l+ _ <- cmd "ln" "-s" (T.pack b) (T.pack l) rm l test_f b assert res@@ -65,7 +66,7 @@ it "rm_f" $ do res <- shelly $ do writefile b "b"- cmd "ln" "-s" b l+ _ <- cmd "ln" "-s" (T.pack b) (T.pack l) rm_f l test_f b assert res@@ -75,7 +76,7 @@ res <- shelly $ do mkdir d writefile (d</>b) "b"- cmd "ln" "-s" (d</>b) l+ _ <- cmd "ln" "-s" (T.pack $ d</>b) (T.pack l) rm_rf l test_f (d</>b) assert res
test/src/RunSpec.hs view
@@ -3,6 +3,7 @@ import TestInit import qualified Data.Text as T+import Data.Text (Text) import System.IO runSpec :: Spec@@ -18,13 +19,117 @@ it "without escaping" $ do res <- shelly $ escaping False $ run "echo" [ "*" ]- assert $ "README.md" `elem` T.words res+ if isWindows+ then res @?= "*\n"+ else assert $ "README.md" `elem` T.words res it "with binary handle mode" $ do res <- shelly $ onCommandHandles (initOutputHandles (flip hSetBinaryMode True)) $ run "cat" [ "test/data/nonascii.txt" ]- res @?= "Selbstverst\228ndlich \252berraschend\n"+ if isWindows+ then res @?= "Selbstverst\228ndlich \252berraschend\r\n"+ else res @?= "Selbstverst\228ndlich \252berraschend\n"+ unless isWindows $ do+ it "script at $PWD" $ do+ res <- shelly $ do+ run_ "chmod" ["+x", "test/data/hello.sh"]+ run "./test/data/hello.sh" []+ res @?= "Hello!\n" + describe "cmd" $ do+ let shouldBeTxt res t = res @?= (t :: Text)++ it "with Text" $ do+ res <- shelly $ cmd "echo" ("wibble" :: Text)+ res `shouldBeTxt` "wibble\n"++ it "with String" $ do+ res <- shelly $ cmd "echo" "wibble"+ res `shouldBeTxt` "wibble\n"++ it "with [Text]" $ do+ res <- shelly $ cmd "echo" (["wibble"] :: [Text])+ res `shouldBeTxt` "wibble\n"++ it "with [String]" $ do+ res <- shelly $ cmd "echo" ["wibble"]+ res `shouldBeTxt` "wibble\n"++ -- Check all two argument permutations (with replacement) of { Text, String, [Text], [String] }.+ it "with Text and Text" $ do+ res <- shelly $ cmd "echo" ("wibble" :: Text) ("wobble" :: Text)+ res `shouldBeTxt` "wibble wobble\n"++ it "with Text and String" $ do+ res <- shelly $ cmd "echo" ("wibble" :: Text) "wobble"+ res `shouldBeTxt` "wibble wobble\n"++ it "with Text and [Text]" $ do+ res <- shelly $ cmd "echo" ("wibble" :: Text) (["wobble", "wurble"] :: [Text])+ res `shouldBeTxt` "wibble wobble wurble\n"++ it "with Text and [String]" $ do+ res <- shelly $ cmd "echo" ("wibble" :: Text) ["wobble", "wurble"]+ res `shouldBeTxt` "wibble wobble wurble\n"++ it "with String and Text" $ do+ res <- shelly $ cmd "echo" "wibble" ("wobble" :: Text)+ res `shouldBeTxt` "wibble wobble\n"++ it "with String and String" $ do+ res <- shelly $ cmd "echo" "wibble" "wobble"+ res `shouldBeTxt` "wibble wobble\n"++ it "with String and [Text]" $ do+ res <- shelly $ cmd "echo" "wibble" (["wobble", "wurble"] :: [Text])+ res `shouldBeTxt` "wibble wobble wurble\n"++ it "with [Text] and Text" $ do+ res <- shelly $ cmd "echo" (["wibble", "wobble"] :: [Text]) ("wurble" :: Text)+ res `shouldBeTxt` "wibble wobble wurble\n"++ it "with [Text] and String" $ do+ res <- shelly $ cmd "echo" (["wibble", "wobble"] :: [Text]) "wurble"+ res `shouldBeTxt` "wibble wobble wurble\n"++ it "with [Text] and [Text]" $ do+ res <- shelly $ cmd "echo" (["wibble", "wobble"] :: [Text]) (["wurble"] :: [Text])+ res `shouldBeTxt` "wibble wobble wurble\n"++ it "with [Text] and [String]" $ do+ res <- shelly $ cmd "echo" (["wibble", "wobble"] :: [Text]) ["wurble"]+ res `shouldBeTxt` "wibble wobble wurble\n"++ it "with [String] and Text " $ do+ res <- shelly $ cmd "echo" ["wibble", "wobble"] ("wurble" :: Text)+ res `shouldBeTxt` "wibble wobble wurble\n"++ it "with [String] and String " $ do+ res <- shelly $ cmd "echo" ["wibble", "wobble"] "wurble"+ res `shouldBeTxt` "wibble wobble wurble\n"++ it "with [String] and [Text] " $ do+ res <- shelly $ cmd "echo" ["wibble", "wobble"] (["wurble"] :: [Text])+ res `shouldBeTxt` "wibble wobble wurble\n"++ it "with [String] and [String] " $ do+ res <- shelly $ cmd "echo" ["wibble", "wobble"] ["wurble"]+ res `shouldBeTxt` "wibble wobble wurble\n"++ -- Check unit cases+ it "returns Unit" $ do+ res <- shelly $ cmd "echo" "wibble" "wobble"+ res @?= ()++ it "works with underscore" $ do+ _ <- shelly $ cmd "echo" "wibble" "wobble"+ True `shouldBe` True++ -- This should now compile without a warning since ghc should infer Sh () instead of Sh Text.+ it "defaults to Unit" $ do+ shelly $ cmd "echo" "wibble" "wobble"+ True `shouldBe` True+ -- Bash-related commands describe "bash" $ do it "simple command" $ do@@ -38,7 +143,9 @@ it "with binary handle mode" $ do res <- shelly $ onCommandHandles (initOutputHandles (flip hSetBinaryMode True)) $ bash "cat" [ "test/data/nonascii.txt" ]- res @?= "Selbstverst\228ndlich \252berraschend\n"+ if isWindows+ then res @?= "Selbstverst\228ndlich \252berraschend\r\n"+ else res @?= "Selbstverst\228ndlich \252berraschend\n" {- This throws spurious errors on some systems it "can detect failing commands in pipes" $ do@@ -51,8 +158,13 @@ it "preserve pipe behaviour" $ do (eCode, res) <- shelly $ escaping False $ errExit False $ do- res <- bash "echo" [ "'foo'", "|", "echo", "'bar'" ]+ res <-+ if isWindows+ then bash "echo" [ "foo", "|", "echo", "bar" ]+ else bash "echo" [ "'foo'", "|", "echo", "'bar'" ] eCode <- lastExitCode return (eCode, res)- res @?= "bar\n"+ if isWindows+ then res @?= "bar'\n"+ else res @?= "bar\n" eCode @?= 0
+ test/src/ShowCommandSpec.hs view
@@ -0,0 +1,37 @@+module ShowCommandSpec (showCommandSpec) where++import TestInit++showCommandSpec :: Spec+showCommandSpec = do+ describe "show_command" $ do+ it "preserves the empty string" $ do+ show_command "echo" [""] @?= "echo \"\""++ it "does not quote arguments that do not contain special characters" $ do+ show_command "echo" ["a1~!@#%^-_+=:,.?/"] @?= "echo a1~!@#%^-_+=:,.?/"++ it "quotes whitespace" $ do+ show_command "echo" [" "] @?= "echo \" \""+ show_command "echo" ["\t"] @?= "echo \"\t\""+ show_command "echo" ["\r"] @?= "echo \"\r\""+ show_command "echo" ["\n"] @?= "echo \"\n\""+++ it "quotes arguments that contain special characters" $ do+ show_command "echo" ["'"] @?= "echo \"'\""+ show_command "echo" ["&"] @?= "echo \"&\""+ show_command "echo" ["|"] @?= "echo \"|\""+ show_command "echo" [";"] @?= "echo \";\""+ show_command "echo" ["("] @?= "echo \"(\""+ show_command "echo" [")"] @?= "echo \")\""+ show_command "echo" ["{"] @?= "echo \"{\""+ show_command "echo" ["}"] @?= "echo \"}\""+ show_command "echo" ["<"] @?= "echo \"<\""+ show_command "echo" [">"] @?= "echo \">\""++ it "escapes the few special characters that must be escaped even in quotes" $ do+ show_command "echo" ["\""] @?= "echo \"\\\"\""+ show_command "echo" ["\\"] @?= "echo \"\\\\\""+ show_command "echo" ["$"] @?= "echo \"\\$\""+ show_command "echo" ["`"] @?= "echo \"\\`\""
test/src/SshSpec.hs view
@@ -1,18 +1,39 @@+{-# LANGUAGE OverloadedStrings #-} module SshSpec ( sshSpec ) where import TestInit+import qualified Data.Text as T sshSpec :: Spec sshSpec = do+ let q = "'" -- a single quote+ let qq = "'\\''" -- quote of a single quote+ let qqq = T.concat [qq, "\\", qq, qq] -- quote of qq describe "sshCommandText" $ do it "simple command" $ do let res = sshCommandText [("wibble", [])] SeqSsh- res @?= "\"wibble\""+ res @?= T.concat [q, qq, "wibble", qq, q] it "space command" $ do let res = sshCommandText [("to", ["outer space"])] SeqSsh- res @?= "\"to 'outer space'\""+ res @?= T.concat [q, qq, "to", qq, " ", qq, "outer space", qq ,q] it "multiple space commands" $ do let res = sshCommandText [("to", ["outer space"]), ("and", ["back again"])] SeqSsh- res @?= "\"to 'outer space' && and 'back again'\""+ res @?= T.concat+ [ q, qq, "to", qq, " ", qq, "outer space", qq+ , " && "+ , qq, "and", qq, " ", qq, "back again", qq, q+ ]++ it "commands with quotes and spaces" $ do+ let res = sshCommandText [ ("echo", ["Godfater's brother, Tom says: \"huh??\""])+ , ("foo", ["--dir", "Tom's father/"])] SeqSsh+ res @?= T.concat+ [ q, qq, "echo", qq, " "+ , qq, "Godfater", qqq, "s brother, Tom says: \"huh??\"", qq+ , " && "+ , qq, "foo", qq, " "+ , qq, "--dir", qq, " "+ , qq, "Tom", qqq, "s father/", qq, q+ ]
test/src/TestInit.hs view
@@ -1,10 +1,13 @@-module TestInit (module Export) where+module TestInit (module Export, isWindows) where -import Test.HUnit as Export hiding (path) +import Test.HUnit as Export hiding (path) import Test.Hspec as Export #ifdef LIFTED import Shelly.Lifted as Export #else import Shelly as Export #endif-import Test.Hspec.HUnit ()+import Test.Hspec.Contrib.HUnit ()+import System.Info(os)+isWindows :: Bool+isWindows = os == "mingw32"
test/src/TestMain.hs view
@@ -7,12 +7,15 @@ import MoveSpec import RmSpec import FindSpec+import PrintCommandsFnSpec import EnvSpec import FailureSpec import CopySpec import LiftedSpec import RunSpec+import ShowCommandSpec import SshSpec+import PipeSpec import Test.Hspec @@ -24,9 +27,12 @@ moveSpec rmSpec findSpec+ printCommandsFnSpec envSpec failureSpec copySpec liftedSpec runSpec+ showCommandSpec sshSpec+ pipeSpec
test/src/WhichSpec.hs view
@@ -11,7 +11,7 @@ it "recognizes cabal as a path executable" $ do res <- shelly $ test_px "find" True @?= res- + it "cannot find missing exe" $ do Nothing <- shelly $ which "alskjdf;ashlva;ousnva;nj" assert True
test/src/WriteSpec.hs view
@@ -1,7 +1,6 @@ module WriteSpec ( writeSpec ) where import TestInit-import Prelude hiding (FilePath) import Data.Text (Text) default (Text)