shelly 1.5.4.1 → 1.12.1.1
raw patch · 42 files changed
Files
- ChangeLog.md +185/−0
- LICENSE +1/−1
- README.md +185/−0
- shelly.cabal +216/−57
- src/Shelly.hs +562/−344
- src/Shelly/Base.hs +110/−92
- src/Shelly/Directory.hs +23/−0
- src/Shelly/Find.hs +52/−39
- src/Shelly/Lifted.hs +70/−54
- src/Shelly/Pipe.hs +98/−83
- src/Shelly/Unix.hs +12/−0
- test/data/hello.sh +3/−0
- test/data/nonascii.txt +1/−0
- test/data/symlinked_dir/hoge_file +0/−0
- test/data/zshrc +2795/−0
- test/examples/color.hs +12/−0
- test/examples/drain.hs +19/−0
- test/examples/drain.sh +4/−0
- test/examples/printer.sh +6/−0
- test/examples/run-handles.hs +8/−0
- test/examples/test.sh +2/−0
- test/src/CopySpec.hs +80/−0
- test/src/EnvSpec.hs +34/−0
- test/src/FailureSpec.hs +29/−0
- test/src/FindSpec.hs +137/−0
- test/src/Help.hs +19/−0
- test/src/LiftedSpec.hs +23/−0
- test/src/LogWithSpec.hs +18/−0
- test/src/MoveSpec.hs +76/−0
- test/src/PipeSpec.hs +97/−0
- test/src/PrintCommandsFnSpec.hs +14/−0
- test/src/ReadFileSpec.hs +17/−0
- test/src/RmSpec.hs +83/−0
- test/src/RunSpec.hs +170/−0
- test/src/ShowCommandSpec.hs +37/−0
- test/src/SshSpec.hs +39/−0
- test/src/TestInit.hs +13/−0
- test/src/TestMain.hs +38/−0
- test/src/WhichSpec.hs +17/−0
- test/src/WriteSpec.hs +40/−0
- test/src/sleep.hs +9/−0
- test/testall +57/−0
+ ChangeLog.md view
@@ -0,0 +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++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++Greg Weber, 2016-06-26+* Added `sshPairsWithOptions` function.++# 1.6.7++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++Greg Weber, 2016-04-21+* Add `prependToPath` function.++# 1.6.5++Greg Weber, 2015-12-10+* Expose `MonadShControl`.++# 1.6.4.1++Greg Weber, 2015-12-01+* Add `writeBinary` function.
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2010, Petr Rockai <me@mornfall.net>+Copyright (c) 2017, Petr Rockai <me@mornfall.net> All rights reserved.
+ README.md view
@@ -0,0 +1,185 @@+# Shelly++[](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)++Shelly provides a single module for convenient systems programming in Haskell.++* 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.++++## More shelly packages++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](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)+++### Blog Posts++* [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](https://www.reddit.com/r/haskell/comments/w86gu/my_current_job_task_is_boring_so_i_wrote_a_simple/)++### Help++* [google group for Haskell shell scripting](https://groups.google.com/forum/#!forum/haskell-shell-scripting)++## Alternatives++### Haskell shell scripting libraries+++* [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, 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.+For some this is an absolutely critical feature, particularly given that Haskell does not yet offer up stack traces.+++### Haskell file-finding supplements++* [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.+++### Shell commands with richer input/output++Shelly does not change the nature of shell scripting (text in, text out).+If you want something more revolutionary you might try these:++* [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++Shelly's main goal is ease of use.+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`.++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+ {-# 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"+ 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]+ uploads "my-server:/remote/path/" ["deploy"]+ sshPairs_ "my-server" [("cd", ["/remote/path"]), ("./deploy", [])]+ else do+ cmd "./script/angel"++ -- same path on remote host+ -- will create directories+ 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++Yes, as seen above you can write variadic functions in Haskell quite easily, you just can't compose them as easily.+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 ...`.++### Using Text and FilePath together++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 `Text` into a `FilePath` automatically.++Manual conversion is done through `toTextIgnore` or `toTextWarn`.+++### Thread-safe working directory and relative paths++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`.+++### Good error messages++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`.+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 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`.
shelly.cabal view
@@ -1,74 +1,233 @@-Name: shelly+cabal-version: 2.0 -Version: 1.5.4.1-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/data/symlinked_dir/hoge_file+ test/data/hello.sh+ test/testall+ Library- Exposed-modules: Shelly, Shelly.Lifted, Shelly.Pipe- 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.5,- directory >= 1.1.0.0 && < 1.3.0.0,- mtl >= 2,- process >= 1.0,- unix-compat < 0.5,- system-filepath >= 0.4.7 && < 0.5,- system-fileio < 0.4,- monad-control >= 0.3.2 && < 0.4,- lifted-base,- lifted-async,- exceptions == 0.6.*,- 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: test/src+ main-is: TestMain.hs+ other-modules:+ CopySpec+ EnvSpec+ FailureSpec+ FindSpec+ Help+ LiftedSpec+ MoveSpec+ PipeSpec+ PrintCommandsFnSpec+ ReadFileSpec+ RmSpec+ RunSpec+ ShowCommandSpec+ SshSpec+ TestInit+ WhichSpec+ WriteSpec++ ghc-options:+ -threaded+ -Wall+ -Wcompat+ -fwarn-tabs+ -funbox-strict-fields+ -fno-warn-type-defaults++ default-language: Haskell2010+ default-extensions:+ OverloadedStrings+ ExtendedDefaultRules++ if flag(lifted)+ cpp-options: -DLIFTED++ build-depends:+ 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++ default-extensions:+ CPP++Flag build-examples+ Description: build some example programs+ Default: False+ Manual: True++-- 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+ , shelly+ , text++ default-extensions:+ CPP+ else+ buildable: False++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+ , shelly+ , text++ default-extensions:+ CPP+ else+ buildable: False++Executable Color+ hs-source-dirs: test/examples+ main-is: color.hs+ default-language: Haskell2010+ if flag(build-examples)+ buildable: True++ build-depends: base+ , process+ , shelly+ , text+ else+ buildable: False
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,56 +22,65 @@ -- > 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 , command, command_, command1, command1_- , sshPairs, sshPairs_+ , sshPairs,sshPairsPar, sshPairs_,sshPairsPar_, sshPairsWithOptions+ , sshCommandText, SshMode(..) , ShellCmd(..), CmdArg (..) -- * Running commands Using handles , runHandle, runHandles, transferLinesAndCombine, transferFoldHandleLines , StdHandle(..), StdStream(..) + -- * Handle manipulation+ , HandleInitializer, StdInit(..), initOutputHandles, initAllHandles - -- * Modifying and querying environment.- , setenv, get_env, get_env_text, getenv, get_env_def, get_env_all, get_environment, appendToPath+ -- * 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- , readfile, readBinary, writefile, appendfile, touchfile, withTmpDir+ , readfile, readBinary, writefile, writeBinary, appendfile, touchfile, withTmpDir -- * exiting the program , exit, errorExit, quietExit, terror -- * Exceptions , bracket_sh, catchany, catch_sh, handle_sh, handleany_sh, finally_sh, ShellyHandler(..), catches_sh, catchany_sh+ , ReThrownException(..)+ , RunFailed(..) -- * convert between Text and FilePath- , toTextIgnore, toTextWarn, FP.fromText+ , toTextIgnore, toTextWarn, fromText -- * Utility Functions , whenM, unlessM, time, sleep@@ -82,130 +93,101 @@ -- * find functions , find, findWhen, findFold, findDirFilter, findDirFilterWhen, findFoldDirFilter+ , followSymlink ) 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 hiding (handle)-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: --@@ -219,38 +201,42 @@ 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 -> Handle -> IO Text-transferLinesAndCombine h1 h2 = transferFoldHandleLines mempty (|>) h1 h2 >>=+transferLinesAndCombine :: Handle -> (Text -> IO ()) -> IO Text+transferLinesAndCombine readHandle putWrite =+ transferFoldHandleLines mempty (|>) readHandle putWrite >>= return . lineSeqToText lineSeqToText :: Seq Text -> Text@@ -261,17 +247,17 @@ -- | 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-transferFoldHandleLines :: a -> FoldCallback a -> Handle -> Handle -> IO a-transferFoldHandleLines start foldLine readHandle writeHandle = go start+-- 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 go acc = do mLine <- filterIOErrors $ TIO.hGetLine readHandle case mLine of Nothing -> return acc- Just line -> TIO.hPutStrLn writeHandle line >> go (foldLine acc line)+ Just line -> putWrite line >> go (foldLine acc line) filterIOErrors :: IO a -> IO (Maybe a) filterIOErrors action = catchIOError@@ -289,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@@ -307,45 +293,53 @@ 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 fp = do- mExe <- which exe+ findExe+#if defined(mingw32_HOST_OS)+ fp+#else+ _fp+#endif+ = do+ mExe <- whichEith exe case mExe of- Just execFp -> return execFp+ Right execFp -> return execFp -- windows looks in extra places besides the PATH, so just give -- up even if the behavior is not properly specified anymore -- -- 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)- Nothing -> return fp+#if defined(mingw32_HOST_OS)+ Left _ -> return fp #else- Nothing -> liftIO $ throwIO $ userError $- "shelly did not find " `mappend` encodeString fp `mappend`- if absolute exe then "" else " in the PATH"+ 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+ , detach_console = False+ , create_new_console = False+ , new_session = False+ , child_group = Nothing+ , child_user = Nothing+#if MIN_VERSION_process(1,5,0)+ , use_process_jobs = False #endif } return ( just $ createdInH <|> toHandle mInH@@ -361,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@@ -394,22 +389,22 @@ -- | Same as a normal 'catch' but specialized for the Sh monad. catch_sh :: (Exception e) => Sh a -> (e -> Sh a) -> Sh a-catch_sh action handle = do+catch_sh action handler = do ref <- ask- liftIO $ catch (runSh action ref) (\e -> runSh (handle e) ref)+ liftIO $ catch (runSh action ref) (\e -> runSh (handler e) ref) --- | Same as a normal 'catch' but specialized for the Sh monad.-handle_sh :: (Exception e) => Sh a -> (e -> Sh a) -> Sh a-handle_sh action handle = do+-- | Same as a normal 'handle' but specialized for the Sh monad.+handle_sh :: (Exception e) => (e -> Sh a) -> Sh a -> Sh a+handle_sh handler action = do ref <- ask- liftIO $ catch (runSh action ref) (\e -> runSh (handle e) ref)+ liftIO $ handle (\e -> runSh (handler e) ref) (runSh action ref) -- | Same as a normal 'finally' but specialized for the 'Sh' monad. finally_sh :: Sh a -> Sh b -> Sh a-finally_sh action handle = do+finally_sh action handler = do ref <- ask- liftIO $ finally (runSh action ref) (runSh handle ref)+ liftIO $ finally (runSh action ref) (runSh handler ref) bracket_sh :: Sh a -> (a -> Sh b) -> (a -> Sh c) -> Sh c bracket_sh acquire release main = do@@ -431,18 +426,18 @@ liftIO $ catches (runner action) $ map (toHandler runner) handlers where toHandler :: (Sh a -> IO a) -> ShellyHandler a -> Handler a- toHandler runner (ShellyHandler handle) = Handler (\e -> runner (handle e))+ 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 an exception in the Sh monad.-handleany_sh :: Sh a -> (SomeException -> Sh a) -> Sh a+-- | 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 ()@@ -454,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:@@ -562,18 +556,23 @@ 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 -- @PATH@: this does not duplicate that behavior. which :: FilePath -> Sh (Maybe FilePath)-which originalFp = whichFull+which fp = either (const Nothing) Just <$> whichEith fp++-- | Get a full path to an executable by looking at the @PATH@ environement+-- variable. Windows normally looks in additional places besides the+-- @PATH@: this does not duplicate that behavior.+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@@ -581,50 +580,57 @@ whichFull fp = do (trace . mappend "which " . toTextIgnore) fp >> whichUntraced where- whichUntraced | absolute fp = checkFile- | length (splitDirectories fp) > 0 = lookupPath- | otherwise = lookupCache- checkFile = do- exists <- liftIO $ isFile fp- return $ toMaybe exists fp+ whichUntraced | isAbsolute fp = checkFile+ | startsWithDot splitOnDirs = checkFile+ | otherwise = lookupPath >>= leftPathError - lookupPath =- (pathDirs >>=) $ findMapM $ \dir -> do- let fullFp = dir </> fp- res <- liftIO $ isExecutable fullFp- return $ toMaybe res fullFp+ splitOnDirs = splitDirectories fp - lookupCache = do- pathExecutables <- cachedPathExecutables- liftIO $ print pathExecutables- return $ fmap (flip (</>) fp . fst) $- L.find (S.member fp . snd) pathExecutables+ -- '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 $ doesFileExist fp+ return $ if exists then Right fp else+ Left $ "did not find file: " <> fp - pathDirs = mapM absPath =<< ((map FP.fromText . T.split (== searchPathSeparator)) `fmap` get_env_text "PATH")+ leftPathError :: Maybe FilePath -> Sh (Either String FilePath)+ leftPathError Nothing = Left <$> pathLookupError+ leftPathError (Just x) = return $ Right x - 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+ pathLookupError :: Sh String+ pathLookupError = do+ pATH <- get_env_text "PATH"+ return $+ "shelly did not find " `mappend` fp `mappend`+ " in the PATH: " `mappend` T.unpack pATH + lookupPath :: Sh (Maybe FilePath)+ lookupPath = (pathDirs >>=) $ findMapM $ \dir -> do+ let fullFp = dir </> fp+ res <- liftIO $ isExecutable fullFp+ return $ if res then Just fullFp else Nothing --- | Returns 'Just' if the precondition is fulfilled.-toMaybe :: Bool -> a -> Maybe a-toMaybe False _ = Nothing-toMaybe True x = Just x+ 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)@@ -643,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@@ -661,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@@ -688,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@@ -699,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 ()@@ -708,33 +715,55 @@ 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.+prependToPath :: FilePath -> Sh ()+prependToPath = traceAbsPath ("prependToPath: " <>) >=> \filepath -> do+ tp <- toTextWarn filepath+ pe <- get_env_text path_env+ setPath $ tp <> T.singleton searchPathSeparator <> pe+ get_environment :: Sh [(String, String)] 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 -> toMaybe (not $ T.null val) val+ 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" #-}@@ -745,12 +774,27 @@ 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).+initOutputHandles :: HandleInitializer -> StdInit+initOutputHandles f = StdInit (const $ return ()) f f +-- | Apply a single initializer to all three standard process handles (stdin, stdout and stderr).+initAllHandles :: HandleInitializer -> StdInit+initAllHandles f = StdInit f f f++-- | When running an external command, apply the given initializers to+-- the specified handles for that command.+-- This can for example be used to change the encoding of the+-- handles or set them into binary mode.+onCommandHandles :: StdInit -> Sh a -> Sh a+onCommandHandles initHandles a =+ sub $ modify (\x -> x { sInitCommandHandles = initHandles }) >> a+ -- | Create a sub-Sh in which external command outputs are not echoed and -- commands are not printed. -- See 'sub'.@@ -771,6 +815,22 @@ , sPrintCommands = True }) >> a +-- | Create a sub-Sh in which stdout is sent to the user-defined+-- logger. When running with 'silently' the given log will not be+-- called for any output. Likewise the log will also not be called for+-- output from 'run_' and 'bash_' commands.+log_stdout_with :: (Text -> IO ()) -> Sh a -> Sh a+log_stdout_with logger a = sub $ modify (\s -> s { sPutStdout = logger })+ >> a++-- | Create a sub-Sh in which stderr is sent to the user-defined+-- logger. When running with 'silently' the given log will not be+-- called for any output. However, unlike 'log_stdout_with' the log+-- will be called for output from 'run_' and 'bash_' commands.+log_stderr_with :: (Text -> IO ()) -> Sh a -> Sh a+log_stderr_with logger a = sub $ modify (\s -> s { sPutStderr = logger })+ >> a+ -- | Create a sub-Sh with stdout printing on or off -- Defaults to True. print_stdout :: Bool -> Sh a -> Sh a@@ -789,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.@@ -811,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 }@@ -826,9 +893,7 @@ -- see the 'run' documentation. escaping :: Bool -> Sh a -> Sh a escaping shouldEscape action = sub $ do- modify $ \st -> st { sRun =- if shouldEscape then runCommand else runCommandNoEscape- }+ modify $ \st -> st { sCommandEscaping = shouldEscape } action -- | named after bash -e errexit. Defaults to @True@.@@ -840,6 +905,15 @@ modify $ \st -> st { sErrExit = shouldExit } action +-- | 'find'-command follows symbolic links. Defaults to @False@.+-- When @True@, follow symbolic links.+-- When @False@, never follow symbolic links.+followSymlink :: Bool -> Sh a -> Sh a+followSymlink enableFollowSymlink action = sub $ do+ modify $ \st -> st { sFollowSymlink = enableFollowSymlink }+ action++ defReadOnlyState :: ReadOnlyState defReadOnlyState = ReadOnlyState { rosFailToDir = False } @@ -850,11 +924,22 @@ shellyNoDir = shelly' ReadOnlyState { rosFailToDir = False } {-# DEPRECATED shellyNoDir "Just use shelly. The default settings have changed" #-} --- Using this entry point creates a @.shelly@ directory in the case+-- | Using this entry point creates a @.shelly@ directory in the case -- of failure where errors are recorded. 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@@ -864,15 +949,19 @@ 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+ , sPutStdout = TIO.hPutStrLn stdout+ , sPutStderr = TIO.hPutStrLn stderr , sPrintStdout = True , sPrintStderr = True , sPrintCommands = False- , sRun = runCommand+ , sPrintCommandsFn = TIO.hPutStrLn stdout+ , sInitCommandHandles = initAllHandles (const $ return ())+ , sCommandEscaping = True , sEnvironment = environment , sTracing = True , sTrace = T.empty@@ -880,6 +969,7 @@ , sPathExecutables = Nothing , sErrExit = True , sReadOnly = ros+ , sFollowSymlink = False } stref <- liftIO $ newIORef def let caught =@@ -903,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@@ -917,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@@ -928,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) =@@ -942,48 +1032,109 @@ 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 --- | same as 'sshPairs', but returns ()+data SshMode = ParSsh | SeqSsh++-- | Same as 'sshPairs', but returns @()@. sshPairs_ :: Text -> [(FilePath, [Text])] -> Sh () sshPairs_ _ [] = return () sshPairs_ server cmds = sshPairs' run_ server cmds --- | run commands over SSH.--- An ssh executable is expected in your path.+-- | 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. -- 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 = sshPairs' run server cmds+sshPairs server cmds = sshPairsWithOptions' run server [] cmds SeqSsh +-- | 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++sshPairsPar' :: (FilePath -> [Text] -> Sh a) -> Text -> [(FilePath, [Text])] -> Sh a+sshPairsPar' run' server actions = sshPairsWithOptions' run' server [] actions ParSsh+ sshPairs' :: (FilePath -> [Text] -> Sh a) -> Text -> [(FilePath, [Text])] -> Sh a-sshPairs' run' server actions = escaping False $ do- let ssh_commands = surround '\'' $ foldl1- (\memo next -> memo <> " && " <> next)- (map toSSH actions)- run' "ssh" [server, ssh_commands]- where- toSSH (exe,args) = show_command exe args+sshPairs' run' server actions = sshPairsWithOptions' run' server [] actions SeqSsh +-- | Like 'sshPairs', but allows for arguments to the call to @ssh@.+sshPairsWithOptions :: Text -- ^ Server name.+ -> [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 ""+sshPairsWithOptions server sshargs cmds = sshPairsWithOptions' run server sshargs cmds SeqSsh -data QuietExit = QuietExit Int deriving (Show, Typeable)+sshPairsWithOptions' :: (FilePath -> [Text] -> Sh a) -> Text -> [Text] -> [(FilePath, [Text])] -> SshMode -> Sh a+sshPairsWithOptions' run' server sshargs actions mode = escaping False $ do+ run' "ssh" ([server] ++ sshargs ++ [sshCommandText actions mode])++sshCommandText :: [(FilePath, [Text])] -> SshMode -> Text+sshCommandText actions mode =+ quoteOne (foldl1 joiner (map (uncurry quoteCommand) actions))+ where+ joiner memo next = case mode of+ SeqSsh -> memo <> " && " <> next+ ParSsh -> memo <> " & " <> next++data QuietExit = QuietExit Int deriving (Show) instance Exception QuietExit -data ReThrownException e = ReThrownException e String deriving (Typeable)+-- | Shelly's wrapper around exceptions thrown in its monad+data ReThrownException e = ReThrownException e String instance Exception e => Exception (ReThrownException e) instance Exception e => Show (ReThrownException e) where show (ReThrownException ex msg) = "\n" ++@@ -997,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_',@@ -1012,69 +1163,107 @@ -- 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 --- | bind some arguments to run for re-use. Example:+-- | 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++bash_ :: FilePath -> [Text] -> Sh ()+bash_ fp args = escaping False $ run_ "bash" $ bashArgs fp args++bashArgs :: FilePath -> [Text] -> [Text]+bashArgs fp args = ["-c", "'" <> sanitise (toTextIgnore fp : args) <> "'"]+ where+ sanitise = T.replace "'" "\'" . T.intercalate " "++-- | 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:+-- -- > 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 ([one_arg] ++ args ++ more_args)+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 ([one_arg] ++ args ++ more_args)+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_ = runFoldLines () (\_ _ -> ())+run_ exe args = do+ state <- get+ if sPrintStdout state+ then runWithColor_+ else runFoldLines () (\_ _ -> ()) exe args+ where+ -- same a runFoldLines except Inherit Stdout+ -- That allows color to show up+ runWithColor_ =+ runHandles exe args [OutHandle Inherit] $ \inH _ errH -> do+ state <- get+ errs <- liftIO $ do+ hClose inH -- setStdin was taken care of before the process even ran+ errVar <- (putHandleIntoMVar mempty (|>) errH (sPutStderr state) (sPrintStderr state))+ lineSeqToText `fmap` wait errVar+ modify $ \state' -> state' { sStderr = errs }+ return () liftIO_ :: IO a -> Sh ()-liftIO_ action = void (liftIO action)+liftIO_ = void . liftIO -- | 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- errPromise <- liftIO $ async $ transferLinesAndCombine errH stderr+ state <- get+ errVar <- liftIO $+ (putHandleIntoMVar mempty (|>) errH (sPutStderr state) (sPrintStderr state)) res <- withHandle outH- errs <- liftIO $ wait errPromise-+ errs <- liftIO $ lineSeqToText `fmap` wait errVar modify $ \state' -> state' { sStderr = errs } return res -- | 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@@ -1083,13 +1272,21 @@ 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+ bracket_sh- ((sRun state) reusedHandles state exe args)+ (doRun reusedHandles state exe args) (\(_,_,_,procH) -> (liftIO $ terminateProcess procH)) (\(inH,outH,errH,procH) -> do++ liftIO $ do+ inInit (sInitCommandHandles state) inH+ outInit (sInitCommandHandles state) outH+ errInit (sInitCommandHandles state) errH+ liftIO $ case mStdin of Just input -> TIO.hPutStr inH input Nothing -> return ()@@ -1118,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@@ -1127,21 +1324,22 @@ (errVar, outVar) <- liftIO $ do hClose inH -- setStdin was taken care of before the process even ran liftM2 (,)- (putHandleIntoMVar mempty (|>) errH stderr (sPrintStderr state))- (putHandleIntoMVar start cb outH stdout (sPrintStdout state))+ (putHandleIntoMVar mempty (|>) errH (sPutStderr state) (sPrintStderr state))+ (putHandleIntoMVar start cb outH (sPutStdout state) (sPrintStdout state)) errs <- liftIO $ lineSeqToText `fmap` wait errVar modify $ \state' -> state' { sStderr = errs } liftIO $ wait outVar -putHandleIntoMVar :: a -> FoldCallback a- -> Handle -- ^ out handle- -> Handle -- ^ in handle- -> Bool -- ^ should it be printed while transfered?- -> IO (Async a)-putHandleIntoMVar start cb outH inHandle shouldPrint = liftIO $ async $ do+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 inHandle+ then transferFoldHandleLines start cb outH putWrite else foldHandleLines start cb outH @@ -1154,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@@ -1168,87 +1366,107 @@ 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 trace "withTmpDir" dir <- liftIO getTemporaryDirectory tid <- liftIO myThreadId- (pS, handle) <- liftIO $ openTempFile dir ("tmp" ++ filter isAlphaNum (show tid))+ (pS, fhandle) <- liftIO $ openTempFile dir ("tmp" ++ filter isAlphaNum (show tid)) let p = pack pS- liftIO $ hClose handle -- required on windows+ liftIO $ hClose fhandle -- required on windows rm_f p mkdir p act p `finally_sh` rm_rf p --- | Write a Lazy 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 f bytes)+ -- | Update a file, creating (a blank file) if it does not exist. touchfile :: FilePath -> Sh () touchfile = traceAbsPath ("touch " <>) >=> flip appendfile "" --- | Append a Lazy 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.+-- | 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) time what = sub $ do trace "time"@@ -1257,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,19 +7,19 @@ {-# 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(..), FilePath, Text,+ Sh(..), ShIO, runSh, State(..), ReadOnlyState(..), StdHandle(..),+ HandleInitializer, StdInit(..),+ FilePath, Text, relPath, path, absPath, canonic, canonicalize, test_d, test_s, 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,@@ -27,27 +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)@@ -57,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@@ -65,17 +62,25 @@ 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 instance MonadBaseControl IO Sh where+#if MIN_VERSION_monad_control(1,0,0)+ type StM Sh a = StM (ReaderT (IORef State) IO) a+ liftBaseWith f =+ Sh $ liftBaseWith $ \runInBase -> f $ \k ->+ runInBase $ unSh k+ restoreM = Sh . restoreM+#else newtype StM Sh a = StMSh (StM (ReaderT (IORef State) IO) a) liftBaseWith f = Sh $ liftBaseWith $ \runInBase -> f $ \k -> liftM StMSh $ runInBase $ unSh k restoreM (StMSh m) = Sh . restoreM $ m+#endif instance Catch.MonadThrow Sh where throwM = liftIO . Catch.throwM@@ -84,45 +89,56 @@ 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 data ReadOnlyState = ReadOnlyState { rosFailToDir :: Bool }-data State = State +data State = State { sCode :: Int -- ^ exit code for command that ran , sStdin :: Maybe Text -- ^ stdin for the command to be run , sStderr :: Text -- ^ stderr for command that ran , sDirectory :: FilePath -- ^ working directory+ , sPutStdout :: Text -> IO () -- ^ by default, hPutStrLn stdout , sPrintStdout :: Bool -- ^ print stdout of command that is executed+ , sPutStderr :: Text -> IO () -- ^ by default, hPutStrLn stderr , sPrintStderr :: Bool -- ^ print stderr of command that is executed , sPrintCommands :: Bool -- ^ print command that is executed- , sRun :: [StdHandle] -> State -> FilePath -> [Text] -> Sh (Handle, Handle, Handle, ProcessHandle) -- ^ command runner, a different runner is used when escaping, probably better to just hold the escaping flag+ , 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+ -- than passing to the shell for expansion , sEnvironment :: [(String, String)] , sPathExecutables :: Maybe [(FilePath, S.Set FilePath)] -- ^ cache of executables in the PATH , sTracing :: Bool -- ^ should we trace command execution , sTrace :: Text -- ^ the trace of command execution , sErrExit :: Bool -- ^ should we exit immediately on any error , sReadOnly :: ReadOnlyState+ , sFollowSymlink :: Bool -- ^ 'find'-command follows symlinks. } data StdHandle = InHandle StdStream | OutHandle StdStream | ErrorHandle StdStream --- | A monadic-conditional version of the "when" guard.+-- | Initialize a handle before using it.+type HandleInitializer = Handle -> IO ()++-- | A collection of initializers for the three standard process handles.+data StdInit =+ StdInit {+ inInit :: HandleInitializer,+ outInit :: HandleInitializer,+ errInit :: HandleInitializer+ }++-- | 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@@ -131,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@@ -145,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@@ -170,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@@ -203,49 +222,50 @@ -- 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 get :: Sh State get = do- stateVar <- ask + stateVar <- ask liftIO (readIORef stateVar) modify :: (State -> State) -> Sh () modify f = do- state <- ask + 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@@ -255,46 +275,44 @@ 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 = traceLiftIO TIO.putStrLn-echo_n = traceLiftIO $ (>> hFlush stdout) . TIO.putStr-echo_err = traceLiftIO $ TIO.hPutStrLn stderr-echo_n_err = traceLiftIO $ (>> hFlush stderr) . TIO.hPutStr stderr+echo msg = traceEcho msg >> liftIO (TIO.putStrLn msg >> hFlush stdout)+echo_n msg = traceEcho msg >> liftIO (TIO.putStr msg >> hFlush stdout)+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) -traceLiftIO :: (Text -> IO ()) -> Text -> Sh ()-traceLiftIO f msg = trace ("echo " `mappend` "'" `mappend` msg `mappend` "'") >> liftIO (f msg)+-- | @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` "'")+ -- | A helper to catch any exception (same as -- @... `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,45 +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- if isDir && 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 #-}@@ -25,18 +25,20 @@ module Shelly.Lifted ( MonadSh(..),+ MonadShControl(..), -- This is copied from Shelly.hs, so that we are sure to export the -- exact same set of symbols. Whenever that export list is updated, -- 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_@@ -48,24 +50,24 @@ , S.StdHandle(..), S.StdStream(..) - -- * Modifying and querying environment.- , setenv, get_env, get_env_text, get_env_all, appendToPath+ -- * 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@@ -78,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@@ -91,28 +93,26 @@ -- * find functions , S.find, S.findWhen, S.findFold, S.findDirFilter, S.findDirFilterWhen, S.findFoldDirFilter+ , 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@@ -129,44 +129,50 @@ 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)+ 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)+ 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)+ 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- return (a, s, mempty)+ return (a, s, mempty :: w) instance MonadSh m => S.ShellCmd (m Text) where cmdAll = (liftSh .) . S.run@@ -178,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 @@ -189,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 =@@ -221,7 +218,7 @@ => MonadShControl (WriterT w m) where newtype ShM (WriterT w m) a = WriterTShM (ShM m (a, w)) liftShWith f =- WriterT $ liftM (\x -> (x, mempty)) $ liftShWith $ \runInSh -> f $ \k ->+ WriterT $ liftM (\x -> (x, mempty :: w)) $ liftShWith $ \runInSh -> f $ \k -> liftM WriterTShM $ runInSh $ runWriterT k restoreSh (WriterTShM m) = WriterT . restoreSh $ m {-# INLINE liftShWith #-}@@ -231,19 +228,18 @@ => MonadShControl (Strict.WriterT w m) where newtype ShM (Strict.WriterT w m) a = StWriterTShM (ShM m (a, w)) liftShWith f =- Strict.WriterT $ liftM (\x -> (x, mempty)) $ liftShWith $ \runInSh -> f $ \k ->+ Strict.WriterT $ liftM (\x -> (x, mempty :: w)) $ liftShWith $ \runInSh -> f $ \k -> liftM StWriterTShM $ runInSh $ Strict.runWriterT k restoreSh (StWriterTShM m) = Strict.WriterT . restoreSh $ m {-# 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 #-} @@ -278,7 +274,7 @@ => MonadShControl (RWS.RWST r w s m) where newtype ShM (RWS.RWST r w s m) a = RWSTShM (ShM m (a, s ,w)) liftShWith f = RWS.RWST $ \r s ->- liftM (\x -> (x,s,mempty)) $ liftShWith $ \runInSh -> f $ \k ->+ liftM (\x -> (x,s,mempty :: w)) $ liftShWith $ \runInSh -> f $ \k -> liftM RWSTShM $ runInSh $ RWS.runRWST k r s restoreSh (RWSTShM m) = RWS.RWST . const . const . restoreSh $ m {-# INLINE liftShWith #-}@@ -288,7 +284,7 @@ => MonadShControl (Strict.RWST r w s m) where newtype ShM (Strict.RWST r w s m) a = StRWSTShM (ShM m (a, s, w)) liftShWith f = Strict.RWST $ \r s ->- liftM (\x -> (x,s,mempty)) $ liftShWith $ \runInSh -> f $ \k ->+ liftM (\x -> (x,s,mempty :: w)) $ liftShWith $ \runInSh -> f $ \k -> liftM StRWSTShM $ runInSh $ Strict.runRWST k r s restoreSh (StRWSTShM m) = Strict.RWST . const . const . restoreSh $ m {-# INLINE liftShWith #-}@@ -313,6 +309,12 @@ verbosely :: MonadShControl m => m a -> m a verbosely a = controlSh $ \runInSh -> S.verbosely (runInSh a) +log_stdout_with :: MonadShControl m => (Text -> IO ()) -> m a -> m a+log_stdout_with logger a = controlSh $ \runInSh -> S.log_stdout_with logger (runInSh a)++log_stderr_with :: MonadShControl m => (Text -> IO ()) -> m a -> m a+log_stderr_with logger a = controlSh $ \runInSh -> S.log_stderr_with logger (runInSh a)+ print_stdout :: MonadShControl m => Bool -> m a -> m a print_stdout shouldPrint a = controlSh $ \runInSh -> S.print_stdout shouldPrint (runInSh a) @@ -322,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) @@ -337,6 +343,9 @@ errExit :: MonadShControl m => Bool -> m a -> m a errExit shouldExit action = controlSh $ \runInSh -> S.errExit shouldExit (runInSh action) +followSymlink :: MonadShControl m => Bool -> m a -> m a+followSymlink enableFollowSymlink action = controlSh $ \runInSh -> S.followSymlink enableFollowSymlink (runInSh action)+ (-|-) :: (MonadShControl m, MonadSh m) => m Text -> m b -> m b one -|- two = controlSh $ \runInSh -> do x <- runInSh one@@ -354,7 +363,7 @@ toTextWarn :: MonadSh m => FilePath -> m Text toTextWarn = liftSh . toTextWarn -transferLinesAndCombine :: MonadIO m => Handle -> Handle -> m Text+transferLinesAndCombine :: MonadIO m => Handle -> (Text -> IO ()) -> m Text transferLinesAndCombine = (liftIO .) . S.transferLinesAndCombine get :: MonadSh m => m S.State@@ -363,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" #-} @@ -451,6 +460,9 @@ appendToPath :: MonadSh m => FilePath -> m () appendToPath = liftSh . S.appendToPath +prependToPath :: MonadSh m => FilePath -> m ()+prependToPath = liftSh . S.prependToPath+ get_env_all :: MonadSh m => m [(String, String)] get_env_all = liftSh S.get_env_all @@ -546,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 @@ -558,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,22 +30,23 @@ -- > import Shelly -- > import Data.Text as T -- > default (T.Text)+ module Shelly.Pipe (- -- * Entering Sh.- Sh, shs, shelly, shellyFailDir, shsFailDir, sub, silently, verbosely, escaping, print_stdout, print_commands, tracing, errExit+ -- * 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.- , setenv, get_env, get_env_text, get_env_def, appendToPath + -- * Modifying and querying environment+ , setenv, get_env, get_env_text, get_env_def, appendToPath, prependToPath+ -- * Environment directory , cd, chdir, pwd @@ -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,53 @@ -- * 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) -default (T.Text)-- -- | 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 + fmap f = Sh . fmap (fmap f) . unSh +instance Applicative Sh where+ pure = Sh . pure . pure+ (<*>) = ap+ a *> b = Sh $ unSh a *> unSh b+ instance Monad Sh where- return = Sh . return . return + return = pure a >>= f = Sh $ fmap concat $ mapM (unSh . f) =<< unSh a- a >> b = Sh $ unSh a >> unSh b+ (>>) = (*>) -instance Applicative Sh where- pure = return- (<*>) = ap+instance Alternative Sh where+ empty = mzero+ (<|>) = mplus instance MonadPlus Sh where mzero = Sh $ return []@@ -151,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) -} @@ -185,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 @@ -208,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 () @@ -236,6 +233,14 @@ escaping :: Bool -> Sh a -> Sh a escaping b = lift1 (S.escaping b) +-- | see 'S.log_stdout_with'+log_stdout_with :: (Text -> IO ()) -> Sh a -> Sh a+log_stdout_with logger = lift1 (S.log_stdout_with logger)++-- | see 'S.log_stderr_with'+log_stderr_with :: (Text -> IO ()) -> Sh a -> Sh a+log_stderr_with logger = lift1 (S.log_stdout_with logger)+ -- | see 'S.print_stdout' print_stdout :: Bool -> Sh a -> Sh a print_stdout b = lift1 (S.print_stdout b)@@ -252,6 +257,9 @@ errExit :: Bool -> Sh a -> Sh a errExit b = lift1 (S.errExit b) +-- | see 'S.followSymlink'+followSymlink :: Bool -> Sh a -> Sh a+followSymlink b = lift1 (S.followSymlink b) -- | see 'S.run' run :: FilePath -> [Text] -> Sh Text@@ -275,7 +283,7 @@ -- | see 'S.setStdin' setStdin :: Text -> Sh ()-setStdin = sh1 S.setStdin +setStdin = sh1 S.setStdin -- | see 'S.lastExitCode' lastExitCode :: Sh Int@@ -327,6 +335,10 @@ appendToPath :: FilePath -> Sh () appendToPath = sh1 S.appendToPath +-- | see 'S.prependToPath'+prependToPath :: FilePath -> Sh ()+prependToPath = sh1 S.prependToPath+ -- | see 'S.cd' cd :: FilePath -> Sh () cd = sh1 S.cd@@ -340,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.@@ -510,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 @@ -529,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 ()@@ -579,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@@ -598,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
@@ -0,0 +1,12 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Commands that only work on Unix.+module Shelly.Unix+ ( kill+ ) where++import Shelly+import qualified Data.Text as T++kill :: Int -> Sh ()+kill pid = run_ "kill" ["-15", T.pack $ show pid]
+ test/data/hello.sh view
@@ -0,0 +1,3 @@+#!/usr/bin/env bash++echo -n "Hello!"
+ test/data/nonascii.txt view
@@ -0,0 +1,1 @@+Selbstverständlich überraschend
+ test/data/symlinked_dir/hoge_file view
+ test/data/zshrc view
@@ -0,0 +1,2795 @@+# Filename: /etc/zsh/zshrc+# Purpose: config file for zsh (z shell)+# Authors: grml-team (grml.org), (c) Michael Prokop <mika@grml.org>+# Bug-Reports: see http://grml.org/bugs/+# License: This file is licensed under the GPL v2.+################################################################################+# This file is sourced only for interactive shells. It+# should contain commands to set up aliases, functions,+# options, key bindings, etc.+#+# Global Order: zshenv, zprofile, zshrc, zlogin+################################################################################++# USAGE+# If you are using this file as your ~/.zshrc file, please use ~/.zshrc.pre+# and ~/.zshrc.local for your own customisations. The former file is read+# before ~/.zshrc, the latter is read after it. Also, consider reading the+# refcard and the reference manual for this setup, both available from:+# <http://grml.org/zsh/>++# Contributing:+# If you want to help to improve grml's zsh setup, clone the grml-etc-core+# repository from git.grml.org:+# git clone git://git.grml.org/grml-etc-core.git+#+# Make your changes, commit them; use 'git format-patch' to create a series+# of patches and send those to the following address via 'git send-email':+# grml-etc-core@grml.org+#+# Doing so makes sure the right people get your patches for review and+# possibly inclusion.++# zsh-refcard-tag documentation:+# You may notice strange looking comments in this file.+# These are there for a purpose. grml's zsh-refcard can now be+# automatically generated from the contents of the actual configuration+# file. However, we need a little extra information on which comments+# and what lines of code to take into account (and for what purpose).+#+# Here is what they mean:+#+# List of tags (comment types) used:+# #a# Next line contains an important alias, that should+# be included in the grml-zsh-refcard.+# (placement tag: @@INSERT-aliases@@)+# #f# Next line contains the beginning of an important function.+# (placement tag: @@INSERT-functions@@)+# #v# Next line contains an important variable.+# (placement tag: @@INSERT-variables@@)+# #k# Next line contains an important keybinding.+# (placement tag: @@INSERT-keybindings@@)+# #d# Hashed directories list generation:+# start denotes the start of a list of 'hash -d'+# definitions.+# end denotes its end.+# (placement tag: @@INSERT-hasheddirs@@)+# #A# Abbreviation expansion list generation:+# start denotes the beginning of abbreviations.+# end denotes their end.+# Lines within this section that end in '#d .*' provide+# extra documentation to be included in the refcard.+# (placement tag: @@INSERT-abbrev@@)+# #m# This tag allows you to manually generate refcard entries+# for code lines that are hard/impossible to parse.+# Example:+# #m# k ESC-h Call the run-help function+# That would add a refcard entry in the keybindings table+# for 'ESC-h' with the given comment.+# So the syntax is: #m# <section> <argument> <comment>+# #o# This tag lets you insert entries to the 'other' hash.+# Generally, this should not be used. It is there for+# things that cannot be done easily in another way.+# (placement tag: @@INSERT-other-foobar@@)+#+# All of these tags (except for m and o) take two arguments, the first+# within the tag, the other after the tag:+#+# #<tag><section># <comment>+#+# Where <section> is really just a number, which are defined by the+# @secmap array on top of 'genrefcard.pl'. The reason for numbers+# instead of names is, that for the reader, the tag should not differ+# much from a regular comment. For zsh, it is a regular comment indeed.+# The numbers have got the following meanings:+# 0 -> "default"+# 1 -> "system"+# 2 -> "user"+# 3 -> "debian"+# 4 -> "search"+# 5 -> "shortcuts"+# 6 -> "services"+#+# So, the following will add an entry to the 'functions' table in the+# 'system' section, with a (hopefully) descriptive comment:+# #f1# Edit an alias via zle+# edalias() {+#+# It will then show up in the @@INSERT-aliases-system@@ replacement tag+# that can be found in 'grml-zsh-refcard.tex.in'.+# If the section number is omitted, the 'default' section is assumed.+# Furthermore, in 'grml-zsh-refcard.tex.in' @@INSERT-aliases@@ is+# exactly the same as @@INSERT-aliases-default@@. If you want a list of+# *all* aliases, for example, use @@INSERT-aliases-all@@.++# zsh profiling+# just execute 'ZSH_PROFILE_RC=1 zsh' and run 'zprof' to get the details+if [[ $ZSH_PROFILE_RC -gt 0 ]] ; then+ zmodload zsh/zprof+fi++# load .zshrc.pre to give the user the chance to overwrite the defaults+[[ -r ${HOME}/.zshrc.pre ]] && source ${HOME}/.zshrc.pre++# check for version/system+# check for versions (compatibility reasons)+is4(){+ [[ $ZSH_VERSION == <4->* ]] && return 0+ return 1+}++is41(){+ [[ $ZSH_VERSION == 4.<1->* || $ZSH_VERSION == <5->* ]] && return 0+ return 1+}++is42(){+ [[ $ZSH_VERSION == 4.<2->* || $ZSH_VERSION == <5->* ]] && return 0+ return 1+}++is425(){+ [[ $ZSH_VERSION == 4.2.<5->* || $ZSH_VERSION == 4.<3->* || $ZSH_VERSION == <5->* ]] && return 0+ return 1+}++is43(){+ [[ $ZSH_VERSION == 4.<3->* || $ZSH_VERSION == <5->* ]] && return 0+ return 1+}++is433(){+ [[ $ZSH_VERSION == 4.3.<3->* || $ZSH_VERSION == 4.<4->* \+ || $ZSH_VERSION == <5->* ]] && return 0+ return 1+}++is439(){+ [[ $ZSH_VERSION == 4.3.<9->* || $ZSH_VERSION == 4.<4->* \+ || $ZSH_VERSION == <5->* ]] && return 0+ return 1+}++#f1# Checks whether or not you're running grml+isgrml(){+ [[ -f /etc/grml_version ]] && return 0+ return 1+}++#f1# Checks whether or not you're running a grml cd+isgrmlcd(){+ [[ -f /etc/grml_cd ]] && return 0+ return 1+}++if isgrml ; then+#f1# Checks whether or not you're running grml-small+ isgrmlsmall() {+ if [[ ${${${(f)"$(</etc/grml_version)"}%% *}##*-} == 'small' ]]; then+ return 0+ fi+ return 1+ }+else+ isgrmlsmall() { return 1 }+fi++isdarwin(){+ [[ $OSTYPE == darwin* ]] && return 0+ return 1+}++#f1# are we running within an utf environment?+isutfenv() {+ case "$LANG $CHARSET $LANGUAGE" in+ *utf*) return 0 ;;+ *UTF*) return 0 ;;+ *) return 1 ;;+ esac+}++# check for user, if not running as root set $SUDO to sudo+(( EUID != 0 )) && SUDO='sudo' || SUDO=''++# change directory to home on first invocation of zsh+# important for rungetty -> autologin+# Thanks go to Bart Schaefer!+isgrml && checkhome() {+ if [[ -z "$ALREADY_DID_CD_HOME" ]] ; then+ export ALREADY_DID_CD_HOME=$HOME+ cd+ fi+}++# check for zsh v3.1.7+++if ! [[ ${ZSH_VERSION} == 3.1.<7->* \+ || ${ZSH_VERSION} == 3.<2->.<->* \+ || ${ZSH_VERSION} == <4->.<->* ]] ; then++ printf '-!-\n'+ printf '-!- In this configuration we try to make use of features, that only\n'+ printf '-!- require version 3.1.7 of the shell; That way this setup can be\n'+ printf '-!- used with a wide range of zsh versions, while using fairly\n'+ printf '-!- advanced features in all supported versions.\n'+ printf '-!-\n'+ printf '-!- However, you are running zsh version %s.\n' "$ZSH_VERSION"+ printf '-!-\n'+ printf '-!- While this *may* work, it might as well fail.\n'+ printf '-!- Please consider updating to at least version 3.1.7 of zsh.\n'+ printf '-!-\n'+ printf '-!- DO NOT EXPECT THIS TO WORK FLAWLESSLY!\n'+ printf '-!- If it does today, you'\''ve been lucky.\n'+ printf '-!-\n'+ printf '-!- Ye been warned!\n'+ printf '-!-\n'++ function zstyle() { : }+fi++# autoload wrapper - use this one instead of autoload directly+# We need to define this function as early as this, because autoloading+# 'is-at-least()' needs it.+function zrcautoload() {+ emulate -L zsh+ setopt extended_glob+ local fdir ffile+ local -i ffound++ ffile=$1+ (( found = 0 ))+ for fdir in ${fpath} ; do+ [[ -e ${fdir}/${ffile} ]] && (( ffound = 1 ))+ done++ (( ffound == 0 )) && return 1+ if [[ $ZSH_VERSION == 3.1.<6-> || $ZSH_VERSION == <4->* ]] ; then+ autoload -U ${ffile} || return 1+ else+ autoload ${ffile} || return 1+ fi+ return 0+}++# Load is-at-least() for more precise version checks Note that this test will+# *always* fail, if the is-at-least function could not be marked for+# autoloading.+zrcautoload is-at-least || is-at-least() { return 1 }++# set some important options (as early as possible)++# append history list to the history file; this is the default but we make sure+# because it's required for share_history.+setopt append_history++# import new commands from the history file also in other zsh-session+is4 && setopt share_history++# save each command's beginning timestamp and the duration to the history file+setopt extended_history++# If a new command line being added to the history list duplicates an older+# one, the older command is removed from the list+is4 && setopt histignorealldups++# remove command lines from the history list when the first character on the+# line is a space+setopt histignorespace++# if a command is issued that can't be executed as a normal command, and the+# command is the name of a directory, perform the cd command to that directory.+setopt auto_cd++# in order to use #, ~ and ^ for filename generation grep word+# *~(*.gz|*.bz|*.bz2|*.zip|*.Z) -> searches for word not in compressed files+# don't forget to quote '^', '~' and '#'!+setopt extended_glob++# display PID when suspending processes as well+setopt longlistjobs++# try to avoid the 'zsh: no matches found...'+setopt nonomatch++# report the status of backgrounds jobs immediately+setopt notify++# whenever a command completion is attempted, make sure the entire command path+# is hashed first.+setopt hash_list_all++# not just at the end+setopt completeinword++# Don't send SIGHUP to background processes when the shell exits.+setopt nohup++# make cd push the old directory onto the directory stack.+setopt auto_pushd++# avoid "beep"ing+setopt nobeep++# don't push the same dir twice.+setopt pushd_ignore_dups++# * shouldn't match dotfiles. ever.+setopt noglobdots++# use zsh style word splitting+setopt noshwordsplit++# don't error out when unset parameters are used+setopt unset++# setting some default values+NOCOR=${NOCOR:-0}+NOMENU=${NOMENU:-0}+NOPRECMD=${NOPRECMD:-0}+COMMAND_NOT_FOUND=${COMMAND_NOT_FOUND:-0}+GRML_ZSH_CNF_HANDLER=${GRML_ZSH_CNF_HANDLER:-/usr/share/command-not-found/command-not-found}+BATTERY=${BATTERY:-0}+GRMLSMALL_SPECIFIC=${GRMLSMALL_SPECIFIC:-1}+ZSH_NO_DEFAULT_LOCALE=${ZSH_NO_DEFAULT_LOCALE:-0}++typeset -ga ls_options+typeset -ga grep_options+if ls --help 2> /dev/null | grep -q GNU; then+ ls_options=( --color=auto )+elif [[ $OSTYPE == freebsd* ]]; then+ ls_options=( -G )+fi+if grep --help 2> /dev/null | grep -q GNU || \+ [[ $OSTYPE == freebsd* ]]; then+ grep_options=( --color=auto )+fi++# utility functions+# this function checks if a command exists and returns either true+# or false. This avoids using 'which' and 'whence', which will+# avoid problems with aliases for which on certain weird systems. :-)+# Usage: check_com [-c|-g] word+# -c only checks for external commands+# -g does the usual tests and also checks for global aliases+check_com() {+ emulate -L zsh+ local -i comonly gatoo++ if [[ $1 == '-c' ]] ; then+ (( comonly = 1 ))+ shift+ elif [[ $1 == '-g' ]] ; then+ (( gatoo = 1 ))+ else+ (( comonly = 0 ))+ (( gatoo = 0 ))+ fi++ if (( ${#argv} != 1 )) ; then+ printf 'usage: check_com [-c] <command>\n' >&2+ return 1+ fi++ if (( comonly > 0 )) ; then+ [[ -n ${commands[$1]} ]] && return 0+ return 1+ fi++ if [[ -n ${commands[$1]} ]] \+ || [[ -n ${functions[$1]} ]] \+ || [[ -n ${aliases[$1]} ]] \+ || [[ -n ${reswords[(r)$1]} ]] ; then++ return 0+ fi++ if (( gatoo > 0 )) && [[ -n ${galiases[$1]} ]] ; then+ return 0+ fi++ return 1+}++# creates an alias and precedes the command with+# sudo if $EUID is not zero.+salias() {+ emulate -L zsh+ local only=0 ; local multi=0+ while [[ $1 == -* ]] ; do+ case $1 in+ (-o) only=1 ;;+ (-a) multi=1 ;;+ (--) shift ; break ;;+ (-h)+ printf 'usage: salias [-h|-o|-a] <alias-expression>\n'+ printf ' -h shows this help text.\n'+ printf ' -a replace '\'' ; '\'' sequences with '\'' ; sudo '\''.\n'+ printf ' be careful using this option.\n'+ printf ' -o only sets an alias if a preceding sudo would be needed.\n'+ return 0+ ;;+ (*) printf "unkown option: '%s'\n" "$1" ; return 1 ;;+ esac+ shift+ done++ if (( ${#argv} > 1 )) ; then+ printf 'Too many arguments %s\n' "${#argv}"+ return 1+ fi++ key="${1%%\=*}" ; val="${1#*\=}"+ if (( EUID == 0 )) && (( only == 0 )); then+ alias -- "${key}=${val}"+ elif (( EUID > 0 )) ; then+ (( multi > 0 )) && val="${val// ; / ; sudo }"+ alias -- "${key}=sudo ${val}"+ fi++ return 0+}++# a "print -l ${(u)foo}"-workaround for pre-4.2.0 shells+# usage: uprint foo+# Where foo is the *name* of the parameter you want printed.+# Note that foo is no typo; $foo would be wrong here!+if ! is42 ; then+ uprint () {+ emulate -L zsh+ local -a u+ local w+ local parameter=$1++ if [[ -z ${parameter} ]] ; then+ printf 'usage: uprint <parameter>\n'+ return 1+ fi++ for w in ${(P)parameter} ; do+ [[ -z ${(M)u:#$w} ]] && u=( $u $w )+ done++ builtin print -l $u+ }+fi++# Check if we can read given files and source those we can.+xsource() {+ if (( ${#argv} < 1 )) ; then+ printf 'usage: xsource FILE(s)...\n' >&2+ return 1+ fi++ while (( ${#argv} > 0 )) ; do+ [[ -r "$1" ]] && source "$1"+ shift+ done+ return 0+}++# Check if we can read a given file and 'cat(1)' it.+xcat() {+ emulate -L zsh+ if (( ${#argv} != 1 )) ; then+ printf 'usage: xcat FILE\n' >&2+ return 1+ fi++ [[ -r $1 ]] && cat $1+ return 0+}++# Remove these functions again, they are of use only in these+# setup files. This should be called at the end of .zshrc.+xunfunction() {+ emulate -L zsh+ local -a funcs+ funcs=(salias xcat xsource xunfunction zrcautoload)++ for func in $funcs ; do+ [[ -n ${functions[$func]} ]] \+ && unfunction $func+ done+ return 0+}++# this allows us to stay in sync with grml's zshrc and put own+# modifications in ~/.zshrc.local+zrclocal() {+ xsource "/etc/zsh/zshrc.local"+ xsource "${HOME}/.zshrc.local"+ return 0+}++# locale setup+if (( ZSH_NO_DEFAULT_LOCALE == 0 )); then+ xsource "/etc/default/locale"+fi++for var in LANG LC_ALL LC_MESSAGES ; do+ [[ -n ${(P)var} ]] && export $var+done++xsource "/etc/sysconfig/keyboard"++TZ=$(xcat /etc/timezone)++# set some variables+if check_com -c vim ; then+#v#+ export EDITOR=${EDITOR:-vim}+else+ export EDITOR=${EDITOR:-vi}+fi++#v#+export PAGER=${PAGER:-less}++#v#+export MAIL=${MAIL:-/var/mail/$USER}++# if we don't set $SHELL then aterm, rxvt,.. will use /bin/sh or /bin/bash :-/+export SHELL='/bin/zsh'++# color setup for ls:+check_com -c dircolors && eval $(dircolors -b)+# color setup for ls on OS X:+isdarwin && export CLICOLOR=1++# do MacPorts setup on darwin+if isdarwin && [[ -d /opt/local ]]; then+ # Note: PATH gets set in /etc/zprofile on Darwin, so this can't go into+ # zshenv.+ PATH="/opt/local/bin:/opt/local/sbin:$PATH"+ MANPATH="/opt/local/share/man:$MANPATH"+fi+# do Fink setup on darwin+isdarwin && xsource /sw/bin/init.sh++# load our function and completion directories+for fdir in /usr/share/grml/zsh/completion /usr/share/grml/zsh/functions; do+ fpath=( ${fdir} ${fdir}/**/*(/N) ${fpath} )+ if [[ ${fpath} == '/usr/share/grml/zsh/functions' ]] ; then+ for func in ${fdir}/**/[^_]*[^~](N.) ; do+ zrcautoload ${func:t}+ done+ fi+done+unset fdir func++# support colors in less+export LESS_TERMCAP_mb=$'\E[01;31m'+export LESS_TERMCAP_md=$'\E[01;31m'+export LESS_TERMCAP_me=$'\E[0m'+export LESS_TERMCAP_se=$'\E[0m'+export LESS_TERMCAP_so=$'\E[01;44;33m'+export LESS_TERMCAP_ue=$'\E[0m'+export LESS_TERMCAP_us=$'\E[01;32m'++# mailchecks+MAILCHECK=30++# report about cpu-/system-/user-time of command if running longer than+# 5 seconds+REPORTTIME=5++# watch for everyone but me and root+watch=(notme root)++# automatically remove duplicates from these arrays+typeset -U path cdpath fpath manpath++# keybindings+if [[ "$TERM" != emacs ]] ; then+ [[ -z "$terminfo[kdch1]" ]] || bindkey -M emacs "$terminfo[kdch1]" delete-char+ [[ -z "$terminfo[khome]" ]] || bindkey -M emacs "$terminfo[khome]" beginning-of-line+ [[ -z "$terminfo[kend]" ]] || bindkey -M emacs "$terminfo[kend]" end-of-line+ [[ -z "$terminfo[kdch1]" ]] || bindkey -M vicmd "$terminfo[kdch1]" vi-delete-char+ [[ -z "$terminfo[khome]" ]] || bindkey -M vicmd "$terminfo[khome]" vi-beginning-of-line+ [[ -z "$terminfo[kend]" ]] || bindkey -M vicmd "$terminfo[kend]" vi-end-of-line+ [[ -z "$terminfo[cuu1]" ]] || bindkey -M viins "$terminfo[cuu1]" vi-up-line-or-history+ [[ -z "$terminfo[cuf1]" ]] || bindkey -M viins "$terminfo[cuf1]" vi-forward-char+ [[ -z "$terminfo[kcuu1]" ]] || bindkey -M viins "$terminfo[kcuu1]" vi-up-line-or-history+ [[ -z "$terminfo[kcud1]" ]] || bindkey -M viins "$terminfo[kcud1]" vi-down-line-or-history+ [[ -z "$terminfo[kcuf1]" ]] || bindkey -M viins "$terminfo[kcuf1]" vi-forward-char+ [[ -z "$terminfo[kcub1]" ]] || bindkey -M viins "$terminfo[kcub1]" vi-backward-char+ # ncurses stuff:+ [[ "$terminfo[kcuu1]" == $'\eO'* ]] && bindkey -M viins "${terminfo[kcuu1]/O/[}" vi-up-line-or-history+ [[ "$terminfo[kcud1]" == $'\eO'* ]] && bindkey -M viins "${terminfo[kcud1]/O/[}" vi-down-line-or-history+ [[ "$terminfo[kcuf1]" == $'\eO'* ]] && bindkey -M viins "${terminfo[kcuf1]/O/[}" vi-forward-char+ [[ "$terminfo[kcub1]" == $'\eO'* ]] && bindkey -M viins "${terminfo[kcub1]/O/[}" vi-backward-char+ [[ "$terminfo[khome]" == $'\eO'* ]] && bindkey -M viins "${terminfo[khome]/O/[}" beginning-of-line+ [[ "$terminfo[kend]" == $'\eO'* ]] && bindkey -M viins "${terminfo[kend]/O/[}" end-of-line+ [[ "$terminfo[khome]" == $'\eO'* ]] && bindkey -M emacs "${terminfo[khome]/O/[}" beginning-of-line+ [[ "$terminfo[kend]" == $'\eO'* ]] && bindkey -M emacs "${terminfo[kend]/O/[}" end-of-line+fi++## keybindings (run 'bindkeys' for details, more details via man zshzle)+# use emacs style per default:+bindkey -e+# use vi style:+# bindkey -v++## beginning-of-line OR beginning-of-buffer OR beginning of history+## by: Bart Schaefer <schaefer@brasslantern.com>, Bernhard Tittelbach+beginning-or-end-of-somewhere() {+ local hno=$HISTNO+ if [[ ( "${LBUFFER[-1]}" == $'\n' && "${WIDGET}" == beginning-of* ) || \+ ( "${RBUFFER[1]}" == $'\n' && "${WIDGET}" == end-of* ) ]]; then+ zle .${WIDGET:s/somewhere/buffer-or-history/} "$@"+ else+ zle .${WIDGET:s/somewhere/line-hist/} "$@"+ if (( HISTNO != hno )); then+ zle .${WIDGET:s/somewhere/buffer-or-history/} "$@"+ fi+ fi+}+zle -N beginning-of-somewhere beginning-or-end-of-somewhere+zle -N end-of-somewhere beginning-or-end-of-somewhere+++#if [[ "$TERM" == screen ]] ; then++## with HOME/END, move to beginning/end of line (on multiline) on first keypress+## to beginning/end of buffer on second keypress+## and to beginning/end of history on (at most) the third keypress+# terminator & non-debian xterm+bindkey '\eOH' beginning-of-somewhere # home+bindkey '\eOF' end-of-somewhere # end+# freebsd console+bindkey '\e[H' beginning-of-somewhere # home+bindkey '\e[F' end-of-somewhere # end+# xterm,gnome-terminal,quake,etc+bindkey '^[[1~' beginning-of-somewhere # home+bindkey '^[[4~' end-of-somewhere # end+# if terminal type is set to 'rxvt':+bindkey '\e[7~' beginning-of-somewhere # home+bindkey '\e[8~' end-of-somewhere # end+#fi++bindkey '\e[A' up-line-or-search # cursor up+bindkey '\e[B' down-line-or-search # <ESC>-++## use Ctrl-left-arrow and Ctrl-right-arrow for jumping to word-beginnings on the CL+bindkey "\e[5C" forward-word+bindkey "\e[5D" backward-word+bindkey "\e[1;5C" forward-word+bindkey "\e[1;5D" backward-word+## the same for alt-left-arrow and alt-right-arrow+bindkey '^[[1;3C' forward-word+bindkey '^[[1;3D' backward-word++# Search backward in the history for a line beginning with the current+# line up to the cursor and move the cursor to the end of the line then+zle -N history-beginning-search-backward-end history-search-end+zle -N history-beginning-search-forward-end history-search-end+#k# search history backward for entry beginning with typed text+bindkey '^xp' history-beginning-search-backward-end+#k# search history forward for entry beginning with typed text+bindkey '^xP' history-beginning-search-forward-end+#k# search history backward for entry beginning with typed text+bindkey "\e[5~" history-beginning-search-backward-end # PageUp+#k# search history forward for entry beginning with typed text+bindkey "\e[6~" history-beginning-search-forward-end # PageDown++# bindkey -s '^l' "|less\n" # ctrl-L pipes to less+# bindkey -s '^b' " &\n" # ctrl-B runs it in the background++# insert unicode character+# usage example: 'ctrl-x i' 00A7 'ctrl-x i' will give you an §+# See for example http://unicode.org/charts/ for unicode characters code+zrcautoload insert-unicode-char+zle -N insert-unicode-char+#k# Insert Unicode character+bindkey '^xi' insert-unicode-char++#m# k Shift-tab Perform backwards menu completion+if [[ -n "$terminfo[kcbt]" ]]; then+ bindkey "$terminfo[kcbt]" reverse-menu-complete+elif [[ -n "$terminfo[cbt]" ]]; then # required for GNU screen+ bindkey "$terminfo[cbt]" reverse-menu-complete+fi++## toggle the ,. abbreviation feature on/off+# NOABBREVIATION: default abbreviation-state+# 0 - enabled (default)+# 1 - disabled+NOABBREVIATION=${NOABBREVIATION:-0}++grml_toggle_abbrev() {+ if (( ${NOABBREVIATION} > 0 )) ; then+ NOABBREVIATION=0+ else+ NOABBREVIATION=1+ fi+}++#k# Toggle abbreviation expansion on/off+zle -N grml_toggle_abbrev+bindkey '^xA' grml_toggle_abbrev++# add a command line to the shells history without executing it+commit-to-history() {+ print -s ${(z)BUFFER}+ zle send-break+}+zle -N commit-to-history+bindkey "^x^h" commit-to-history++# only slash should be considered as a word separator:+slash-backward-kill-word() {+ local WORDCHARS="${WORDCHARS:s@/@}"+ # zle backward-word+ zle backward-kill-word+}+zle -N slash-backward-kill-word++#k# Kill left-side word or everything up to next slash+bindkey '\ev' slash-backward-kill-word+#k# Kill left-side word or everything up to next slash+bindkey '\e^h' slash-backward-kill-word+#k# Kill left-side word or everything up to next slash+bindkey '\e^?' slash-backward-kill-word++# use the new *-pattern-* widgets for incremental history search+if is439 ; then+ bindkey '^r' history-incremental-pattern-search-backward+ bindkey '^s' history-incremental-pattern-search-forward+fi++# a generic accept-line wrapper++# This widget can prevent unwanted autocorrections from command-name+# to _command-name, rehash automatically on enter and call any number+# of builtin and user-defined widgets in different contexts.+#+# For a broader description, see:+# <http://bewatermyfriend.org/posts/2007/12-26.11-50-38-tooltime.html>+#+# The code is imported from the file 'zsh/functions/accept-line' from+# <http://ft.bewatermyfriend.org/comp/zsh/zsh-dotfiles.tar.bz2>, which+# distributed under the same terms as zsh itself.++# A newly added command will may not be found or will cause false+# correction attempts, if you got auto-correction set. By setting the+# following style, we force accept-line() to rehash, if it cannot+# find the first word on the command line in the $command[] hash.+zstyle ':acceptline:*' rehash true++function Accept-Line() {+ setopt localoptions noksharrays+ local -a subs+ local -xi aldone+ local sub+ local alcontext=${1:-$alcontext}++ zstyle -a ":acceptline:${alcontext}" actions subs++ (( ${#subs} < 1 )) && return 0++ (( aldone = 0 ))+ for sub in ${subs} ; do+ [[ ${sub} == 'accept-line' ]] && sub='.accept-line'+ zle ${sub}++ (( aldone > 0 )) && break+ done+}++function Accept-Line-getdefault() {+ emulate -L zsh+ local default_action++ zstyle -s ":acceptline:${alcontext}" default_action default_action+ case ${default_action} in+ ((accept-line|))+ printf ".accept-line"+ ;;+ (*)+ printf ${default_action}+ ;;+ esac+}++function Accept-Line-HandleContext() {+ zle Accept-Line++ default_action=$(Accept-Line-getdefault)+ zstyle -T ":acceptline:${alcontext}" call_default \+ && zle ${default_action}+}++function accept-line() {+ setopt localoptions noksharrays+ local -ax cmdline+ local -x alcontext+ local buf com fname format msg default_action++ alcontext='default'+ buf="${BUFFER}"+ cmdline=(${(z)BUFFER})+ com="${cmdline[1]}"+ fname="_${com}"++ Accept-Line 'preprocess'++ zstyle -t ":acceptline:${alcontext}" rehash \+ && [[ -z ${commands[$com]} ]] \+ && rehash++ if [[ -n ${com} ]] \+ && [[ -n ${reswords[(r)$com]} ]] \+ || [[ -n ${aliases[$com]} ]] \+ || [[ -n ${functions[$com]} ]] \+ || [[ -n ${builtins[$com]} ]] \+ || [[ -n ${commands[$com]} ]] ; then++ # there is something sensible to execute, just do it.+ alcontext='normal'+ Accept-Line-HandleContext++ return+ fi++ if [[ -o correct ]] \+ || [[ -o correctall ]] \+ && [[ -n ${functions[$fname]} ]] ; then++ # nothing there to execute but there is a function called+ # _command_name; a completion widget. Makes no sense to+ # call it on the commandline, but the correct{,all} options+ # will ask for it nevertheless, so warn the user.+ if [[ ${LASTWIDGET} == 'accept-line' ]] ; then+ # Okay, we warned the user before, he called us again,+ # so have it his way.+ alcontext='force'+ Accept-Line-HandleContext++ return+ fi++ if zstyle -t ":acceptline:${alcontext}" nocompwarn ; then+ alcontext='normal'+ Accept-Line-HandleContext+ else+ # prepare warning message for the user, configurable via zstyle.+ zstyle -s ":acceptline:${alcontext}" compwarnfmt msg++ if [[ -z ${msg} ]] ; then+ msg="%c will not execute and completion %f exists."+ fi++ zformat -f msg "${msg}" "c:${com}" "f:${fname}"++ zle -M -- "${msg}"+ fi+ return+ elif [[ -n ${buf//[$' \t\n']##/} ]] ; then+ # If we are here, the commandline contains something that is not+ # executable, which is neither subject to _command_name correction+ # and is not empty. might be a variable assignment+ alcontext='misc'+ Accept-Line-HandleContext++ return+ fi++ # If we got this far, the commandline only contains whitespace, or is empty.+ alcontext='empty'+ Accept-Line-HandleContext+}++zle -N accept-line+zle -N Accept-Line+zle -N Accept-Line-HandleContext++# power completion - abbreviation expansion+# power completion / abbreviation expansion / buffer expansion+# see http://zshwiki.org/home/examples/zleiab for details+# less risky than the global aliases but powerful as well+# just type the abbreviation key and afterwards ',.' to expand it+declare -A abk+setopt extendedglob+setopt interactivecomments+abk=(+# key # value (#d additional doc string)+#A# start+ '...' '../..'+ '....' '../../..'+ 'BG' '& exit'+ 'C' '| wc -l'+ 'G' '|& grep '${grep_options:+"${grep_options[*]} "}+ 'H' '| head'+ 'Hl' ' --help |& less -r' #d (Display help in pager)+ 'L' '| less'+ 'LL' '|& less -r'+ 'M' '| most'+ 'N' '&>/dev/null' #d (No Output)+ 'R' '| tr A-z N-za-m' #d (ROT13)+ 'SL' '| sort | less'+ 'S' '| sort -u'+ 'T' '| tail'+ 'V' '|& vim -'+#A# end+ 'co' './configure && make && sudo make install'+)++zleiab() {+ emulate -L zsh+ setopt extendedglob+ local MATCH++ if (( NOABBREVIATION > 0 )) ; then+ LBUFFER="${LBUFFER},."+ return 0+ fi++ matched_chars='[.-|_a-zA-Z0-9]#'+ LBUFFER=${LBUFFER%%(#m)[.-|_a-zA-Z0-9]#}+ LBUFFER+=${abk[$MATCH]:-$MATCH}+}++zle -N zleiab && bindkey ",." zleiab++#f# display contents of assoc array $abk+help-show-abk()+{+ zle -M "$(print "Type ,. after these abbreviations to expand them:"; print -a -C 2 ${(kv)abk})"+}+#k# Display list of abbreviations that expand when followed by ,.+zle -N help-show-abk && bindkey '^xb' help-show-abk++# autoloading+zrcautoload zmv # who needs mmv or rename?+zrcautoload history-search-end++# we don't want to quote/espace URLs on our own...+# if autoload -U url-quote-magic ; then+# zle -N self-insert url-quote-magic+# zstyle ':url-quote-magic:*' url-metas '*?[]^()~#{}='+# else+# print 'Notice: no url-quote-magic available :('+# fi+alias url-quote='autoload -U url-quote-magic ; zle -N self-insert url-quote-magic'++#m# k ESC-h Call \kbd{run-help} for the 1st word on the command line+alias run-help >&/dev/null && unalias run-help+for rh in run-help{,-git,-svk,-svn}; do+ zrcautoload $rh+done; unset rh++# completion system+if zrcautoload compinit ; then+ compinit || print 'Notice: no compinit available :('+else+ print 'Notice: no compinit available :('+ function zstyle { }+ function compdef { }+fi++is4 && zrcautoload zed # use ZLE editor to edit a file or function++is4 && \+for mod in complist deltochar mathfunc ; do+ zmodload -i zsh/${mod} 2>/dev/null || print "Notice: no ${mod} available :("+done++# autoload zsh modules when they are referenced+if is4 ; then+ zmodload -a zsh/stat zstat+ zmodload -a zsh/zpty zpty+ zmodload -ap zsh/mapfile mapfile+fi++if is4 && zrcautoload insert-files && zle -N insert-files ; then+ #k# Insert files and test globbing+ bindkey "^xf" insert-files # C-x-f+fi++bindkey ' ' magic-space # also do history expansion on space+#k# Trigger menu-complete+bindkey '\ei' menu-complete # menu completion via esc-i++# press esc-e for editing command line in $EDITOR or $VISUAL+if is4 && zrcautoload edit-command-line && zle -N edit-command-line ; then+ #k# Edit the current line in \kbd{\$EDITOR}+ bindkey '\ee' edit-command-line+fi++if is4 && [[ -n ${(k)modules[zsh/complist]} ]] ; then+ #k# menu selection: pick item but stay in the menu+ bindkey -M menuselect '\e^M' accept-and-menu-complete+ # also use + and INSERT since it's easier to press repeatedly+ bindkey -M menuselect "+" accept-and-menu-complete+ bindkey -M menuselect "^[[2~" accept-and-menu-complete++ # accept a completion and try to complete again by using menu+ # completion; very useful with completing directories+ # by using 'undo' one's got a simple file browser+ bindkey -M menuselect '^o' accept-and-infer-next-history+fi++# press "ctrl-e d" to insert the actual date in the form yyyy-mm-dd+insert-datestamp() { LBUFFER+=${(%):-'%D{%Y-%m-%d}'}; }+zle -N insert-datestamp++#k# Insert a timestamp on the command line (yyyy-mm-dd)+bindkey '^ed' insert-datestamp++# press esc-m for inserting last typed word again (thanks to caphuso!)+insert-last-typed-word() { zle insert-last-word -- 0 -1 };+zle -N insert-last-typed-word;++#k# Insert last typed word+bindkey "\em" insert-last-typed-word++function grml-zsh-fg() {+ if (( ${#jobstates} )); then+ zle .push-input+ [[ -o hist_ignore_space ]] && BUFFER=' ' || BUFFER=''+ BUFFER="${BUFFER}fg"+ zle .accept-line+ else+ zle -M 'No background jobs. Doing nothing.'+ fi+}+zle -N grml-zsh-fg+#k# A smart shortcut for \kbd{fg<enter>}+bindkey '^z' grml-zsh-fg++# run command line as user root via sudo:+sudo-command-line() {+ [[ -z $BUFFER ]] && zle up-history+ if [[ $BUFFER != sudo\ * ]]; then+ BUFFER="sudo $BUFFER"+ CURSOR=$(( CURSOR+5 ))+ fi+}+zle -N sudo-command-line++#k# prepend the current command with "sudo"+bindkey "^os" sudo-command-line++### jump behind the first word on the cmdline.+### useful to add options.+function jump_after_first_word() {+ local words+ words=(${(z)BUFFER})++ if (( ${#words} <= 1 )) ; then+ CURSOR=${#BUFFER}+ else+ CURSOR=${#${words[1]}}+ fi+}+zle -N jump_after_first_word+#k# jump to after first word (for adding options)+bindkey '^x1' jump_after_first_word++# complete word from history with menu (from Book: ZSH, OpenSource-Press)+zle -C hist-complete complete-word _generic+zstyle ':completion:hist-complete:*' completer _history+#k# complete word from history with menu+bindkey "^x^x" hist-complete++## complete word from currently visible Screen or Tmux buffer.+if check_com -c screen || check_com -c tmux; then+ _complete_screen_display() {+ [[ "$TERM" != "screen" ]] && return 1++ local TMPFILE=$(mktemp)+ local -U -a _screen_display_wordlist+ trap "rm -f $TMPFILE" EXIT++ # fill array with contents from screen hardcopy+ if ((${+TMUX})); then+ #works, but crashes tmux below version 1.4+ #luckily tmux -V option to ask for version, was also added in 1.4+ tmux -V &>/dev/null || return+ tmux -q capture-pane \; save-buffer -b 0 $TMPFILE \; delete-buffer -b 0+ else+ screen -X hardcopy $TMPFILE+ # screen sucks, it dumps in latin1, apparently always. so recode it+ # to system charset+ check_com recode && recode latin1 $TMPFILE+ fi+ _screen_display_wordlist=( ${(QQ)$(<$TMPFILE)} )+ # remove PREFIX to be completed from that array+ _screen_display_wordlist[${_screen_display_wordlist[(i)$PREFIX]}]=""+ compadd -a _screen_display_wordlist+ }+ #k# complete word from currently visible GNU screen buffer+ bindkey -r "^xS"+ compdef -k _complete_screen_display complete-word '^xS'+fi++# history++ZSHDIR=$HOME/.zsh++#v#+HISTFILE=$HOME/.zsh_history+isgrmlcd && HISTSIZE=500 || HISTSIZE=5000+isgrmlcd && SAVEHIST=1000 || SAVEHIST=10000 # useful for setopt append_history++# dirstack handling++DIRSTACKSIZE=${DIRSTACKSIZE:-20}+DIRSTACKFILE=${DIRSTACKFILE:-${HOME}/.zdirs}++if [[ -f ${DIRSTACKFILE} ]] && [[ ${#dirstack[*]} -eq 0 ]] ; then+ dirstack=( ${(f)"$(< $DIRSTACKFILE)"} )+ # "cd -" won't work after login by just setting $OLDPWD, so+ [[ -d $dirstack[1] ]] && cd $dirstack[1] && cd $OLDPWD+fi++chpwd() {+ local -ax my_stack+ my_stack=( ${PWD} ${dirstack} )+ if is42 ; then+ builtin print -l ${(u)my_stack} >! ${DIRSTACKFILE}+ else+ uprint my_stack >! ${DIRSTACKFILE}+ fi+}++# directory based profiles++if is433 ; then++CHPWD_PROFILE='default'+function chpwd_profiles() {+ # Say you want certain settings to be active in certain directories.+ # This is what you want.+ #+ # zstyle ':chpwd:profiles:/usr/src/grml(|/|/*)' profile grml+ # zstyle ':chpwd:profiles:/usr/src/debian(|/|/*)' profile debian+ #+ # When that's done and you enter a directory that matches the pattern+ # in the third part of the context, a function called chpwd_profile_grml,+ # for example, is called (if it exists).+ #+ # If no pattern matches (read: no profile is detected) the profile is+ # set to 'default', which means chpwd_profile_default is attempted to+ # be called.+ #+ # A word about the context (the ':chpwd:profiles:*' stuff in the zstyle+ # command) which is used: The third part in the context is matched against+ # ${PWD}. That's why using a pattern such as /foo/bar(|/|/*) makes sense.+ # Because that way the profile is detected for all these values of ${PWD}:+ # /foo/bar+ # /foo/bar/+ # /foo/bar/baz+ # So, if you want to make double damn sure a profile works in /foo/bar+ # and everywhere deeper in that tree, just use (|/|/*) and be happy.+ #+ # The name of the detected profile will be available in a variable called+ # 'profile' in your functions. You don't need to do anything, it'll just+ # be there.+ #+ # Then there is the parameter $CHPWD_PROFILE is set to the profile, that+ # was is currently active. That way you can avoid running code for a+ # profile that is already active, by running code such as the following+ # at the start of your function:+ #+ # function chpwd_profile_grml() {+ # [[ ${profile} == ${CHPWD_PROFILE} ]] && return 1+ # ...+ # }+ #+ # The initial value for $CHPWD_PROFILE is 'default'.+ #+ # Version requirement:+ # This feature requires zsh 4.3.3 or newer.+ # If you use this feature and need to know whether it is active in your+ # current shell, there are several ways to do that. Here are two simple+ # ways:+ #+ # a) If knowing if the profiles feature is active when zsh starts is+ # good enough for you, you can put the following snippet into your+ # .zshrc.local:+ #+ # (( ${+functions[chpwd_profiles]} )) && print "directory profiles active"+ #+ # b) If that is not good enough, and you would prefer to be notified+ # whenever a profile changes, you can solve that by making sure you+ # start *every* profile function you create like this:+ #+ # function chpwd_profile_myprofilename() {+ # [[ ${profile} == ${CHPWD_PROFILE} ]] && return 1+ # print "chpwd(): Switching to profile: $profile"+ # ...+ # }+ #+ # That makes sure you only get notified if a profile is *changed*,+ # not everytime you change directory, which would probably piss+ # you off fairly quickly. :-)+ #+ # There you go. Now have fun with that.+ local -x profile++ zstyle -s ":chpwd:profiles:${PWD}" profile profile || profile='default'+ if (( ${+functions[chpwd_profile_$profile]} )) ; then+ chpwd_profile_${profile}+ fi++ CHPWD_PROFILE="${profile}"+ return 0+}+chpwd_functions=( ${chpwd_functions} chpwd_profiles )++fi # is433++# display battery status on right side of prompt via running 'BATTERY=1 zsh'+if [[ $BATTERY -gt 0 ]] ; then+ if ! check_com -c acpi ; then+ BATTERY=0+ fi+fi++battery() {+if [[ $BATTERY -gt 0 ]] ; then+ PERCENT="${${"$(acpi 2>/dev/null)"}/(#b)[[:space:]]#Battery <->: [^0-9]##, (<->)%*/${match[1]}}"+ if [[ -z "$PERCENT" ]] ; then+ PERCENT='acpi not present'+ else+ if [[ "$PERCENT" -lt 20 ]] ; then+ PERCENT="warning: ${PERCENT}%%"+ else+ PERCENT="${PERCENT}%%"+ fi+ fi+fi+}+# set colors for use in prompts+if zrcautoload colors && colors 2>/dev/null ; then+ BLUE="%{${fg[blue]}%}"+ RED="%{${fg_bold[red]}%}"+ GREEN="%{${fg[green]}%}"+ CYAN="%{${fg[cyan]}%}"+ MAGENTA="%{${fg[magenta]}%}"+ YELLOW="%{${fg[yellow]}%}"+ WHITE="%{${fg[white]}%}"+ NO_COLOUR="%{${reset_color}%}"+else+ BLUE=$'%{\e[1;34m%}'+ RED=$'%{\e[1;31m%}'+ GREEN=$'%{\e[1;32m%}'+ CYAN=$'%{\e[1;36m%}'+ WHITE=$'%{\e[1;37m%}'+ MAGENTA=$'%{\e[1;35m%}'+ YELLOW=$'%{\e[1;33m%}'+ NO_COLOUR=$'%{\e[0m%}'+fi++# gather version control information for inclusion in a prompt++if zrcautoload vcs_info; then+ # `vcs_info' in zsh versions 4.3.10 and below have a broken `_realpath'+ # function, which can cause a lot of trouble with our directory-based+ # profiles. So:+ if [[ ${ZSH_VERSION} == 4.3.<-10> ]] ; then+ function VCS_INFO_realpath () {+ setopt localoptions NO_shwordsplit chaselinks+ ( builtin cd -q $1 2> /dev/null && pwd; )+ }+ fi++ zstyle ':vcs_info:*' max-exports 2++ if [[ -o restricted ]]; then+ zstyle ':vcs_info:*' enable NONE+ fi+fi++# Change vcs_info formats for the grml prompt. The 2nd format sets up+# $vcs_info_msg_1_ to contain "zsh: repo-name" used to set our screen title.+# TODO: The included vcs_info() version still uses $VCS_INFO_message_N_.+# That needs to be the use of $VCS_INFO_message_N_ needs to be changed+# to $vcs_info_msg_N_ as soon as we use the included version.+if [[ "$TERM" == dumb ]] ; then+ zstyle ':vcs_info:*' actionformats "(%s%)-[%b|%a] " "zsh: %r"+ zstyle ':vcs_info:*' formats "(%s%)-[%b] " "zsh: %r"+else+ # these are the same, just with a lot of colours:+ zstyle ':vcs_info:*' actionformats "${MAGENTA}(${NO_COLOUR}%s${MAGENTA})${YELLOW}-${MAGENTA}[${GREEN}%b${YELLOW}|${RED}%a${MAGENTA}]${NO_COLOUR} " \+ "zsh: %r"+ zstyle ':vcs_info:*' formats "${MAGENTA}(${NO_COLOUR}%s${MAGENTA})${YELLOW}-${MAGENTA}[${GREEN}%b${MAGENTA}]${NO_COLOUR}%} " \+ "zsh: %r"+ zstyle ':vcs_info:(sv[nk]|bzr):*' branchformat "%b${RED}:${YELLOW}%r"+fi++# command not found handling++(( ${COMMAND_NOT_FOUND} == 1 )) &&+function command_not_found_handler() {+ emulate -L zsh+ if [[ -x ${GRML_ZSH_CNF_HANDLER} ]] ; then+ ${GRML_ZSH_CNF_HANDLER} $1+ fi+ return 1+}++# set prompt+if zrcautoload promptinit && promptinit 2>/dev/null ; then+ promptinit # people should be able to use their favourite prompt+else+ print 'Notice: no promptinit available :('+fi++setopt prompt_subst++# make sure to use right prompt only when not running a command+is41 && setopt transient_rprompt+++function ESC_print () {+ info_print $'\ek' $'\e\\' "$@"+}+function set_title () {+ info_print $'\e]0;' $'\a' "$@"+}++function info_print () {+ local esc_begin esc_end+ esc_begin="$1"+ esc_end="$2"+ shift 2+ printf '%s' ${esc_begin}+ printf '%s' "$*"+ printf '%s' "${esc_end}"+}++# TODO: revise all these NO* variables and especially their documentation+# in zsh-help() below.+is4 && [[ $NOPRECMD -eq 0 ]] && precmd () {+ [[ $NOPRECMD -gt 0 ]] && return 0+ # update VCS information+ (( ${+functions[vcs_info]} )) && vcs_info++ if [[ $TERM == screen* ]] ; then+ if [[ -n ${vcs_info_msg_1_} ]] ; then+ ESC_print ${vcs_info_msg_1_}+ else+ ESC_print "zsh"+ fi+ fi+ # just use DONTSETRPROMPT=1 to be able to overwrite RPROMPT+ if [[ ${DONTSETRPROMPT:-} -eq 0 ]] ; then+ if [[ $BATTERY -gt 0 ]] ; then+ # update battery (dropped into $PERCENT) information+ battery+ RPROMPT="%(?..:() ${PERCENT}"+ else+ RPROMPT="%(?..:() "+ fi+ fi+ # adjust title of xterm+ # see http://www.faqs.org/docs/Linux-mini/Xterm-Title.html+ [[ ${NOTITLE:-} -gt 0 ]] && return 0+ case $TERM in+ (xterm*|rxvt*)+ set_title ${(%):-"%n@%m: %~"}+ ;;+ esac+}++# preexec() => a function running before every command+is4 && [[ $NOPRECMD -eq 0 ]] && \+preexec () {+ [[ $NOPRECMD -gt 0 ]] && return 0+# set hostname if not running on host with name 'grml'+ if [[ -n "$HOSTNAME" ]] && [[ "$HOSTNAME" != $(hostname) ]] ; then+ NAME="@$HOSTNAME"+ fi+# get the name of the program currently running and hostname of local machine+# set screen window title if running in a screen+ if [[ "$TERM" == screen* ]] ; then+ # local CMD=${1[(wr)^(*=*|sudo|ssh|-*)]} # don't use hostname+ local CMD="${1[(wr)^(*=*|sudo|ssh|-*)]}$NAME" # use hostname+ ESC_print ${CMD}+ fi+# adjust title of xterm+ [[ ${NOTITLE} -gt 0 ]] && return 0+ case $TERM in+ (xterm*|rxvt*)+ set_title "${(%):-"%n@%m:"}" "$1"+ ;;+ esac+}++EXITCODE="%(?..%?%1v )"+# secondary prompt, printed when the shell needs more information to complete a+# command.+PS2='\`%_> '+# selection prompt used within a select loop.+PS3='?# '+# the execution trace prompt (setopt xtrace). default: '+%N:%i>'+PS4='+%N:%i:%_> '++# set variable debian_chroot if running in a chroot with /etc/debian_chroot+if [[ -z "$debian_chroot" ]] && [[ -r /etc/debian_chroot ]] ; then+ debian_chroot=$(cat /etc/debian_chroot)+fi++# don't use colors on dumb terminals (like emacs):+if [[ "$TERM" == dumb ]] ; then+ PROMPT="${EXITCODE}${debian_chroot:+($debian_chroot)}%n@%m %40<...<%B%~%b%<< "+else+ # only if $GRMLPROMPT is set (e.g. via 'GRMLPROMPT=1 zsh') use the extended+ # prompt set variable identifying the chroot you work in (used in the+ # prompt below)+ if [[ $GRMLPROMPT -gt 0 ]] ; then+ PROMPT="${RED}${EXITCODE}${CYAN}[%j running job(s)] ${GREEN}{history#%!} ${RED}%(3L.+.) ${BLUE}%* %D+${BLUE}%n${NO_COLOUR}@%m %40<...<%B%~%b%<< "+ else+ # This assembles the primary prompt string+ if (( EUID != 0 )); then+ #PROMPT="${RED}${EXITCODE}${WHITE}${debian_chroot:+($debian_chroot)}${BLUE}%n${NO_COLOUR}@%m %40<...<%B%~%b%<< "+ PROMPT="${RED}${EXITCODE}${WHITE}${debian_chroot:+($debian_chroot)}${GREEN}%n@%m${BLUE} %40<...<%B%~%b%<< "+ else+ PROMPT="${BLUE}${EXITCODE}${WHITE}${debian_chroot:+($debian_chroot)}${RED}%n${NO_COLOUR}@%m %40<...<%B%~%b%<< "+ fi+ fi+fi++PROMPT="${PROMPT}"'${vcs_info_msg_0_}'"%# "++# if we are inside a grml-chroot set a specific prompt theme+if [[ -n "$GRML_CHROOT" ]] ; then+ PROMPT="%{$fg[red]%}(CHROOT) %{$fg_bold[red]%}%n%{$fg_no_bold[white]%}@%m %40<...<%B%~%b%<< %\# "+fi++# 'hash' some often used directories+#d# start+hash -d deb=/var/cache/apt/archives+hash -d doc=/usr/share/doc+hash -d linux=/lib/modules/$(command uname -r)/build/+hash -d log=/var/log+hash -d slog=/var/log/syslog+hash -d src=/usr/src+hash -d templ=/usr/share/doc/grml-templates+hash -d tt=/usr/share/doc/texttools-doc+hash -d www=/var/www+#d# end++# some aliases+if check_com -c screen ; then+ if [[ $UID -eq 0 ]] ; then+ if [[ -r /etc/grml/screenrc ]]; then+ alias screen="${commands[screen]} -c /etc/grml/screenrc"+ fi+ elif [[ -r $HOME/.screenrc ]] ; then+ alias screen="${commands[screen]} -c $HOME/.screenrc"+ else+ if [[ -r /etc/grml/screenrc_grml ]]; then+ alias screen="${commands[screen]} -c /etc/grml/screenrc_grml"+ else+ if [[ -r /etc/grml/screenrc ]]; then+ alias screen="${commands[screen]} -c /etc/grml/screenrc"+ fi+ fi+ fi+fi++# do we have GNU ls with color-support?+if [[ "$TERM" != dumb ]]; then+ #a1# execute \kbd{@a@}:\quad ls with colors+ alias ls='ls -b -CF '${ls_options:+"${ls_options[*]} "}+ #a1# execute \kbd{@a@}:\quad list all files, with colors+ alias la='ls -la '${ls_options:+"${ls_options[*]} "}+ #a1# long colored list, without dotfiles (@a@)+ alias ll='ls -l '${ls_options:+"${ls_options[*]} "}+ #a1# long colored list, human readable sizes (@a@)+ alias lh='ls -hAl '${ls_options:+"${ls_options[*]} "}+ #a1# List files, append qualifier to filenames \\&\quad(\kbd{/} for directories, \kbd{@} for symlinks ...)+ alias l='ls -lF '${ls_options:+"${ls_options[*]} "}+else+ alias ls='ls -b -CF'+ alias la='ls -la'+ alias ll='ls -l'+ alias lh='ls -hAl'+ alias l='ls -lF'+fi++alias mdstat='cat /proc/mdstat'+alias ...='cd ../../'++# generate alias named "$KERNELVERSION-reboot" so you can use boot with kexec:+if [[ -x /sbin/kexec ]] && [[ -r /proc/cmdline ]] ; then+ alias "$(uname -r)-reboot"="kexec -l --initrd=/boot/initrd.img-"$(uname -r)" --command-line=\"$(cat /proc/cmdline)\" /boot/vmlinuz-"$(uname -r)""+fi++# see http://www.cl.cam.ac.uk/~mgk25/unicode.html#term for details+alias term2iso="echo 'Setting terminal to iso mode' ; print -n '\e%@'"+alias term2utf="echo 'Setting terminal to utf-8 mode'; print -n '\e%G'"++# make sure it is not assigned yet+[[ -n ${aliases[utf2iso]} ]] && unalias utf2iso+utf2iso() {+ if isutfenv ; then+ for ENV in $(env | command grep -i '.utf') ; do+ eval export "$(echo $ENV | sed 's/UTF-8/iso885915/ ; s/utf8/iso885915/')"+ done+ fi+}++# make sure it is not assigned yet+[[ -n ${aliases[iso2utf]} ]] && unalias iso2utf+iso2utf() {+ if ! isutfenv ; then+ for ENV in $(env | command grep -i '\.iso') ; do+ eval export "$(echo $ENV | sed 's/iso.*/UTF-8/ ; s/ISO.*/UTF-8/')"+ done+ fi+}++# especially for roadwarriors using GNU screen and ssh:+if ! check_com asc &>/dev/null ; then+ asc() { autossh -t "$@" 'screen -RdU' }+ compdef asc=ssh+fi++#f1# Hints for the use of zsh on grml+zsh-help() {+ print "$bg[white]$fg[black]+zsh-help - hints for use of zsh on grml+=======================================$reset_color"++ print '+Main configuration of zsh happens in /etc/zsh/zshrc.+That file is part of the package grml-etc-core, if you want to+use them on a non-grml-system just get the tar.gz from+http://deb.grml.org/ or (preferably) get it from the git repository:++ http://git.grml.org/f/grml-etc-core/etc/zsh/zshrc++This version of grml'\''s zsh setup does not use skel/.zshrc anymore.+The file is still there, but it is empty for backwards compatibility.++For your own changes use these two files:+ $HOME/.zshrc.pre+ $HOME/.zshrc.local++The former is sourced very early in our zshrc, the latter is sourced+very lately.++System wide configuration without touching configuration files of grml+can take place in /etc/zsh/zshrc.local.++For information regarding zsh start at http://grml.org/zsh/++Take a look at grml'\''s zsh refcard:+% xpdf =(zcat /usr/share/doc/grml-docs/zsh/grml-zsh-refcard.pdf.gz)++Check out the main zsh refcard:+% '$BROWSER' http://www.bash2zsh.com/zsh_refcard/refcard.pdf++And of course visit the zsh-lovers:+% man zsh-lovers++You can adjust some options through environment variables when+invoking zsh without having to edit configuration files.+Basically meant for bash users who are not used to the power of+the zsh yet. :)++ "NOCOR=1 zsh" => deactivate automatic correction+ "NOMENU=1 zsh" => do not use auto menu completion+ (note: use ctrl-d for completion instead!)+ "NOPRECMD=1 zsh" => disable the precmd + preexec commands (set GNU screen title)+ "NOTITLE=1 zsh" => disable setting the title of xterms without disabling+ preexec() and precmd() completely+ "BATTERY=1 zsh" => activate battery status (via acpi) on right side of prompt+ "COMMAND_NOT_FOUND=1 zsh"+ => Enable a handler if an external command was not found+ The command called in the handler can be altered by setting+ the GRML_ZSH_CNF_HANDLER variable, the default is:+ "/usr/share/command-not-found/command-not-found"++A value greater than 0 is enables a feature; a value equal to zero+disables it. If you like one or the other of these settings, you can+add them to ~/.zshrc.pre to ensure they are set when sourcing grml'\''s+zshrc.'++ print "+$bg[white]$fg[black]+Please report wishes + bugs to the grml-team: http://grml.org/bugs/+Enjoy your grml system with the zsh!$reset_color"+}++# debian stuff+if [[ -r /etc/debian_version ]] ; then+ #a3# Execute \kbd{apt-cache search}+ alias acs='apt-cache search'+ #a3# Execute \kbd{apt-cache show}+ alias acsh='apt-cache show'+ #a3# Execute \kbd{apt-cache policy}+ alias acp='apt-cache policy'+ #a3# Execute \kbd{apt-get dist-upgrade}+ salias adg="apt-get dist-upgrade"+ #a3# Execute \kbd{apt-get install}+ salias agi="apt-get install"+ #a3# Execute \kbd{aptitude install}+ salias ati="aptitude install"+ #a3# Execute \kbd{apt-get upgrade}+ salias ag="apt-get upgrade"+ #a3# Execute \kbd{apt-get update}+ salias au="apt-get update"+ #a3# Execute \kbd{aptitude update ; aptitude safe-upgrade}+ salias -a up="aptitude update ; aptitude safe-upgrade"+ #a3# Execute \kbd{dpkg-buildpackage}+ alias dbp='dpkg-buildpackage'+ #a3# Execute \kbd{grep-excuses}+ alias ge='grep-excuses'++ # get a root shell as normal user in live-cd mode:+ if isgrmlcd && [[ $UID -ne 0 ]] ; then+ alias su="sudo su"+ fi++ #a1# Take a look at the syslog: \kbd{\$PAGER /var/log/syslog}+ salias llog="$PAGER /var/log/syslog" # take a look at the syslog+ #a1# Take a look at the syslog: \kbd{tail -f /var/log/syslog}+ salias tlog="tail -f /var/log/syslog" # follow the syslog+fi++# sort installed Debian-packages by size+if check_com -c dpkg-query ; then+ #a3# List installed Debian-packages sorted by size+ alias debs-by-size="dpkg-query -Wf 'x \${Installed-Size} \${Package} \${Status}\n' | sed -ne '/^x /d' -e '/^x \(.*\) install ok installed$/s//\1/p' | sort -nr"+fi++# if cdrecord is a symlink (to wodim) or isn't present at all warn:+if [[ -L /usr/bin/cdrecord ]] || ! check_com -c cdrecord; then+ if check_com -c wodim; then+ cdrecord() {+ cat <<EOMESS+cdrecord is not provided under its original name by Debian anymore.+See #377109 in the BTS of Debian for more details.++Please use the wodim binary instead+EOMESS+ return 1+ }+ fi+fi++# Use hard limits, except for a smaller stack and no core dumps+unlimit+is425 && limit stack 8192+isgrmlcd && limit core 0 # important for a live-cd-system+limit -s++# completion system++# called later (via is4 && grmlcomp)+# note: use 'zstyle' for getting current settings+# press ^xh (control-x h) for getting tags in context; ^x? (control-x ?) to run complete_debug with trace output+grmlcomp() {+ # TODO: This could use some additional information++ # allow one error for every three characters typed in approximate completer+ zstyle ':completion:*:approximate:' max-errors 'reply=( $((($#PREFIX+$#SUFFIX)/3 )) numeric )'++ # don't complete backup files as executables+ zstyle ':completion:*:complete:-command-::commands' ignored-patterns '(aptitude-*|*\~)'++ # start menu completion only if it could find no unambiguous initial string+ zstyle ':completion:*:correct:*' insert-unambiguous true+ zstyle ':completion:*:corrections' format $'%{\e[0;31m%}%d (errors: %e)%{\e[0m%}'+ zstyle ':completion:*:correct:*' original true++ # activate color-completion+ zstyle ':completion:*:default' list-colors ${(s.:.)LS_COLORS}++ # format on completion+ zstyle ':completion:*:descriptions' format $'%{\e[0;31m%}completing %B%d%b%{\e[0m%}'++ # automatically complete 'cd -<tab>' and 'cd -<ctrl-d>' with menu+ # zstyle ':completion:*:*:cd:*:directory-stack' menu yes select++ # insert all expansions for expand completer+ zstyle ':completion:*:expand:*' tag-order all-expansions+ zstyle ':completion:*:history-words' list false++ # activate menu+ zstyle ':completion:*:history-words' menu yes++ # ignore duplicate entries+ zstyle ':completion:*:history-words' remove-all-dups yes+ zstyle ':completion:*:history-words' stop yes++ # match uppercase from lowercase+ zstyle ':completion:*' matcher-list 'm:{a-z}={A-Z}'++ # separate matches into groups+ zstyle ':completion:*:matches' group 'yes'+ zstyle ':completion:*' group-name ''++ if [[ "$NOMENU" -eq 0 ]] ; then+ # if there are more than 5 options allow selecting from a menu+ zstyle ':completion:*' menu select=5+ else+ # don't use any menus at all+ setopt no_auto_menu+ fi++ zstyle ':completion:*:messages' format '%d'+ zstyle ':completion:*:options' auto-description '%d'++ # describe options in full+ zstyle ':completion:*:options' description 'yes'++ # on processes completion complete all user processes+ zstyle ':completion:*:processes' command 'ps -au$USER'++ # offer indexes before parameters in subscripts+ zstyle ':completion:*:*:-subscript-:*' tag-order indexes parameters++ # provide verbose completion information+ zstyle ':completion:*' verbose true++ # recent (as of Dec 2007) zsh versions are able to provide descriptions+ # for commands (read: 1st word in the line) that it will list for the user+ # to choose from. The following disables that, because it's not exactly fast.+ zstyle ':completion:*:-command-:*:' verbose false++ # set format for warnings+ zstyle ':completion:*:warnings' format $'%{\e[0;31m%}No matches for:%{\e[0m%} %d'++ # define files to ignore for zcompile+ zstyle ':completion:*:*:zcompile:*' ignored-patterns '(*~|*.zwc)'+ zstyle ':completion:correct:' prompt 'correct to: %e'++ # Ignore completion functions for commands you don't have:+ zstyle ':completion::(^approximate*):*:functions' ignored-patterns '_*'++ # Provide more processes in completion of programs like killall:+ zstyle ':completion:*:processes-names' command 'ps c -u ${USER} -o command | uniq'++ # complete manual by their section+ zstyle ':completion:*:manuals' separate-sections true+ zstyle ':completion:*:manuals.*' insert-sections true+ zstyle ':completion:*:man:*' menu yes select++ # provide .. as a completion+ zstyle ':completion:*' special-dirs ..++ # run rehash on completion so new installed program are found automatically:+ _force_rehash() {+ (( CURRENT == 1 )) && rehash+ return 1+ }++ ## correction+ # some people don't like the automatic correction - so run 'NOCOR=1 zsh' to deactivate it+ if [[ "$NOCOR" -gt 0 ]] ; then+ zstyle ':completion:*' completer _oldlist _expand _force_rehash _complete _files _ignored+ setopt nocorrect+ else+ # try to be smart about when to use what completer...+ setopt correct+ zstyle -e ':completion:*' completer '+ if [[ $_last_try != "$HISTNO$BUFFER$CURSOR" ]] ; then+ _last_try="$HISTNO$BUFFER$CURSOR"+ reply=(_complete _match _ignored _prefix _files)+ else+ if [[ $words[1] == (rm|mv) ]] ; then+ reply=(_complete _files)+ else+ reply=(_oldlist _expand _force_rehash _complete _ignored _correct _approximate _files)+ fi+ fi'+ fi++ # command for process lists, the local web server details and host completion+ zstyle ':completion:*:urls' local 'www' '/var/www/' 'public_html'++ # caching+ [[ -d $ZSHDIR/cache ]] && zstyle ':completion:*' use-cache yes && \+ zstyle ':completion::complete:*' cache-path $ZSHDIR/cache/++ # host completion+ if is42 ; then+ [[ -r ~/.ssh/known_hosts ]] && _ssh_hosts=(${${${${(f)"$(<$HOME/.ssh/known_hosts)"}:#[\|]*}%%\ *}%%,*}) || _ssh_hosts=()+ [[ -r /etc/hosts ]] && : ${(A)_etc_hosts:=${(s: :)${(ps:\t:)${${(f)~~"$(</etc/hosts)"}%%\#*}##[:blank:]#[^[:blank:]]#}}} || _etc_hosts=()+ else+ _ssh_hosts=()+ _etc_hosts=()+ fi+ hosts=(+ $(hostname)+ "$_ssh_hosts[@]"+ "$_etc_hosts[@]"+ grml.org+ localhost+ )+ zstyle ':completion:*:hosts' hosts $hosts+ # TODO: so, why is this here?+ # zstyle '*' hosts $hosts++ # use generic completion system for programs not yet defined; (_gnu_generic works+ # with commands that provide a --help option with "standard" gnu-like output.)+ for compcom in cp deborphan df feh fetchipac head hnb ipacsum mv \+ pal stow tail uname ; do+ [[ -z ${_comps[$compcom]} ]] && compdef _gnu_generic ${compcom}+ done; unset compcom++ # see upgrade function in this file+ compdef _hosts upgrade+}++# grmlstuff+grmlstuff() {+# people should use 'grml-x'!+ if check_com -c 915resolution; then+ 855resolution() {+ echo "Please use 915resolution as resolution modifying tool for Intel \+graphic chipset."+ return -1+ }+ fi++ #a1# Output version of running grml+ alias grml-version='cat /etc/grml_version'++ if check_com -c rebuildfstab ; then+ #a1# Rebuild /etc/fstab+ alias grml-rebuildfstab='rebuildfstab -v -r -config'+ fi++ if check_com -c grml-debootstrap ; then+ debian2hd() {+ echo "Installing debian to harddisk is possible by using grml-debootstrap."+ return 1+ }+ fi+}++# now run the functions+isgrml && checkhome+is4 && isgrml && grmlstuff+is4 && grmlcomp++# keephack+is4 && xsource "/etc/zsh/keephack"++# wonderful idea of using "e" glob qualifier by Peter Stephenson+# You use it as follows:+# $ NTREF=/reference/file+# $ ls -l *(e:nt:)+# This lists all the files in the current directory newer than the reference file.+# You can also specify the reference file inline; note quotes:+# $ ls -l *(e:'nt ~/.zshenv':)+is4 && nt() {+ if [[ -n $1 ]] ; then+ local NTREF=${~1}+ fi+ [[ $REPLY -nt $NTREF ]]+}++# shell functions++#f1# Reload an autoloadable function+freload() { while (( $# )); do; unfunction $1; autoload -U $1; shift; done }+compdef _functions freload++#f1# List symlinks in detail (more detailed version of 'readlink -f' and 'whence -s')+sll() {+ [[ -z "$1" ]] && printf 'Usage: %s <file(s)>\n' "$0" && return 1+ for file in "$@" ; do+ while [[ -h "$file" ]] ; do+ ls -l $file+ file=$(readlink "$file")+ done+ done+}++# TODO: Is it supported to use pager settings like this?+# PAGER='less -Mr' - If so, the use of $PAGER here needs fixing+# with respect to wordsplitting. (ie. ${=PAGER})+if check_com -c $PAGER ; then+ #f1# View Debian's changelog of a given package+ dchange() {+ emulate -L zsh+ if [[ -r /usr/share/doc/$1/changelog.Debian.gz ]] ; then+ $PAGER /usr/share/doc/$1/changelog.Debian.gz+ elif [[ -r /usr/share/doc/$1/changelog.gz ]] ; then+ $PAGER /usr/share/doc/$1/changelog.gz+ else+ if check_com -c aptitude ; then+ echo "No changelog for package $1 found, using aptitude to retrieve it."+ if isgrml ; then+ aptitude -t unstable changelog $1+ else+ aptitude changelog $1+ fi+ else+ echo "No changelog for package $1 found, sorry."+ return 1+ fi+ fi+ }+ _dchange() { _files -W /usr/share/doc -/ }+ compdef _dchange dchange++ #f1# View Debian's NEWS of a given package+ dnews() {+ emulate -L zsh+ if [[ -r /usr/share/doc/$1/NEWS.Debian.gz ]] ; then+ $PAGER /usr/share/doc/$1/NEWS.Debian.gz+ else+ if [[ -r /usr/share/doc/$1/NEWS.gz ]] ; then+ $PAGER /usr/share/doc/$1/NEWS.gz+ else+ echo "No NEWS file for package $1 found, sorry."+ return 1+ fi+ fi+ }+ _dnews() { _files -W /usr/share/doc -/ }+ compdef _dnews dnews++ #f1# View upstream's changelog of a given package+ uchange() {+ emulate -L zsh+ if [[ -r /usr/share/doc/$1/changelog.gz ]] ; then+ $PAGER /usr/share/doc/$1/changelog.gz+ else+ echo "No changelog for package $1 found, sorry."+ return 1+ fi+ }+ _uchange() { _files -W /usr/share/doc -/ }+ compdef _uchange uchange+fi++# zsh profiling+profile() {+ ZSH_PROFILE_RC=1 $SHELL "$@"+}++#f1# Edit an alias via zle+edalias() {+ [[ -z "$1" ]] && { echo "Usage: edalias <alias_to_edit>" ; return 1 } || vared aliases'[$1]' ;+}+compdef _aliases edalias++#f1# Edit a function via zle+edfunc() {+ [[ -z "$1" ]] && { echo "Usage: edfunc <function_to_edit>" ; return 1 } || zed -f "$1" ;+}+compdef _functions edfunc++# use it e.g. via 'Restart apache2'+#m# f6 Start() \kbd{/etc/init.d/\em{process}}\quad\kbd{start}+#m# f6 Restart() \kbd{/etc/init.d/\em{process}}\quad\kbd{restart}+#m# f6 Stop() \kbd{/etc/init.d/\em{process}}\quad\kbd{stop}+#m# f6 Reload() \kbd{/etc/init.d/\em{process}}\quad\kbd{reload}+#m# f6 Force-Reload() \kbd{/etc/init.d/\em{process}}\quad\kbd{force-reload}+if [[ -d /etc/init.d || -d /etc/service ]] ; then+ __start_stop() {+ local action_="${1:l}" # e.g Start/Stop/Restart+ local service_="$2"+ local param_="$3"++ local service_target_="$(readlink /etc/init.d/$service_)"+ if [[ $service_target_ == "/usr/bin/sv" ]]; then+ # runit+ case "${action_}" in+ start) if [[ ! -e /etc/service/$service_ ]]; then+ $SUDO ln -s "/etc/sv/$service_" "/etc/service/"+ else+ $SUDO "/etc/init.d/$service_" "${action_}" "$param_"+ fi ;;+ # there is no reload in runits sysv emulation+ reload) $SUDO "/etc/init.d/$service_" "force-reload" "$param_" ;;+ *) $SUDO "/etc/init.d/$service_" "${action_}" "$param_" ;;+ esac+ else+ # sysvinit+ $SUDO "/etc/init.d/$service_" "${action_}" "$param_"+ fi+ }++ _grmlinitd() {+ local -a scripts+ scripts=( /etc/init.d/*(x:t) )+ _describe "service startup script" scripts+ }++ for i in Start Restart Stop Force-Reload Reload ; do+ eval "$i() { __start_stop $i \"\$1\" \"\$2\" ; }"+ compdef _grmlinitd $i+ done+fi++#f1# Provides useful information on globbing+H-Glob() {+ echo -e "+ / directories+ . plain files+ @ symbolic links+ = sockets+ p named pipes (FIFOs)+ * executable plain files (0100)+ % device files (character or block special)+ %b block special files+ %c character special files+ r owner-readable files (0400)+ w owner-writable files (0200)+ x owner-executable files (0100)+ A group-readable files (0040)+ I group-writable files (0020)+ E group-executable files (0010)+ R world-readable files (0004)+ W world-writable files (0002)+ X world-executable files (0001)+ s setuid files (04000)+ S setgid files (02000)+ t files with the sticky bit (01000)++ print *(m-1) # Files modified up to a day ago+ print *(a1) # Files accessed a day ago+ print *(@) # Just symlinks+ print *(Lk+50) # Files bigger than 50 kilobytes+ print *(Lk-50) # Files smaller than 50 kilobytes+ print **/*.c # All *.c files recursively starting in \$PWD+ print **/*.c~file.c # Same as above, but excluding 'file.c'+ print (foo|bar).* # Files starting with 'foo' or 'bar'+ print *~*.* # All Files that do not contain a dot+ chmod 644 *(.^x) # make all plain non-executable files publically readable+ print -l *(.c|.h) # Lists *.c and *.h+ print **/*(g:users:) # Recursively match all files that are owned by group 'users'+ echo /proc/*/cwd(:h:t:s/self//) # Analogous to >ps ax | awk '{print $1}'<"+}+alias help-zshglob=H-Glob++#v1# set number of lines to display per page+HELP_LINES_PER_PAGE=20+#v1# set location of help-zle cache file+HELP_ZLE_CACHE_FILE=~/.cache/zsh_help_zle_lines.zsh+#f1# helper function for help-zle, actually generates the help text+help_zle_parse_keybindings()+{+ emulate -L zsh+ setopt extendedglob+ unsetopt ksharrays #indexing starts at 1++ #v1# choose files that help-zle will parse for keybindings+ ((${+HELPZLE_KEYBINDING_FILES})) || HELPZLE_KEYBINDING_FILES=( /etc/zsh/zshrc ~/.zshrc.pre ~/.zshrc ~/.zshrc.local )++ if [[ -r $HELP_ZLE_CACHE_FILE ]]; then+ local load_cache=0+ for f ($HELPZLE_KEYBINDING_FILES) [[ $f -nt $HELP_ZLE_CACHE_FILE ]] && load_cache=1+ [[ $load_cache -eq 0 ]] && . $HELP_ZLE_CACHE_FILE && return+ fi++ #fill with default keybindings, possibly to be overwriten in a file later+ #Note that due to zsh inconsistency on escaping assoc array keys, we encase the key in '' which we will remove later+ local -A help_zle_keybindings+ help_zle_keybindings['<Ctrl>@']="set MARK"+ help_zle_keybindings['<Ctrl>x<Ctrl>j']="vi-join lines"+ help_zle_keybindings['<Ctrl>x<Ctrl>b']="jump to matching brace"+ help_zle_keybindings['<Ctrl>x<Ctrl>u']="undo"+ help_zle_keybindings['<Ctrl>_']="undo"+ help_zle_keybindings['<Ctrl>x<Ctrl>f<c>']="find <c> in cmdline"+ help_zle_keybindings['<Ctrl>a']="goto beginning of line"+ help_zle_keybindings['<Ctrl>e']="goto end of line"+ help_zle_keybindings['<Ctrl>t']="transpose charaters"+ help_zle_keybindings['<Alt>t']="transpose words"+ help_zle_keybindings['<Alt>s']="spellcheck word"+ help_zle_keybindings['<Ctrl>k']="backward kill buffer"+ help_zle_keybindings['<Ctrl>u']="forward kill buffer"+ help_zle_keybindings['<Ctrl>y']="insert previously killed word/string"+ help_zle_keybindings["<Alt>'"]="quote line"+ help_zle_keybindings['<Alt>"']="quote from mark to cursor"+ help_zle_keybindings['<Alt><arg>']="repeat next cmd/char <arg> times (<Alt>-<Alt>1<Alt>0a -> -10 times 'a')"+ help_zle_keybindings['<Alt>u']="make next word Uppercase"+ help_zle_keybindings['<Alt>l']="make next word lowercase"+ help_zle_keybindings['<Ctrl>xd']="preview expansion under cursor"+ help_zle_keybindings['<Alt>q']="push current CL into background, freeing it. Restore on next CL"+ help_zle_keybindings['<Alt>.']="insert (and interate through) last word from prev CLs"+ help_zle_keybindings['<Alt>,']="complete word from newer history (consecutive hits)"+ help_zle_keybindings['<Alt>m']="repeat last typed word on current CL"+ help_zle_keybindings['<Ctrl>v']="insert next keypress symbol literally (e.g. for bindkey)"+ help_zle_keybindings['!!:n*<Tab>']="insert last n arguments of last command"+ help_zle_keybindings['!!:n-<Tab>']="insert arguments n..N-2 of last command (e.g. mv s s d)"+ help_zle_keybindings['<Alt>h']="show help/manpage for current command"++ #init global variables+ unset help_zle_lines help_zle_sln+ typeset -g -a help_zle_lines+ typeset -g help_zle_sln=1++ local k v+ local lastkeybind_desc contents #last description starting with #k# that we found+ local num_lines_elapsed=0 #number of lines between last description and keybinding+ #search config files in the order they a called (and thus the order in which they overwrite keybindings)+ for f in $HELPZLE_KEYBINDING_FILES; do+ [[ -r "$f" ]] || continue #not readable ? skip it+ contents="$(<$f)"+ for cline in "${(f)contents}"; do+ #zsh pattern: matches lines like: #k# ..............+ if [[ "$cline" == (#s)[[:space:]]#\#k\#[[:space:]]##(#b)(*)[[:space:]]#(#e) ]]; then+ lastkeybind_desc="$match[*]"+ num_lines_elapsed=0+ #zsh pattern: matches lines that set a keybinding using bindkey or compdef -k+ # ignores lines that are commentend out+ # grabs first in '' or "" enclosed string with length between 1 and 6 characters+ elif [[ "$cline" == [^#]#(bindkey|compdef -k)[[:space:]](*)(#b)(\"((?)(#c1,6))\"|\'((?)(#c1,6))\')(#B)(*) ]]; then+ #description prevously found ? description not more than 2 lines away ? keybinding not empty ?+ if [[ -n $lastkeybind_desc && $num_lines_elapsed -lt 2 && -n $match[1] ]]; then+ #substitute keybinding string with something readable+ k=${${${${${${${match[1]/\\e\^h/<Alt><BS>}/\\e\^\?/<Alt><BS>}/\\e\[5~/<PageUp>}/\\e\[6~/<PageDown>}//(\\e|\^\[)/<Alt>}//\^/<Ctrl>}/3~/<Alt><Del>}+ #put keybinding in assoc array, possibly overwriting defaults or stuff found in earlier files+ #Note that we are extracting the keybinding-string including the quotes (see Note at beginning)+ help_zle_keybindings[${k}]=$lastkeybind_desc+ fi+ lastkeybind_desc=""+ else+ ((num_lines_elapsed++))+ fi+ done+ done+ unset contents+ #calculate length of keybinding column+ local kstrlen=0+ for k (${(k)help_zle_keybindings[@]}) ((kstrlen < ${#k})) && kstrlen=${#k}+ #convert the assoc array into preformated lines, which we are able to sort+ for k v in ${(kv)help_zle_keybindings[@]}; do+ #pad keybinding-string to kstrlen chars and remove outermost characters (i.e. the quotes)+ help_zle_lines+=("${(r:kstrlen:)k[2,-2]}${v}")+ done+ #sort lines alphabetically+ help_zle_lines=("${(i)help_zle_lines[@]}")+ [[ -d ${HELP_ZLE_CACHE_FILE:h} ]] || mkdir -p "${HELP_ZLE_CACHE_FILE:h}"+ echo "help_zle_lines=(${(q)help_zle_lines[@]})" >| $HELP_ZLE_CACHE_FILE+ zcompile $HELP_ZLE_CACHE_FILE+}+typeset -g help_zle_sln+typeset -g -a help_zle_lines++#f1# Provides (partially autogenerated) help on keybindings and the zsh line editor+help-zle()+{+ emulate -L zsh+ unsetopt ksharrays #indexing starts at 1+ #help lines already generated ? no ? then do it+ [[ ${+functions[help_zle_parse_keybindings]} -eq 1 ]] && {help_zle_parse_keybindings && unfunction help_zle_parse_keybindings}+ #already displayed all lines ? go back to the start+ [[ $help_zle_sln -gt ${#help_zle_lines} ]] && help_zle_sln=1+ local sln=$help_zle_sln+ #note that help_zle_sln is a global var, meaning we remember the last page we viewed+ help_zle_sln=$((help_zle_sln + HELP_LINES_PER_PAGE))+ zle -M "${(F)help_zle_lines[sln,help_zle_sln-1]}"+}+#k# display help for keybindings and ZLE (cycle pages with consecutive use)+zle -N help-zle && bindkey '^xz' help-zle++# grep for running process, like: 'any vim'+any() {+ emulate -L zsh+ unsetopt KSH_ARRAYS+ if [[ -z "$1" ]] ; then+ echo "any - grep for process(es) by keyword" >&2+ echo "Usage: any <keyword>" >&2 ; return 1+ else+ ps xauwww | grep -i "${grep_options[@]}" "[${1[1]}]${1[2,-1]}"+ fi+}+++# After resuming from suspend, system is paging heavily, leading to very bad interactivity.+# taken from $LINUX-KERNELSOURCE/Documentation/power/swsusp.txt+[[ -r /proc/1/maps ]] && \+deswap() {+ print 'Reading /proc/[0-9]*/maps and sending output to /dev/null, this might take a while.'+ cat $(sed -ne 's:.* /:/:p' /proc/[0-9]*/maps | sort -u | grep -v '^/dev/') > /dev/null+ print 'Finished, running "swapoff -a; swapon -a" may also be useful.'+}++# a wrapper for vim, that deals with title setting+# VIM_OPTIONS+# set this array to a set of options to vim you always want+# to have set when calling vim (in .zshrc.local), like:+# VIM_OPTIONS=( -p )+# This will cause vim to send every file given on the+# commandline to be send to it's own tab (needs vim7).+vim() {+ VIM_PLEASE_SET_TITLE='yes' command vim ${VIM_OPTIONS} "$@"+}++# make a backup of a file+bk() {+ cp -a "$1" "${1}_$(date --iso-8601=seconds)"+}++ssl_hashes=( sha512 sha256 sha1 md5 )++for sh in ${ssl_hashes}; do+ eval 'ssl-cert-'${sh}'() {+ emulate -L zsh+ if [[ -z $1 ]] ; then+ printf '\''usage: %s <file>\n'\'' "ssh-cert-'${sh}'"+ return 1+ fi+ openssl x509 -noout -fingerprint -'${sh}' -in $1+ }'+done; unset sh++ssl-cert-fingerprints() {+ emulate -L zsh+ local i+ if [[ -z $1 ]] ; then+ printf 'usage: ssl-cert-fingerprints <file>\n'+ return 1+ fi+ for i in ${ssl_hashes}+ do ssl-cert-$i $1;+ done+}++ssl-cert-info() {+ emulate -L zsh+ if [[ -z $1 ]] ; then+ printf 'usage: ssl-cert-info <file>\n'+ return 1+ fi+ openssl x509 -noout -text -in $1+ ssl-cert-fingerprints $1+}++# make sure our environment is clean regarding colors+for color in BLUE RED GREEN CYAN YELLOW MAGENTA WHITE ; unset $color++# "persistent history"+# just write important commands you always need to ~/.important_commands+if [[ -r ~/.important_commands ]] ; then+ fc -R ~/.important_commands+fi++# load the lookup subsystem if it's available on the system+zrcautoload lookupinit && lookupinit++# variables++# set terminal property (used e.g. by msgid-chooser)+export COLORTERM="yes"++# aliases++# general+#a2# Execute \kbd{du -sch}+alias da='du -sch'+#a2# Execute \kbd{jobs -l}+alias j='jobs -l'++# listing stuff+#a2# Execute \kbd{ls -lSrah}+alias dir="ls -lSrah"+#a2# Only show dot-directories+alias lad='ls -d .*(/)' # only show dot-directories+#a2# Only show dot-files+alias lsa='ls -a .*(.)' # only show dot-files+#a2# Only files with setgid/setuid/sticky flag+alias lss='ls -l *(s,S,t)' # only files with setgid/setuid/sticky flag+#a2# Only show 1st ten symlinks+alias lsl='ls -l *(@)' # only symlinks+#a2# Display only executables+alias lsx='ls -l *(*)' # only executables+#a2# Display world-{readable,writable,executable} files+alias lsw='ls -ld *(R,W,X.^ND/)' # world-{readable,writable,executable} files+#a2# Display the ten biggest files+alias lsbig="ls -flh *(.OL[1,10])" # display the biggest files+#a2# Only show directories+alias lsd='ls -d *(/)' # only show directories+#a2# Only show empty directories+alias lse='ls -d *(/^F)' # only show empty directories+#a2# Display the ten newest files+alias lsnew="ls -rtlh *(D.om[1,10])" # display the newest files+#a2# Display the ten oldest files+alias lsold="ls -rtlh *(D.Om[1,10])" # display the oldest files+#a2# Display the ten smallest files+alias lssmall="ls -Srl *(.oL[1,10])" # display the smallest files+#a2# Display the ten newest directories and ten newest .directories+alias lsnewdir="ls -rthdl *(/om[1,10]) .*(D/om[1,10])"+#a2# Display the ten oldest directories and ten oldest .directories+alias lsolddir="ls -rthdl *(/Om[1,10]) .*(D/Om[1,10])"++# some useful aliases+#a2# Remove current empty directory. Execute \kbd{cd ..; rmdir $OLDCWD}+alias rmcdir='cd ..; rmdir $OLDPWD || cd $OLDPWD'++#a2# ssh with StrictHostKeyChecking=no \\&\quad and UserKnownHostsFile unset+alias insecssh='ssh -o "StrictHostKeyChecking=no" -o "UserKnownHostsFile=/dev/null"'+alias insecscp='scp -o "StrictHostKeyChecking=no" -o "UserKnownHostsFile=/dev/null"'++# simple webserver+check_com -c python && alias http="python -m SimpleHTTPServer"++# work around non utf8 capable software in utf environment via $LANG and luit+if check_com isutfenv && check_com luit ; then+ if check_com -c mrxvt ; then+ isutfenv && [[ -n "$LANG" ]] && \+ alias mrxvt="LANG=${LANG/(#b)(*)[.@]*/$match[1].iso885915} luit mrxvt"+ fi++ if check_com -c aterm ; then+ isutfenv && [[ -n "$LANG" ]] && \+ alias aterm="LANG=${LANG/(#b)(*)[.@]*/$match[1].iso885915} luit aterm"+ fi++ if check_com -c centericq ; then+ isutfenv && [[ -n "$LANG" ]] && \+ alias centericq="LANG=${LANG/(#b)(*)[.@]*/$match[1].iso885915} luit centericq"+ fi+fi++# useful functions++#f5# Backup \kbd{file {\rm to} file\_timestamp}+bk() {+ emulate -L zsh+ cp -b $1 $1_`date --iso-8601=m`+}++#f5# cd to directoy and list files+cl() {+ emulate -L zsh+ cd $1 && ls -a+}++# smart cd function, allows switching to /etc when running 'cd /etc/fstab'+cd() {+ if (( ${#argv} == 1 )) && [[ -f ${1} ]]; then+ [[ ! -e ${1:h} ]] && return 1+ print "Correcting ${1} to ${1:h}"+ builtin cd ${1:h}+ else+ builtin cd "$@"+ fi+}++#f5# Create Directoy and \kbd{cd} to it+mkcd() {+ mkdir -p "$@" && cd "$@"+}++#f5# Create temporary directory and \kbd{cd} to it+cdt() {+ local t+ t=$(mktemp -d)+ echo "$t"+ builtin cd "$t"+}++#f5# Create directory under cursor or the selected area+# Press ctrl-xM to create the directory under the cursor or the selected area.+# To select an area press ctrl-@ or ctrl-space and use the cursor.+# Use case: you type "mv abc ~/testa/testb/testc/" and remember that the+# directory does not exist yet -> press ctrl-XM and problem solved+inplaceMkDirs() {+ local PATHTOMKDIR+ if ((REGION_ACTIVE==1)); then+ local F=$MARK T=$CURSOR+ if [[ $F -gt $T ]]; then+ F=${CURSOR}+ T=${MARK}+ fi+ # get marked area from buffer and eliminate whitespace+ PATHTOMKDIR=${BUFFER[F+1,T]%%[[:space:]]##}+ PATHTOMKDIR=${PATHTOMKDIR##[[:space:]]##}+ else+ local bufwords iword+ bufwords=(${(z)LBUFFER})+ iword=${#bufwords}+ bufwords=(${(z)BUFFER})+ PATHTOMKDIR="${(Q)bufwords[iword]}"+ fi+ [[ -z "${PATHTOMKDIR}" ]] && return 1+ if [[ -e "${PATHTOMKDIR}" ]]; then+ zle -M " path already exists, doing nothing"+ else+ zle -M "$(mkdir -p -v "${PATHTOMKDIR}")"+ zle end-of-line+ fi+}+#k# mkdir -p <dir> from string under cursor or marked area+zle -N inplaceMkDirs && bindkey '^xM' inplaceMkDirs++#f5# List files which have been accessed within the last {\it n} days, {\it n} defaults to 1+accessed() {+ emulate -L zsh+ print -l -- *(a-${1:-1})+}++#f5# List files which have been changed within the last {\it n} days, {\it n} defaults to 1+changed() {+ emulate -L zsh+ print -l -- *(c-${1:-1})+}++#f5# List files which have been modified within the last {\it n} days, {\it n} defaults to 1+modified() {+ emulate -L zsh+ print -l -- *(m-${1:-1})+}+# modified() was named new() in earlier versions, add an alias for backwards compatibility+check_com new || alias new=modified++# use colors when GNU grep with color-support+#a2# Execute \kbd{grep -{}-color=auto}+(( $#grep_options > 0 )) && alias grep='grep '${grep_options:+"${grep_options[*]} "}++# Translate DE<=>EN+# 'translate' looks up fot a word in a file with language-to-language+# translations (field separator should be " : "). A typical wordlist looks+# like at follows:+# | english-word : german-transmission+# It's also only possible to translate english to german but not reciprocal.+# Use the following oneliner to turn back the sort order:+# $ awk -F ':' '{ print $2" : "$1" "$3 }' \+# /usr/local/lib/words/en-de.ISO-8859-1.vok > ~/.translate/de-en.ISO-8859-1.vok+#f5# Translates a word+trans() {+ emulate -L zsh+ case "$1" in+ -[dD]*)+ translate -l de-en $2+ ;;+ -[eE]*)+ translate -l en-de $2+ ;;+ *)+ echo "Usage: $0 { -D | -E }"+ echo " -D == German to English"+ echo " -E == English to German"+ esac+}++# Usage: simple-extract <file>+# Using option -d deletes the original archive file.+#f5# Smart archive extractor+simple-extract() {+ emulate -L zsh+ setopt extended_glob noclobber+ local DELETE_ORIGINAL DECOMP_CMD USES_STDIN USES_STDOUT GZTARGET WGET_CMD+ local RC=0+ zparseopts -D -E "d=DELETE_ORIGINAL"+ for ARCHIVE in "${@}"; do+ case $ARCHIVE in+ *.(tar.bz2|tbz2|tbz))+ DECOMP_CMD="tar -xvjf -"+ USES_STDIN=true+ USES_STDOUT=false+ ;;+ *.(tar.gz|tgz))+ DECOMP_CMD="tar -xvzf -"+ USES_STDIN=true+ USES_STDOUT=false+ ;;+ *.(tar.xz|txz|tar.lzma))+ DECOMP_CMD="tar -xvJf -"+ USES_STDIN=true+ USES_STDOUT=false+ ;;+ *.tar)+ DECOMP_CMD="tar -xvf -"+ USES_STDIN=true+ USES_STDOUT=false+ ;;+ *.rar)+ DECOMP_CMD="unrar x"+ USES_STDIN=false+ USES_STDOUT=false+ ;;+ *.lzh)+ DECOMP_CMD="lha x"+ USES_STDIN=false+ USES_STDOUT=false+ ;;+ *.7z)+ DECOMP_CMD="7z x"+ USES_STDIN=false+ USES_STDOUT=false+ ;;+ *.(zip|jar))+ DECOMP_CMD="unzip"+ USES_STDIN=false+ USES_STDOUT=false+ ;;+ *.deb)+ DECOMP_CMD="ar -x"+ USES_STDIN=false+ USES_STDOUT=false+ ;;+ *.bz2)+ DECOMP_CMD="bzip2 -d -c -"+ USES_STDIN=true+ USES_STDOUT=true+ ;;+ *.(gz|Z))+ DECOMP_CMD="gzip -d -c -"+ USES_STDIN=true+ USES_STDOUT=true+ ;;+ *.(xz|lzma))+ DECOMP_CMD="xz -d -c -"+ USES_STDIN=true+ USES_STDOUT=true+ ;;+ *)+ print "ERROR: '$ARCHIVE' has unrecognized archive type." >&2+ RC=$((RC+1))+ continue+ ;;+ esac++ if ! check_com ${DECOMP_CMD[(w)1]}; then+ echo "ERROR: ${DECOMP_CMD[(w)1]} not installed." >&2+ RC=$((RC+2))+ continue+ fi++ GZTARGET="${ARCHIVE:t:r}"+ if [[ -f $ARCHIVE ]] ; then++ print "Extracting '$ARCHIVE' ..."+ if $USES_STDIN; then+ if $USES_STDOUT; then+ ${=DECOMP_CMD} < "$ARCHIVE" > $GZTARGET+ else+ ${=DECOMP_CMD} < "$ARCHIVE"+ fi+ else+ if $USES_STDOUT; then+ ${=DECOMP_CMD} "$ARCHIVE" > $GZTARGET+ else+ ${=DECOMP_CMD} "$ARCHIVE"+ fi+ fi+ [[ $? -eq 0 && -n "$DELETE_ORIGINAL" ]] && rm -f "$ARCHIVE"++ elif [[ "$ARCHIVE" == (#s)(https|http|ftp)://* ]] ; then+ if check_com curl; then+ WGET_CMD="curl -L -k -s -o -"+ elif check_com wget; then+ WGET_CMD="wget -q -O - --no-check-certificate"+ else+ print "ERROR: neither wget nor curl is installed" >&2+ RC=$((RC+4))+ continue+ fi+ print "Downloading and Extracting '$ARCHIVE' ..."+ if $USES_STDIN; then+ if $USES_STDOUT; then+ ${=WGET_CMD} "$ARCHIVE" | ${=DECOMP_CMD} > $GZTARGET+ RC=$((RC+$?))+ else+ ${=WGET_CMD} "$ARCHIVE" | ${=DECOMP_CMD}+ RC=$((RC+$?))+ fi+ else+ if $USES_STDOUT; then+ ${=DECOMP_CMD} =(${=WGET_CMD} "$ARCHIVE") > $GZTARGET+ else+ ${=DECOMP_CMD} =(${=WGET_CMD} "$ARCHIVE")+ fi+ fi++ else+ print "ERROR: '$ARCHIVE' is neither a valid file nor a supported URI." >&2+ RC=$((RC+8))+ fi+ done+ return $RC+}++__archive_or_uri()+{+ _alternative \+ 'files:Archives:_files -g "*.(#l)(tar.bz2|tbz2|tbz|tar.gz|tgz|tar.xz|txz|tar.lzma|tar|rar|lzh|7z|zip|jar|deb|bz2|gz|Z|xz|lzma)"' \+ '_urls:Remote Archives:_urls'+}++_simple_extract()+{+ _arguments \+ '-d[delete original archivefile after extraction]' \+ '*:Archive Or Uri:__archive_or_uri'+}+compdef _simple_extract simple-extract+alias se=simple-extract++#f5# Set all ulimit parameters to \kbd{unlimited}+allulimit() {+ ulimit -c unlimited+ ulimit -d unlimited+ ulimit -f unlimited+ ulimit -l unlimited+ ulimit -n unlimited+ ulimit -s unlimited+ ulimit -t unlimited+}++#f5# Change the xterm title from within GNU-screen+xtrename() {+ emulate -L zsh+ if [[ $1 != "-f" ]] ; then+ if [[ -z ${DISPLAY} ]] ; then+ printf 'xtrename only makes sense in X11.\n'+ return 1+ fi+ else+ shift+ fi+ if [[ -z $1 ]] ; then+ printf 'usage: xtrename [-f] "title for xterm"\n'+ printf ' renames the title of xterm from _within_ screen.\n'+ printf ' also works without screen.\n'+ printf ' will not work if DISPLAY is unset, use -f to override.\n'+ return 0+ fi+ print -n "\eP\e]0;${1}\C-G\e\\"+ return 0+}++# TODO:+# Rewrite this by either using tinyurl.com's API+# or using another shortening service to comply with+# tinyurl.com's policy.+#+# Create small urls via http://tinyurl.com using wget(1).+#function zurl() {+# emulate -L zsh+# [[ -z $1 ]] && { print "USAGE: zurl <URL>" ; return 1 }+#+# local PN url tiny grabber search result preview+# PN=$0+# url=$1+## Check existence of given URL with the help of ping(1).+## N.B. ping(1) only works without an eventual given protocol.+# ping -c 1 ${${url#(ftp|http)://}%%/*} >& /dev/null || \+# read -q "?Given host ${${url#http://*/}%/*} is not reachable by pinging. Proceed anyway? [y|n] "+#+# if (( $? == 0 )) ; then+## Prepend 'http://' to given URL where necessary for later output.+# [[ ${url} != http(s|)://* ]] && url='http://'${url}+# tiny='http://tinyurl.com/create.php?url='+# if check_com -c wget ; then+# grabber='wget -O- -o/dev/null'+# else+# print "wget is not available, but mandatory for ${PN}. Aborting."+# fi+## Looking for i.e.`copy('http://tinyurl.com/7efkze')' in TinyURL's HTML code.+# search='copy\(?http://tinyurl.com/[[:alnum:]]##*'+# result=${(M)${${${(f)"$(${=grabber} ${tiny}${url})"}[(fr)${search}*]}//[()\';]/}%%http:*}+## TinyURL provides the rather new feature preview for more confidence. <http://tinyurl.com/preview.php>+# preview='http://preview.'${result#http://}+#+# printf '%s\n\n' "${PN} - Shrinking long URLs via webservice TinyURL <http://tinyurl.com>."+# printf '%s\t%s\n\n' 'Given URL:' ${url}+# printf '%s\t%s\n\t\t%s\n' 'TinyURL:' ${result} ${preview}+# else+# return 1+# fi+#}++#f2# Find history events by search pattern and list them by date.+whatwhen() {+ emulate -L zsh+ local usage help ident format_l format_s first_char remain first last+ usage='USAGE: whatwhen [options] <searchstring> <search range>'+ help='Use `whatwhen -h'\'' for further explanations.'+ ident=${(l,${#${:-Usage: }},, ,)}+ format_l="${ident}%s\t\t\t%s\n"+ format_s="${format_l//(\\t)##/\\t}"+ # Make the first char of the word to search for case+ # insensitive; e.g. [aA]+ first_char=[${(L)1[1]}${(U)1[1]}]+ remain=${1[2,-1]}+ # Default search range is `-100'.+ first=${2:-\-100}+ # Optional, just used for `<first> <last>' given.+ last=$3+ case $1 in+ ("")+ printf '%s\n\n' 'ERROR: No search string specified. Aborting.'+ printf '%s\n%s\n\n' ${usage} ${help} && return 1+ ;;+ (-h)+ printf '%s\n\n' ${usage}+ print 'OPTIONS:'+ printf $format_l '-h' 'show help text'+ print '\f'+ print 'SEARCH RANGE:'+ printf $format_l "'0'" 'the whole history,'+ printf $format_l '-<n>' 'offset to the current history number; (default: -100)'+ printf $format_s '<[-]first> [<last>]' 'just searching within a give range'+ printf '\n%s\n' 'EXAMPLES:'+ printf ${format_l/(\\t)/} 'whatwhen grml' '# Range is set to -100 by default.'+ printf $format_l 'whatwhen zsh -250'+ printf $format_l 'whatwhen foo 1 99'+ ;;+ (\?)+ printf '%s\n%s\n\n' ${usage} ${help} && return 1+ ;;+ (*)+ # -l list results on stout rather than invoking $EDITOR.+ # -i Print dates as in YYYY-MM-DD.+ # -m Search for a - quoted - pattern within the history.+ fc -li -m "*${first_char}${remain}*" $first $last+ ;;+ esac+}++# mercurial related stuff+if check_com -c hg ; then+ # gnu like diff for mercurial+ # http://www.selenic.com/mercurial/wiki/index.cgi/TipsAndTricks+ #f5# GNU like diff for mercurial+ hgdi() {+ emulate -L zsh+ for i in $(hg status -marn "$@") ; diff -ubwd <(hg cat "$i") "$i"+ }++ # build debian package+ #a2# Alias for \kbd{hg-buildpackage}+ alias hbp='hg-buildpackage'++ # execute commands on the versioned patch-queue from the current repos+ alias mq='hg -R $(readlink -f $(hg root)/.hg/patches)'++ # diffstat for specific version of a mercurial repository+ # hgstat => display diffstat between last revision and tip+ # hgstat 1234 => display diffstat between revision 1234 and tip+ #f5# Diffstat for specific version of a mercurial repos+ hgstat() {+ emulate -L zsh+ [[ -n "$1" ]] && hg diff -r $1 -r tip | diffstat || hg export tip | diffstat+ }++fi # end of check whether we have the 'hg'-executable++# grml-small cleanups++# The following is used to remove zsh-config-items that do not work+# in grml-small by default.+# If you do not want these adjustments (for whatever reason), set+# $GRMLSMALL_SPECIFIC to 0 in your .zshrc.pre file (which this configuration+# sources if it is there).++if (( GRMLSMALL_SPECIFIC > 0 )) && isgrmlsmall ; then++ unset abk[V]+ unalias 'V' &> /dev/null+ unfunction vman &> /dev/null+ unfunction viless &> /dev/null+ unfunction 2html &> /dev/null++ # manpages are not in grmlsmall+ unfunction manzsh &> /dev/null+ unfunction man2 &> /dev/null++fi++zrclocal++## genrefcard.pl settings++### doc strings for external functions from files+#m# f5 grml-wallpaper() Sets a wallpaper (try completion for possible values)++### example: split functions-search 8,16,24,32+#@# split functions-search 8++for file in $HOME/.zsh/*; do+ source $file+done++## END OF FILE #################################################################+# vim:filetype=zsh foldmethod=marker autoindent expandtab shiftwidth=4+# Local variables:+# mode: sh+# End:
+ test/examples/color.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ExtendedDefaultRules #-}+import Shelly+import System.Process (rawSystem)+import Control.Monad (void)+import Data.Text (Text)++default (Text)++main = shelly $ do+ void $ liftIO $ rawSystem "ls" ["--color=auto", "test"]+ run_ "ls" ["--color=auto", "test"]
+ test/examples/drain.hs view
@@ -0,0 +1,19 @@+{-# Language OverloadedStrings, ExtendedDefaultRules #-}++import Shelly+import Control.Monad (void)+import Data.Text (Text)++default (Text)++main :: IO ()+main = do+ let exDir = "./test/examples"+ void $ shelly $ do+ let strs = ["a", "b"] :: [String]+ let texts = ["a", "b"] :: [Text]+ let inferred = ["a", "b"]+ res <- cmd (exDir </> "drain.sh") strs texts inferred+ echo "haskell done"+ echo res+ cmd $ exDir </> "printer.sh"
+ test/examples/drain.sh view
@@ -0,0 +1,4 @@+#!/bin/sh+echo "starting"+sleep 2+echo "finished"
+ test/examples/printer.sh view
@@ -0,0 +1,6 @@+#!/bin/sh++while true; do+ echo "hello"+ sleep 1+done
+ test/examples/run-handles.hs view
@@ -0,0 +1,8 @@+{-# Language OverloadedStrings, ExtendedDefaultRules #-}+import Shelly+-- This test runs, but causes this error to show up:+-- Exception: cannot access an inherited pipe+main = shelly $+ runHandles "bash" ["test/examples/test.sh"] handles doNothing+ where handles = [InHandle Inherit, OutHandle Inherit, ErrorHandle Inherit]+ doNothing _ _ _ = return ""
+ test/examples/test.sh view
@@ -0,0 +1,2 @@+#!/bin/bash+echo hi
+ test/src/CopySpec.hs view
@@ -0,0 +1,80 @@+{-# Language CPP #-}+module CopySpec ( copySpec ) where++import TestInit++import Control.Monad (forM_)+import System.IO.Error+import Help++copySpec :: Spec+copySpec = do+ let b = "b"+ let c = "c"+ describe "cp file" $ do+ it "cp to same dir" $+ forM_ [cp, cp_r] $ \copier -> do+ res <- shelly $+ within_dir "test/a" $ do+ writefile b "testing"+ copier b c+ readfile c+ res @?= "testing"++ it "cp to other dir" $+ forM_ [cp, cp_r] $ \copier -> do+ res <- shelly $+ within_dir "test/a" $ do+ writefile b "testing"+ mkdir c+ copier b c+ readfile "c/b"+ res @?= "testing"++ describe "cp dir" $ do+ it "to dir does not exist: create the to dir" $ do+ res <- shelly $+ within_dir "test/a" $ do+ mkdir b+ writefile "b/d" ""+ cp_r b c+ cIsDir <- test_d c+ 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+ mkdir b+ mkdir c+ writefile "b/d" ""+ cp_r b $ c</>b+ cIsDir <- test_d c+ liftIO $ assert $ cIsDir+ bIsDir <- test_d $ c</>b+ 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+ mkdir b+ mkdir c+ writefile "b/d" ""+ cp_r b $ c+ cIsDir <- test_d c+ liftIO $ assert $ cIsDir+ bIsDir <- test_d $ c</>b+ liftIO $ assert $ bIsDir+ test_f "c/b/d"+ assert res++ it "copies the same dir" $ do+ shelly $+ within_dir "test/a" $ do+ mkdir b+ writefile "b/d" ""+ cp_r b b `catch_sh` (\e -> liftIO $ assert $ isUserError e)+ assert True
+ test/src/EnvSpec.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE CPP #-}+module EnvSpec ( envSpec ) where++import TestInit+import Data.Maybe++envSpec :: Spec+envSpec = do+ describe "getting unset env variables" $ do+ it "get_env" $ do+ res <- shelly $ get_env "FOOBARSHELLY"+ assert $ isNothing res++ it "get_env_text" $ do+ res <- shelly $ get_env_text "FOOBARSHELLY"+ assert $ res == ""++ describe "with SHELLY var set" $ do+ it "get_env" $ do+ res <- shelly $ do+ setenv "SHELLY" "test"+ get_env "SHELLY"+ assert $ res == Just "test"++ it "get_env_text" $ do+ res <- shelly $ do+ 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/FailureSpec.hs view
@@ -0,0 +1,29 @@+module FailureSpec ( failureSpec ) where++import TestInit++failureSpec :: Spec+failureSpec = do+ let discardException action = shellyFailDir $ catchany_sh action (\_ -> return ())++ describe "failure set to stderr" $+ it "writes a failure message to stderr" $ do+ shellyFailDir $ discardException $+ liftIO $ shelly $ do+ test_d ".shelly" >>= liftIO . assert . not+ echo "testing"+ error "bam!"+ assert . not =<< shellyFailDir (test_d ".shelly")++ describe "failure set to directory" $+ it "writes a failure message to a .shelly directory" $ do+ shellyFailDir $ discardException $+ shellyFailDir $ do+ test_d ".shelly" >>= liftIO . assert . not+ echo "testing"+ error "bam!"+ assert =<< shellyFailDir ( do+ exists <- test_d ".shelly"+ rm_rf ".shelly"+ return exists+ )
+ test/src/FindSpec.hs view
@@ -0,0 +1,137 @@+module FindSpec ( findSpec ) where++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+ it "relative to non-existent dir" $ do+ res <- shelly $ relativeTo "rel/" "rel/foo"+ res @?= "foo"+ res2 <- shelly $ relativeTo "rel" "rel/foo"+ res2 @?= "foo"++ it "relative to existing dir" $ do+ res <- shelly $ relativeTo "test/" "test/drain.hs"+ res @?= "drain.hs"+ res2 <- shelly $ relativeTo "test" "test/drain.hs"+ res2 @?= "drain.hs"++ it "abs path relative to existing dir" $ do+ res <- shelly $ do+ d <- pwd+ relativeTo "test/" $ d </> "test/drain.hs"+ res @?= "drain.hs"++ describe "relative listing" $ do+ it "lists relative files" $ do+ res <- shelly $ cd "test/src" >> ls "."+ sort res @?= map toWindowsStyleIfNecessary ["./CopySpec.hs", "./EnvSpec.hs", "./FailureSpec.hs",+ "./FindSpec.hs", "./Help.hs", "./LiftedSpec.hs", "./LogWithSpec.hs", "./MoveSpec.hs",+ "./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 @?= map toWindowsStyleIfNecessary ["./CopySpec.hs", "./EnvSpec.hs", "./FailureSpec.hs",+ "./FindSpec.hs", "./Help.hs", "./LiftedSpec.hs", "./LogWithSpec.hs", "./MoveSpec.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"]++ describe "find" $ do+ it "empty list for empty dir" $ do+ let d = "deleteme"+ res <- shelly $ do+ mkdir_p d+ res <- find d+ rm_rf d+ return res+ res @?= []++ it "lists relative files" $ do+ 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/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"]++ it "lists absolute files" $ do+ res <- shelly $ relPath "test/src" >>= find >>= mapM (relativeTo "test/src")+ sort res @?= ["CopySpec.hs", "EnvSpec.hs", "FailureSpec.hs", "FindSpec.hs",+ "Help.hs", "LiftedSpec.hs", "LogWithSpec.hs", "MoveSpec.hs",+ "PipeSpec.hs", "PrintCommandsFnSpec.hs", "ReadFileSpec.hs", "RmSpec.hs", "RunSpec.hs",+ "ShowCommandSpec.hs", "SshSpec.hs", "TestInit.hs", "TestMain.hs",+ "WhichSpec.hs", "WriteSpec.hs", "sleep.hs"]++ 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
@@ -0,0 +1,19 @@+module Help (+ with_dir, within_dir,+ (@==)+) where++import Shelly+import Test.HUnit+import Control.Monad.Trans ( MonadIO )++(@==) :: (Eq a, Show a, MonadIO m) => a -> a -> m ()+(@==) a b = liftIO (a @?= b)++with_dir :: FilePath -> Sh a -> Sh a+with_dir d action =+ mkdir_p d >> (action `finally_sh` rm_rf d)++within_dir :: FilePath -> Sh a -> Sh a+within_dir d action =+ with_dir d $ chdir d action
+ test/src/LiftedSpec.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE OverloadedStrings #-}++module LiftedSpec ( liftedSpec ) where++import Test.HUnit hiding (path)+import Test.Hspec+import Shelly.Lifted+import Control.Concurrent.Async.Lifted+import Control.Monad.Trans.Maybe+import Test.Hspec.Contrib.HUnit ()++liftedSpec :: Spec+liftedSpec =+ describe "basic actions" $+ it "lifted sub" $ do+ xs <- shelly $+ runMaybeT $ do+ echo "Hello!"+ sub $ withTmpDir $ \p -> wait =<< (async $ do+ writefile (p </> "test.txt") "hello"+ readfile (p </> "test.txt")+ )+ xs @?= Just "hello"
+ test/src/LogWithSpec.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE OverloadedStrings #-}+module LogWithSpec ( logWithSpec ) where++import TestInit++import Control.Concurrent (newEmptyMVar, takeMVar, putMVar)+import Data.Text (Text)+default (Text)++logWithSpec :: Spec+logWithSpec =+ describe "withOutputWriter" $+ it "calls writer function with handler and stdout output" $ do+ outputVar <- newEmptyMVar+ shelly $ log_stdout_with (putMVar outputVar)+ $ run_ "echo" ["single line output"]+ result <- takeMVar outputVar+ assertEqual "expecting output" "single line output" result
+ test/src/MoveSpec.hs view
@@ -0,0 +1,76 @@+module MoveSpec (moveSpec) where++import TestInit+import Help++moveSpec :: Spec+moveSpec = do+ let b = "b"+ let c = "c"+ describe "mv file" $ do+ it "to same dir" $ do+ res <- shelly $+ within_dir "test/a" $ do+ writefile b "testing"+ mv b c+ readfile c+ res @?= "testing"++ it "to other dir" $ do+ res <- shelly $+ within_dir "test/a" $ do+ writefile b "testing"+ mkdir c+ 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 $+ within_dir "test/a" $ do+ mkdir b+ writefile "b/d" ""+ mv b c+ cIsDir <- test_d c+ 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+ mkdir b+ mkdir c+ writefile "b/d" ""+ mv b $ c</>b+ cIsDir <- test_d c+ liftIO $ assert cIsDir+ bIsDir <- test_d $ c</>b+ 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+ mkdir b+ mkdir c+ writefile "b/d" ""+ mv b $ c+ cIsDir <- test_d c+ liftIO $ assert cIsDir+ bIsDir <- test_d $ c</>b+ liftIO $ assert bIsDir+ test_f "c/b/d"+ assert res++ {-+ it "mv the same dir" $ do+ shelly $ do+ within_dir "test/a" $ do+ mkdir b+ writefile "b/d" ""+ mv b b `catch_sh` (\e -> liftIO $ assert $ isUserError e)+ assert True+ -}
+ 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
@@ -0,0 +1,17 @@+{-# LANGUAGE CPP #-}++module ReadFileSpec (readFileSpec) where++import TestInit+import qualified Data.ByteString as BS+import qualified Data.Text as T++readFileSpec :: Spec+readFileSpec = describe "file with invalid encoding" $ do+ 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
@@ -0,0 +1,83 @@+module RmSpec (rmSpec) where++import TestInit+import Data.Text as T+import Help++rmSpec :: Spec+rmSpec = do+ let b = "b"+ let d = "dir"+ describe "rm file" $ do+ it "rm" $ do+ res <- shelly $ do+ writefile b "testing"+ (True @==) =<< test_f b+ rm b+ test_f b+ assert (not res)++ it "rm_r" $ do+ res <- shelly $ do+ writefile b "testing"+ (True @==) =<< test_f b+ rm b+ test_f b+ assert $ not res++ it "rm_f" $ do+ res <- shelly $ do+ (False @==) =<< test_f b+ rm_f b+ test_f b+ assert $ not res++ describe "rm_rf dir" $ do+ it "empty dir" $ do+ res <- shelly $ do+ mkdir d+ rm_rf d+ test_d d+ assert $ not res++ it "dir with file" $ do+ res <- shelly $ do+ mkdir d+ rm d `catchany_sh` (\_ -> return ())+ (True @==) =<< test_d d+ writefile (d </> b) "testing"+ rm d `catchany_sh` (\_ -> return ())+ (True @==) =<< test_d d+ rm_rf d+ test_d d+ assert $ not res++ describe "rm symlink" $ do+ let l = "l"+ it "rm" $ do+ res <- shelly $ do+ writefile b "b"+ _ <- cmd "ln" "-s" (T.pack b) (T.pack l)+ rm l+ test_f b+ assert res+ shelly $ rm b++ it "rm_f" $ do+ res <- shelly $ do+ writefile b "b"+ _ <- cmd "ln" "-s" (T.pack b) (T.pack l)+ rm_f l+ test_f b+ assert res+ shelly $ rm_f b++ it "rm_rf" $ do+ res <- shelly $ do+ mkdir d+ writefile (d</>b) "b"+ _ <- cmd "ln" "-s" (T.pack $ d</>b) (T.pack l)+ rm_rf l+ test_f (d</>b)+ assert res+ shelly $ rm_rf d
+ test/src/RunSpec.hs view
@@ -0,0 +1,170 @@+module RunSpec ( runSpec ) where++import TestInit++import qualified Data.Text as T+import Data.Text (Text)+import System.IO++runSpec :: Spec+runSpec = do+ describe "run" $ do+ it "simple command" $ do+ res <- shelly $ run "echo" [ "wibble" ]+ res @?= "wibble\n"++ it "with escaping" $ do+ res <- shelly $ run "echo" [ "*" ]+ res @?= "*\n"++ it "without escaping" $ do+ res <- shelly $ escaping False $ run "echo" [ "*" ]+ 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" ]+ 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+ res <- shelly $ bash "echo" [ "wibble" ]+ res @?= "wibble\n"++ it "without escaping" $ do+ res <- shelly $ escaping False $ bash "echo" [ "*" ]+ assert $ "README.md" `elem` T.words res++ it "with binary handle mode" $ do+ res <- shelly $ onCommandHandles (initOutputHandles (flip hSetBinaryMode True))+ $ bash "cat" [ "test/data/nonascii.txt" ]+ 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+ eCode <- shelly $ escaping False $ errExit False $ do+ bashPipeFail+ bash_ "echo" ["'foo'", "|", "ls", "\"eoueouoe\"", "2>/dev/null", "|", "echo", "'bar'" ]+ lastExitCode+ eCode `shouldSatisfy` (/= 0)+ -}++ it "preserve pipe behaviour" $ do+ (eCode, res) <- shelly $ escaping False $ errExit False $ do+ res <-+ if isWindows+ then bash "echo" [ "foo", "|", "echo", "bar" ]+ else bash "echo" [ "'foo'", "|", "echo", "'bar'" ]+ eCode <- lastExitCode+ return (eCode, res)+ 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
@@ -0,0 +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 @?= T.concat [q, qq, "wibble", qq, q]++ it "space command" $ do+ let res = sshCommandText [("to", ["outer space"])] SeqSsh+ 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 @?= 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
@@ -0,0 +1,13 @@+module TestInit (module Export, isWindows) where++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.Contrib.HUnit ()+import System.Info(os)+isWindows :: Bool+isWindows = os == "mingw32"
+ test/src/TestMain.hs view
@@ -0,0 +1,38 @@++module Main where++import ReadFileSpec+import WhichSpec+import WriteSpec+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++main :: IO ()+main = hspec $ do+ readFileSpec+ whichSpec+ writeSpec+ moveSpec+ rmSpec+ findSpec+ printCommandsFnSpec+ envSpec+ failureSpec+ copySpec+ liftedSpec+ runSpec+ showCommandSpec+ sshSpec+ pipeSpec
+ test/src/WhichSpec.hs view
@@ -0,0 +1,17 @@+module WhichSpec (whichSpec) where++import TestInit++whichSpec :: Spec+whichSpec = describe "which" $ do+ it "gives full path to cabal" $ do+ Just _ <- shelly $ which "find"+ assert True++ 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
@@ -0,0 +1,40 @@+module WriteSpec ( writeSpec ) where++import TestInit++import Data.Text (Text)+default (Text)++createsFile :: FilePath -> (FilePath -> IO ()) -> IO ()+createsFile f action = do+ exists <- shelly $ test_e f+ when exists $ error "cleanup after yourself!"+ action f+ shelly $ rm f+ return ()+++writeSpec :: Spec+writeSpec = do+ describe "writefile" $+ it "creates and overwrites a file" $ createsFile "foo" $ \f -> do+ assert . (== "a") =<< (shelly $ writefile f "a" >> readfile f)+ assert . (== "b") =<< (shelly $ writefile f "b" >> readfile f)++ describe "writeBinary" $+ it "creates and overwrites a file" $ createsFile "foo" $ \f -> do+ assert . (== "a") =<< (shelly $ writeBinary f "a" >> readBinary f)+ assert . (== "b") =<< (shelly $ writeBinary f "b" >> readBinary f)++ describe "appendfile" $+ it "creates and appends a file" $ createsFile "foo" $ \f -> do+ assert . (== "a") =<< (shelly $ appendfile f "a" >> readfile f)+ assert . (== "ab") =<< (shelly $ appendfile f "b" >> readfile f)++ describe "touchfile" $+ it "creates and updates a file" $ createsFile "foo" $ \f -> do+ assert . (== "") =<< (shelly $ touchfile f >> readfile f)+ assert . (== "") =<< (shelly $ touchfile f >> readfile f)++ assert . (== "a") =<< (shelly $+ writefile f "a" >> touchfile f >> readfile f)
+ test/src/sleep.hs view
@@ -0,0 +1,9 @@+{-# Language OverloadedStrings #-}+import Shelly++main :: IO ()+main =+ shelly $ do+ echo "sleeping"+ run "sleep" ["5"]+ echo "all done"
+ test/testall view
@@ -0,0 +1,57 @@+#!/bin/sh++set -e++if [ -z "$DEBUG" ]; then+ export DEBUG=shelly-testsuite+fi++SUITE=./dist/build/shelly-testsuite/shelly-testsuite++rm -f shelly-testsuite.tix+cabal build++if [ ! -f $SUITE ]; then+ cat <<EOF+Testsuite executable not found, please run:+ cabal configure --enable-tests+then+ cabal build+Note this script should be run from the root of the checkout+EOF+ exit;+fi++$SUITE $*++DIR=dist/hpc++rm -Rf $DIR+mkdir -p $DIR++EXCLUDES='TestMain+CopySpec+EnvSpec+FailureSpec+FindSpec+Help+Main+MoveSpec+ReadFileSpec+WhichSpec+WriteSpec+RunSpec+SshSpec+'++EXCL=""++for m in $EXCLUDES; do+ EXCL="$EXCL --exclude=$m"+done++hpc markup $EXCL --destdir=$DIR shelly-testsuite >/dev/null 2>&1++cat <<EOF+Test coverage report written to $DIR.+EOF