shelly-1.12.1/0000755000000000000000000000000007346545000011265 5ustar0000000000000000shelly-1.12.1/ChangeLog.md0000644000000000000000000001030707346545000013437 0ustar0000000000000000# 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. shelly-1.12.1/LICENSE0000644000000000000000000000300207346545000012265 0ustar0000000000000000Copyright (c) 2017, Petr Rockai All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Petr Rockai nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. shelly-1.12.1/README.md0000644000000000000000000002243507346545000012552 0ustar0000000000000000# Shelly [![Build Status](https://github.com/gregwebs/Shelly.hs/actions/workflows/haskell-ci.yml/badge.svg?branch=master)](https://github.com/gregwebs/Shelly.hs/actions/workflows/haskell-ci.yml) [![Build Status](https://github.com/gregwebs/Shelly.hs/actions/workflows/mac-win-ci.yml/badge.svg?branch=master)](https://github.com/gregwebs/Shelly.hs/actions/workflows/mac-win-ci.yml) [![Hackage](https://img.shields.io/hackage/v/shelly.svg)](https://hackage.haskell.org/package/shelly) [![Stackage Nightly](http://stackage.org/package/shelly/badge/nightly)](http://stackage.org/nightly/package/shelly) [![Stackage LTS](http://stackage.org/package/shelly/badge/lts)](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-1.12.1/Setup.hs0000644000000000000000000000005607346545000012722 0ustar0000000000000000import Distribution.Simple main = defaultMain shelly-1.12.1/shelly.cabal0000644000000000000000000001251307346545000013553 0ustar0000000000000000cabal-version: 2.0 Name: shelly Version: 1.12.1 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: 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.6.1 GHC == 9.4.4 GHC == 9.2.7 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 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: 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-async >= 0.10.2 , 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 && < 1.13 , transformers >= 0.5.2.0 , transformers-base >= 0.4.5 , unix-compat >= 0.4.1.1 && < 0.8 ghc-options: -Wall -Wcompat cpp-options: -DNO_PRELUDE_CATCH default-language: Haskell2010 default-extensions: CPP TypeOperators source-repository head type: git 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 shelly-1.12.1/src/0000755000000000000000000000000007346545000012054 5ustar0000000000000000shelly-1.12.1/src/Shelly.hs0000644000000000000000000015641507346545000013664 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# 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. -- However, it also tries to use modern libraries and techniques to keep things efficient. -- -- The functionality provided by -- this module is (unlike standard Haskell filesystem functionality) -- thread-safe: each Sh maintains its own environment and its own working -- directory. -- -- Recommended usage includes putting the following at the top of your program, -- otherwise you will likely need either type annotations or type conversions -- -- > {-# LANGUAGE OverloadedStrings #-} -- > {-# LANGUAGE ExtendedDefaultRules #-} -- > {-# OPTIONS_GHC -fno-warn-type-defaults #-} -- > import Shelly -- > import qualified Data.Text as T -- > default (T.Text) module Shelly ( -- * Entering Sh Sh, ShIO, shelly, shellyNoDir, shellyFailDir, asyncSh, sub , silently, verbosely, escaping, print_stdout, print_stderr, print_commands, print_commands_with , onCommandHandles , tracing, errExit , log_stdout_with, log_stderr_with -- * Running external commands , run, run_, runFoldLines, cmd, FoldCallback , bash, bash_, bashPipeFail , (-|-), lastStderr, setStdin, lastExitCode , command, command_, command1, command1_ , 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, prependToPath -- * Environment directory , cd, chdir, chdir_p, pwd -- * Printing , echo, echo_n, echo_err, echo_n_err, echoWith, inspect, inspect_err , tag, trace, show_command -- * 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 , mv, rm, rm_f, rm_rf, cp, cp_r, mkdir, mkdir_p, mkdirTree -- * reading/writing Files , 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, fromText -- * Utility Functions , whenM, unlessM, time, sleep -- * Re-exported for your convenience , liftIO, when, unless, FilePath, (<$>) -- * internal functions for writing extensions , get, put -- * find functions , find, findWhen, findFold, findDirFilter, findDirFilterWhen, findFoldDirFilter , followSymlink ) where import Shelly.Base import Shelly.Directory import Shelly.Find 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) import Data.ByteString ( ByteString ) import Data.Char ( isAlphaNum, isDigit, isSpace, isPrint ) #if defined(mingw32_HOST_OS) import Data.Char ( toLower ) #endif import Data.Foldable ( toList ) import Data.IORef import Data.Maybe #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 Data.Typeable 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.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(..) ) -- | 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 CmdArg Text where toTextArgs = (: []) instance CmdArg String where toTextArgs = (: []) . T.pack instance {-# OVERLAPPABLE #-} CmdArg a => CmdArg [a] where toTextArgs = concatMap toTextArgs -- | For the variadic function 'cmd'. -- -- Partially applied variadic functions require type signatures. class ShellCmd t where cmdAll :: FilePath -> [Text] -> t -- 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 ShellCmd (Sh Text) where cmdAll = run instance (CmdArg arg, ShellCmd result) => ShellCmd (arg -> result) where cmdAll fp acc x = cmdAll fp (acc ++ toTextArgs x) -- | 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'. -- -- Convenient usage of 'cmd' requires the following: -- -- > {-# LANGUAGE OverloadedStrings #-} -- > {-# LANGUAGE ExtendedDefaultRules #-} -- > {-# OPTIONS_GHC -fno-warn-type-defaults #-} -- > import Shelly -- > import qualified Data.Text as T -- > default (T.Text) -- 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 = T.unpack -- | 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", but can automatically convert a 'Text'. (<.>) :: (ToFilePath filepath) => filepath -> Text -> FilePath x <.> y = toFilePath x FP.<.> T.unpack y toTextWarn :: FilePath -> Sh Text 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. -- -- Also, return the complete contents being streamed line by line. transferLinesAndCombine :: Handle -> (Text -> IO ()) -> IO Text transferLinesAndCombine readHandle putWrite = transferFoldHandleLines mempty (|>) readHandle putWrite >>= return . lineSeqToText lineSeqToText :: Seq Text -> Text -- extra append puts a newline at the end lineSeqToText = T.intercalate "\n" . toList . flip (|>) "" type FoldCallback a = (a -> Text -> a) -- | Transfer from one handle to another -- For example, send contents of a process output to stdout. -- Does not close the write handle. -- -- 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 -> putWrite line >> go (foldLine acc line) filterIOErrors :: IO a -> IO (Maybe a) filterIOErrors action = catchIOError (fmap Just action) (\e -> if isEOFError e || isIllegalOperation e -- handle was closed then return Nothing else ioError e) foldHandleLines :: a -> FoldCallback a -> Handle -> IO a foldHandleLines start foldLine readHandle = go start where go acc = do mLine <- filterIOErrors $ TIO.hGetLine readHandle case mLine of Nothing -> return acc Just line -> go $ foldLine acc line -- | Same as 'trace', but for use in combinator style: @action `tag` message@. tag :: Sh a -> Text -> Sh a tag action msg = do trace msg action put :: State -> Sh () put newState = do stateVar <- ask liftIO (writeIORef stateVar newState) runCommandNoEscape :: [StdHandle] -> State -> FilePath -> [Text] -> Sh (Handle, Handle, Handle, ProcessHandle) runCommandNoEscape handles st exe args = liftIO $ shellyProcess handles st $ ShellCommand $ T.unpack $ T.intercalate " " (toTextIgnore exe : args) runCommand :: [StdHandle] -> State -> FilePath -> [Text] -> Sh (Handle, Handle, Handle, ProcessHandle) runCommand handles st exe args = findExe exe >>= \fullExe -> liftIO $ shellyProcess handles st $ RawCommand fullExe (map T.unpack args) where findExe :: FilePath -> Sh FilePath findExe #if defined(mingw32_HOST_OS) fp #else _fp #endif = do mExe <- whichEith exe case mExe of 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) Left _ -> return fp #else Left err -> liftIO $ throwIO $ userError err #endif -- process >= 1.4 is used shellyProcess :: [StdHandle] -> State -> CmdSpec -> IO (Handle, Handle, Handle, ProcessHandle) shellyProcess reusedHandles st cmdSpec = do (createdInH, createdOutH, createdErrorH, pHandle) <- createProcess CreateProcess { cmdspec = cmdSpec , cwd = Just $ sDirectory st , env = Just $ sEnvironment st , std_in = createUnless mInH , std_out = createUnless mOutH , std_err = createUnless mErrorH , close_fds = False , create_group = False , 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 , just $ createdOutH <|> toHandle mOutH , just $ createdErrorH <|> toHandle mErrorH , pHandle ) where just :: Maybe a -> a just Nothing = error "error in shelly creating process" just (Just j) = j 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 createUnless (Just stream) = stream mInH = getStream mIn reusedHandles mOutH = getStream mOut reusedHandles mErrorH = getStream mError reusedHandles getStream :: (StdHandle -> Maybe StdStream) -> [StdHandle] -> Maybe StdStream getStream _ [] = Nothing getStream mHandle (h:hs) = mHandle h <|> getStream mHandle hs mIn, mOut, mError :: (StdHandle -> Maybe StdStream) mIn (InHandle h) = Just h mIn _ = Nothing mOut (OutHandle h) = Just h mOut _ = Nothing mError (ErrorHandle h) = Just h mError _ = Nothing {- -- | use for commands requiring usage of sudo. see 'run_sudo'. -- Use this pattern for priveledge separation newtype Sudo a = Sudo { sudo :: Sh a } -- | require that the caller explicitly state 'sudo' run_sudo :: Text -> [Text] -> Sudo Text run_sudo cmd args = Sudo $ run "/usr/bin/sudo" (cmd:args) -} -- | 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 handler = do ref <- ask liftIO $ catch (runSh action ref) (\e -> runSh (handler e) ref) -- | 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 $ 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 handler = do ref <- ask 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 ref <- ask liftIO $ bracket (runSh acquire ref) (\resource -> runSh (release resource) ref) (\resource -> runSh (main resource) ref) -- | You need to wrap exception handlers with this when using 'catches_sh'. data ShellyHandler a = forall e . Exception e => ShellyHandler (e -> Sh a) -- | Same as a normal 'catches', but specialized for the 'Sh' monad. catches_sh :: Sh a -> [ShellyHandler a] -> Sh a catches_sh action handlers = do ref <- ask let runner a = runSh a ref liftIO $ catches (runner action) $ map (toHandler runner) handlers where toHandler :: (Sh a -> IO a) -> ShellyHandler a -> Handler a toHandler runner (ShellyHandler handler) = Handler (\e -> runner (handler e)) -- | Catch any exception in the 'Sh' monad. catchany_sh :: Sh a -> (SomeException -> Sh a) -> Sh a catchany_sh = catch_sh -- | 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 -- track of its own working directory and builds absolute paths internally -- instead of passing down relative paths. cd :: FilePath -> Sh () cd = traceCanonicPath ("cd " <>) >=> cd' where cd' dir = do unlessM (test_d dir) $ errorExit $ "not a directory: " <> tdir modify $ \st -> st { sDirectory = dir, sPathExecutables = Nothing } where tdir = toTextIgnore dir -- | '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_p :: FilePath -> Sh a -> Sh a chdir_p d action = mkdir_p d >> chdir d action pack :: String -> FilePath pack = id -- | Move a file. The second path could be a directory, in which case the -- original file is moved into that directory. -- 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. (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 :: String -> String -> String extraMsg t f = "during copy from: " ++ f ++ " to: " ++ t -- | Get back @[Text]@ instead of @[FilePath]@. lsT :: FilePath -> Sh [Text] lsT = ls >=> mapM toTextWarn -- | 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 :: 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. errorExit :: Text -> Sh a errorExit msg = echo msg >> exit 1 -- | 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'. terror :: Text -> Sh a terror = fail . T.unpack -- | Create a new directory (fails if the directory exists). mkdir :: FilePath -> Sh () mkdir = traceAbsPath ("mkdir " <>) >=> 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 . 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: -- -- > exec = mkTree $ -- > "package" # [ -- > "src" # [ -- > "Data" # leaves ["Tree", "List", "Set", "Map"] -- > ], -- > "test" # leaves ["QuickCheck", "HUnit"], -- > "dist/doc/html" # [] -- > ] -- > where (#) = Node -- > leaves = map (# []) -- mkdirTree :: Tree FilePath -> Sh () mkdirTree = mk . unrollPath where mk :: Tree FilePath -> Sh () mk (Node a ts) = do b <- test_d a unless b $ mkdir a chdir a $ mapM_ mkdirTree ts unrollPath :: Tree FilePath -> Tree FilePath unrollPath (Node v ts) = unrollRoot v $ map unrollPath ts where unrollRoot x = foldr1 phi $ map Node $ splitDirectories x phi a b = a . return . b isExecutable :: FilePath -> IO Bool 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 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 takeExtension originalFp of "" -> originalFp <.> "exe" _ -> originalFp #else originalFp #endif where whichFull fp = do (trace . mappend "which " . toTextIgnore) fp >> whichUntraced where whichUntraced | isAbsolute fp = checkFile | startsWithDot splitOnDirs = checkFile | otherwise = lookupPath >>= leftPathError splitOnDirs = splitDirectories fp -- '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 leftPathError :: Maybe FilePath -> Sh (Either String FilePath) leftPathError Nothing = Left <$> pathLookupError leftPathError (Just x) = return $ Right x 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 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) findMapM _ [] = return Nothing findMapM f (x:xs) = do mb <- f x if (isJust mb) then return mb else findMapM f xs -- | A monadic-conditional version of the 'unless' guard. unlessM :: Monad m => m Bool -> m () -> m () unlessM c a = c >>= \res -> unless res a -- | Does a path point to an existing filesystem object? test_e :: FilePath -> Sh Bool test_e = absPath >=> \f -> liftIO $ do 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 . doesFileExist -- | Test that a file is in the PATH and also executable test_px :: FilePath -> Sh Bool test_px exe = do mFull <- which exe case mFull of Nothing -> return False Just full -> liftIO $ isExecutable full -- | 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 '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_ $ removeDirectoryRecursive f) `catch_sh` (\(e :: IOError) -> when (isPermissionError e) $ do find f >>= mapM_ (\file -> liftIO_ $ fixPermissions file `catchany` \_ -> return ()) liftIO $ removeDirectoryRecursive f ) where fixPermissions file = do permissions <- liftIO $ getPermissions file let deletable = permissions { readable = True, writable = True, executable = True } liftIO $ setPermissions file deletable -- | Remove a file. Does not fail if the file does not exist. -- Does fail if the file is not a file. rm_f :: FilePath -> Sh () rm_f = traceAbsPath ("rm -f " <>) >=> \f -> whenM (test_e f) $ liftIO $ removeFile f -- | Remove a file. -- 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 takeFileName) liftIO . removeFile -- | Set an environment variable. The environment is maintained in Sh -- internally, and is passed to any external commands to be executed. setenv :: Text -> Text -> Sh () setenv k v = if k == path_env then setPath v else setenvRaw k v setenvRaw :: Text -> Text -> Sh () setenvRaw k v = modify $ \x -> x { sEnvironment = wibble $ sEnvironment x } where normK = normalizeEnvVarNameText k (kStr, vStr) = (T.unpack normK, T.unpack v) wibble environment = (kStr, vStr) : filter ((/=kStr) . fst) environment setPath :: Text -> Sh () setPath newPath = do modify $ \x -> x{ sPathExecutables = Nothing } setenvRaw path_env newPath path_env :: Text path_env = normalizeEnvVarNameText "PATH" -- | 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_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'. get_env :: Text -> Sh (Maybe Text) get_env k = do mval <- return . fmap T.pack . lookup (T.unpack normK) =<< gets sEnvironment return $ case mval of Nothing -> Nothing Just val -> if (not $ T.null val) then Just val else Nothing where normK = normalizeEnvVarNameText k getenv :: Text -> Sh Text getenv k = get_env_def k "" {-# DEPRECATED getenv "use get_env or get_env_text" #-} -- | Fetch the current value of an environment variable. Both empty and -- non-existent variables give empty string as a result. get_env_text :: Text -> Sh Text 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. 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'. silently :: Sh a -> Sh a silently a = sub $ modify (\x -> x { sPrintStdout = False , sPrintStderr = False , sPrintCommands = False }) >> a -- | Create a sub-Sh in which external command outputs are echoed and -- Executed commands are printed -- See 'sub'. verbosely :: Sh a -> Sh a verbosely a = sub $ modify (\x -> x { sPrintStdout = True , sPrintStderr = True , 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 print_stdout shouldPrint a = sub $ modify (\x -> x { sPrintStdout = shouldPrint }) >> a -- | Create a sub-Sh with stderr printing on or off -- Defaults to True. print_stderr :: Bool -> Sh a -> Sh a print_stderr shouldPrint a = sub $ modify (\x -> x { sPrintStderr = shouldPrint }) >> a -- | Create a sub-Sh with command echoing on or off -- Defaults to False, set to True by 'verbosely' 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. sub :: Sh a -> Sh a sub a = do oldState <- get modify $ \st -> st { sTrace = T.empty } a `finally_sh` restoreState oldState where restoreState oldState = do newState <- get put oldState { -- avoid losing the log sTrace = sTrace oldState <> sTrace newState -- latest command execution: not make sense to restore these to old settings , sCode = sCode newState , sStderr = sStderr newState -- it is questionable what the behavior of stdin should be , sStdin = sStdin newState } -- | Create a sub-Sh where commands are not traced -- 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 } action -- | Create a sub-Sh with shell character escaping on or off. -- Defaults to @True@. -- -- Setting to @False@ allows for shell wildcard such as * to be expanded by the shell along with any other special shell characters. -- As a side-effect, setting to @False@ causes changes to @PATH@ to be ignored: -- see the 'run' documentation. escaping :: Bool -> Sh a -> Sh a escaping shouldEscape action = sub $ do modify $ \st -> st { sCommandEscaping = shouldEscape } action -- | named after bash -e errexit. Defaults to @True@. -- When @True@, throw an exception on a non-zero exit code. -- When @False@, ignore a non-zero exit code. -- Not recommended to set to @False@ unless you are specifically checking the error code with 'lastExitCode'. errExit :: Bool -> Sh a -> Sh a errExit shouldExit action = sub $ do 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 } -- | Deprecated now, just use 'shelly', whose default has been changed. -- Using this entry point does not create a @.shelly@ directory in the case -- of failure. Instead it logs directly into the standard error stream (@stderr@). shellyNoDir :: MonadIO m => Sh a -> m a 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 -- 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 -- running Sh. shelly :: MonadIO m => Sh a -> m a shelly = shelly' defReadOnlyState shelly' :: MonadIO m => ReadOnlyState -> Sh a -> m a shelly' ros action = do 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 , sPrintCommandsFn = TIO.hPutStrLn stdout , sInitCommandHandles = initAllHandles (const $ return ()) , sCommandEscaping = True , sEnvironment = environment , sTracing = True , sTrace = T.empty , sDirectory = dir , sPathExecutables = Nothing , sErrExit = True , sReadOnly = ros , sFollowSymlink = False } stref <- liftIO $ newIORef def let caught = action `catches_sh` [ ShellyHandler (\ex -> case ex of ExitSuccess -> liftIO $ throwIO ex ExitFailure _ -> throwExplainedException ex ) , ShellyHandler (\ex -> case ex of QuietExit n -> liftIO $ throwIO $ ExitFailure n) , ShellyHandler (\(ex::SomeException) -> throwExplainedException ex) ] liftIO $ runSh caught stref where throwExplainedException :: Exception exception => exception -> Sh a throwExplainedException ex = get >>= errorMsg >>= liftIO . throwIO . ReThrownException ex errorMsg st = if not (rosFailToDir $ sReadOnly st) then ranCommands else do d <- pwd sf <- shellyFile let logFile = dshelly_dirsf (writefile logFile trc >> return ("log of commands saved to: " <> logFile)) `catchany_sh` (\_ -> ranCommands) where trc = sTrace st ranCommands = return . mappend "Ran commands: \n" . T.unpack $ trc shelly_dir = ".shelly" shellyFile = chdir_p shelly_dir $ do fs <- ls "." return $ pack $ show (nextNum fs) <> ".txt" nextNum :: [FilePath] -> Int nextNum [] = 1 nextNum fs = (+ 1) . maximum . map (readDef 1 . filter isDigit . takeFileName) $ fs -- from safe package readDef :: Read a => a -> String -> a readDef def = fromMaybe def . readMay where readMay :: Read a => String -> Maybe a readMay s = case [x | (x,t) <- reads s, ("","") <- lex t] of [x] -> Just x _ -> Nothing data RunFailed = RunFailed FilePath [Text] Int Text deriving (Typeable) instance Show RunFailed where show (RunFailed exe args code errs) = let codeMsg = case code of 127 -> ". exit code 127 usually means the command does not exist (in the PATH)" _ -> "" in "error running: " ++ T.unpack (show_command exe args) ++ "\nexit status: " ++ show code ++ codeMsg ++ "\nstderr: " ++ T.unpack errs instance Exception RunFailed show_command :: FilePath -> [Text] -> Text show_command exe args = let escape char | char `Set.member` specialsInQuotes = T.pack ['\\', char] escape char = T.singleton char quote arg = surround '"' $ T.concatMap escape arg isSafe c = all ($ c) [isPrint, not . isSpace, (`Set.notMember` specials)] showArg "" = surround '"' "" showArg arg | T.all isSafe arg = arg showArg arg = quote arg in T.intercalate " " $ map showArg (toTextIgnore exe : args) -- | Characters that need to be escaped or quoted to retain their literal value. specials :: Set.Set Char specials = Set.fromList "\\'\"`$&|;(){}<>" -- | When inside quotes, characters that need to be escaped to retain their -- literal value. specialsInQuotes :: Set.Set Char specialsInQuotes = Set.fromList "\\\"`$" -- quote one argument quoteOne :: Text -> Text quoteOne t = surround '\'' $ T.replace "'" "'\\''" t -- returns a string that can be executed by a shell. -- NOTE: all parts are treated literally, which means that -- things like variable expansion will not be available. quoteCommand :: FilePath -> [Text] -> Text quoteCommand exe args = T.intercalate " " $ map quoteOne (toTextIgnore exe : args) surround :: Char -> Text -> Text surround c t = T.cons c $ T.snoc t c data SshMode = ParSsh | SeqSsh -- | Same as 'sshPairs', but returns @()@. sshPairs_ :: Text -> [(FilePath, [Text])] -> Sh () sshPairs_ _ [] = return () sshPairs_ server cmds = sshPairs' run_ server cmds -- | 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, and the remote commands are -- quoted with single quotes, in a way such that the remote commands will see -- the literal values you passed, this means that no variable expansion and -- alike will done on either the local shell or the remote shell, and that -- if there are a single or double quotes in your arguments, they need not -- to be quoted manually. -- -- Internally the list of commands are combined with the string @&&@ before given to @ssh@. sshPairs :: Text -> [(FilePath, [Text])] -> Sh Text sshPairs _ [] = return "" sshPairs server cmds = sshPairsWithOptions' run server [] cmds SeqSsh -- | Same as 'sshPairs', but combines commands with the string @&@, -- so they will be started in 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 = 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 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, Typeable) instance Exception QuietExit -- | Shelly's wrapper around exceptions thrown in its monad data ReThrownException e = ReThrownException e String deriving (Typeable) instance Exception e => Exception (ReThrownException e) instance Exception e => Show (ReThrownException e) where show (ReThrownException ex msg) = "\n" ++ msg ++ "\n" ++ "Exception: " ++ show ex -- | Execute an external command. -- Takes the command name and arguments. -- -- You may prefer using 'cmd' instead, which is a variadic argument version -- of this function. -- -- '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'. 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_', -- If you want to avoid the memory and need to process the output then use 'runFoldLines' or 'runHandle' or 'runHandles'. -- -- By default shell characters are escaped and -- the command name is a name of a program that can be found via @PATH@. -- Shelly will look through the @PATH@ itself to find the command. -- -- When 'escaping' is set to @False@, shell characters are allowed. -- Since there is no longer a guarantee that a single program name is -- 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@. -- run :: FilePath -> [Text] -> Sh Text run fp args = return . lineSeqToText =<< runFoldLines mempty (|>) fp args -- | Like 'run', but it invokes the user-requested program with @bash@. 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: -- -- > 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: -- -- > git = command1 "git" [] -- > git "pull" ["origin", "master"] command1 :: FilePath -> [Text] -> Text -> [Text] -> Sh Text command1 com args one_arg more_args = run com (args ++ [one_arg] ++ more_args) -- | Bind some arguments to 'run_' for re-use, and require 1 argument. Example: -- -- > git_ = command1_ "git" [] -- > git "pull" ["origin", "master"] command1_ :: FilePath -> [Text] -> Text -> [Text] -> Sh () command1_ com args one_arg more_args = run_ com (args ++ [one_arg] ++ more_args) -- | The same as 'run', but return @()@ instead of the stdout content. -- The stdout will be read and discarded line-by-line. run_ :: FilePath -> [Text] -> Sh () 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_ = 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. -> Sh a runHandle exe args withHandle = runHandles exe args [] $ \_ outH errH -> do state <- get errVar <- liftIO $ (putHandleIntoMVar mempty (|>) errH (sPutStderr state) (sPrintStderr state)) res <- withHandle outH 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 runHandles exe args reusedHandles withHandles = do -- clear stdin before beginning command execution origstate <- get let mStdin = sStdin origstate put $ origstate { sStdin = Nothing, sCode = 0, sStderr = T.empty } state <- get let cmdString = show_command exe args when (sPrintCommands state) $ echoWith (sPrintCommandsFn state) cmdString trace cmdString let doRun = if sCommandEscaping state then runCommand else runCommandNoEscape bracket_sh (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 () result <- withHandles inH outH errH (ex, code) <- liftIO $ do ex' <- waitForProcess procH -- TODO: specifically catch our own error for Inherit pipes hClose outH `catchany` (const $ return ()) hClose errH `catchany` (const $ return ()) hClose inH `catchany` (const $ return ()) return $ case ex' of ExitSuccess -> (ex', 0) ExitFailure n -> (ex', n) modify $ \state' -> state' { sCode = code } case (sErrExit state, ex) of (True, ExitFailure n) -> do newState <- get liftIO $ throwIO $ RunFailed exe args n (sStderr newState) _ -> return result ) -- | 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 state <- get (errVar, outVar) <- liftIO $ do hClose inH -- setStdin was taken care of before the process even ran liftM2 (,) (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. -> (Text -> IO ()) -- ^ In handle. -> Bool -- ^ Should it be printed while transfered? -> IO (Async a) putHandleIntoMVar start cb outH putWrite shouldPrint = liftIO $ async $ do if shouldPrint then transferFoldHandleLines start cb outH putWrite else foldHandleLines start cb outH -- | The output of last external command. See 'run'. lastStderr :: Sh Text lastStderr = gets sStderr -- | The exit code from the last command. -- Unless you set 'errExit' to False you won't get a chance to use this: a non-zero exit code will throw an exception. lastExitCode :: Sh Int lastExitCode = gets sCode -- | 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. -- 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 one -|- two = do res <- print_stdout False one setStdin res two -- | Copy a file, or a directory recursively. -- Uses 'cp'. cp_r :: FilePath -> FilePath -> Sh () cp_r from' to' = do from <- absPath from' fromIsDir <- (test_d from) 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 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 = 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. 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 :: 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' -- computation. The directory is nuked afterwards. withTmpDir :: (FilePath -> Sh a) -> Sh a withTmpDir act = do trace "withTmpDir" dir <- liftIO getTemporaryDirectory tid <- liftIO myThreadId (pS, fhandle) <- liftIO $ openTempFile dir ("tmp" ++ filter isAlphaNum (show tid)) let p = pack pS liftIO $ hClose fhandle -- required on windows rm_f p mkdir p act p `finally_sh` rm_rf p -- | Write a 'Text' to a file. writefile :: FilePath -> Text -> Sh () writefile f' bits = do f <- traceAbsPath ("writefile " <>) f' 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 'Text' to a file. appendfile :: FilePath -> Text -> Sh () appendfile f' bits = do f <- traceAbsPath ("appendfile " <>) f' liftIO (TIO.appendFile f bits) readfile :: FilePath -> Sh Text readfile = traceAbsPath ("readfile " <>) >=> \fp -> readBinary fp >>= return . TE.decodeUtf8With TE.lenientDecode -- | Wraps 'BS.readFile'. readBinary :: FilePath -> Sh ByteString readBinary = traceAbsPath ("readBinary " <>) >=> liftIO . BS.readFile -- | Flipped 'hasExtension' for 'Text'. hasExt :: Text -> FilePath -> Bool hasExt ext fp = T.pack (FP.takeExtension fp) == ext -- | Run a 'Sh' computation and collect timing information. -- The value returned is the amount of *real* time spent running the computation -- 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" t <- liftIO getCurrentTime res <- what t' <- liftIO getCurrentTime return (realToFrac $ diffUTCTime t' t, res) -- | 'threadDelay' wrapper that uses seconds. sleep :: Int -> Sh () sleep = liftIO . threadDelay . (1000 * 1000 *) -- | Spawn an asynchronous action with a copy of the current state. asyncSh :: Sh a -> Sh (Async a) asyncSh proc = do state <- get liftIO $ async $ shelly (put state >> proc) -- helper because absPath can throw exceptions -- This helps give clear tracing messages tracePath :: (FilePath -> Sh FilePath) -- ^ filepath conversion -> (Text -> Text) -- ^ tracing statement -> FilePath -> Sh FilePath -- ^ converted filepath tracePath convert tracer infp = (convert infp >>= \fp -> traceIt fp >> return fp) `catchany_sh` (\e -> traceIt infp >> liftIO (throwIO e)) where traceIt = trace . tracer . toTextIgnore traceAbsPath :: (Text -> Text) -> FilePath -> Sh FilePath traceAbsPath = tracePath absPath traceCanonicPath :: (Text -> Text) -> FilePath -> Sh FilePath traceCanonicPath = tracePath canonic shelly-1.12.1/src/Shelly/0000755000000000000000000000000007346545000013314 5ustar0000000000000000shelly-1.12.1/src/Shelly/Base.hs0000644000000000000000000002563507346545000014535 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE InstanceSigs#-} module Shelly.Base ( 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, echoWith, inspect, inspect_err, catchany, liftIO, (>=>), eitherRelativeTo, relativeTo, maybeRelativeTo, whenM -- * utilities not yet exported , addTrailingSlash ) where import Data.Text (Text) import System.Process( StdStream(..) ) import System.IO ( Handle, hFlush, stderr, stdout ) 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 System.Directory( doesDirectoryExist, listDirectory) import System.PosixCompat.Files( getSymbolicLinkStatus, isSymbolicLink ) import System.FilePath ( isRelative) import qualified System.FilePath as FP import qualified System.Directory as FS import Data.IORef (readIORef, modifyIORef, IORef) import qualified Data.Text as T import qualified Data.Text.IO as TIO import Control.Exception (SomeException, catch, throwIO, Exception) import Data.Maybe (fromMaybe) import qualified Control.Monad.Catch as Catch import Control.Monad.Trans ( MonadIO, liftIO ) 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 {-# DEPRECATED ShIO "Use Sh instead of ShIO" #-} newtype Sh a = Sh { unSh :: ReaderT (IORef State) IO a } 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 instance Catch.MonadCatch Sh where catch (Sh (ReaderT m)) c = Sh $ ReaderT $ \r -> m r `Catch.catch` \e -> runSh (c e) r runSh :: Sh a -> IORef State -> IO a runSh = runReaderT . unSh data ReadOnlyState = ReadOnlyState { rosFailToDir :: Bool } 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 , 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 -- | 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. -- An absolute path is returned as is. -- To create an absolute path, use 'absPath'. relPath :: FilePath -> Sh FilePath relPath fp = do wd <- gets sDirectory rel <- eitherRelativeTo wd fp return $ case rel of 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 relativeFP fp = do let fullFp = relativeFP FP. fp let relDir = addTrailingSlash relativeFP stripIt relativeFP fp $ stripIt relativeFP fullFp $ stripIt relDir fp $ stripIt relDir fullFp $ do relCan <- canonic relDir 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 = let stripped = FP.makeRelative rel toStrip in if stripped == toStrip then nada else return $ Right stripped -- | 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. -> Sh (Maybe FilePath) maybeRelativeTo relativeFP fp = do epath <- eitherRelativeTo relativeFP fp return $ case epath of Right p -> Just p Left _ -> Nothing -- | Add a trailing slash to ensure the path indicates a directory. addTrailingSlash :: FilePath -> FilePath addTrailingSlash = FP.addTrailingPathSeparator -- | 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'. canonicalize :: FilePath -> Sh FilePath canonicalize = absPath >=> liftIO . canonicalizePath -- | Version of 'FS.canonicalizePath' that keeps a trailing slash. canonicalizePath :: FilePath -> IO FilePath 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 instance Show EmptyFilePathError where show _ = "Empty filepath" instance Exception EmptyFilePathError -- | Make a relative path absolute by combining with the working directory. -- An absolute path is returned as is. -- To create a relative path, use 'relPath'. absPath :: FilePath -> Sh FilePath absPath p | null p = liftIO $ throwIO EmptyFilePathError | isRelative p = do cwd <- gets sDirectory return (cwd FP. p) | otherwise = return p 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 . doesDirectoryExist -- | Does a path point to a symlink? test_s :: FilePath -> Sh Bool test_s = absPath >=> liftIO . \f -> do stat <- getSymbolicLinkStatus f return $ isSymbolicLink stat unpack :: FilePath -> String unpack = id gets :: (State -> a) -> Sh a gets f = f <$> get get :: Sh State get = do stateVar <- ask liftIO (readIORef stateVar) modify :: (State -> State) -> Sh () modify f = do state <- ask liftIO (modifyIORef state f) -- | 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 -- include (other) hidden files. ls :: FilePath -> Sh [FilePath] -- it is important to use path and not absPath so that the listing can remain relative ls fp = do trace $ "ls " `mappend` toTextIgnore fp fmap fst $ lsRelAbs fp lsRelAbs :: FilePath -> Sh ([FilePath], [FilePath]) lsRelAbs f = absPath f >>= \fp -> do files <- liftIO $ listDirectory fp let absolute = map (fp FP.) files let relativized = map (\p -> FP.joinPath [f, p]) files return (relativized, absolute) toTextIgnore :: FilePath -> Text toTextIgnore = T.pack -- | 'print' lifted into 'Sh'. inspect :: Show s => s -> Sh () inspect x = do trace $ T.pack s liftIO $ putStrLn s where s = show x -- | 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@ -- variants do not print a final newline. echo, echo_n, echo_err, echo_n_err :: Text -> Sh () echo msg = traceEcho msg >> liftIO (TIO.putStrLn msg >> hFlush stdout) 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) -- | @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 shelly-1.12.1/src/Shelly/Directory.hs0000644000000000000000000000132107346545000015611 0ustar0000000000000000{-# 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 shelly-1.12.1/src/Shelly/Find.hs0000644000000000000000000000722607346545000014537 0ustar0000000000000000{-# 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 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. -- If you want to filter out some results or fold over them you can do that with the returned files. -- A more efficient approach is to use one of the other find functions. find :: FilePath -> Sh [FilePath] find = findFold (\paths fp -> return $ paths ++ [fp]) [] -- | 'find' that filters the found files as it finds. -- Files must satisfy the given filter to be returned in the result. findWhen :: (FilePath -> Sh Bool) -> FilePath -> Sh [FilePath] findWhen = findDirFilterWhen (const $ return True) -- | 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) -- | '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 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 -- | 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 -- 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 $ 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 shelly-1.12.1/src/Shelly/Lifted.hs0000644000000000000000000005101007346545000015054 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, OverloadedStrings, FlexibleInstances, FlexibleContexts, IncoherentInstances, TypeFamilies, ExistentialQuantification, RankNTypes, ImpredicativeTypes #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | A module for shell-like programming in Haskell. -- Shelly's focus is entirely on ease of use for those coming from shell scripting. -- However, it also tries to use modern libraries and techniques to keep things efficient. -- -- The functionality provided by -- this module is (unlike standard Haskell filesystem functionality) -- thread-safe: each Sh maintains its own environment and its own working -- directory. -- -- Recommended usage includes putting the following at the top of your program, -- otherwise you will likely need either type annotations or type conversions -- -- > {-# LANGUAGE OverloadedStrings #-} -- > {-# LANGUAGE ExtendedDefaultRules #-} -- > {-# OPTIONS_GHC -fno-warn-type-defaults #-} -- > import Shelly -- > import qualified Data.Text as T -- > default (T.Text) 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 Sh, ShIO, S.shelly, S.shellyNoDir, S.shellyFailDir, sub , silently, verbosely, escaping, print_stdout, print_stderr, print_commands, print_commands_with , tracing, errExit , log_stdout_with, log_stderr_with -- * Running external commands , run, run_, runFoldLines, S.cmd, S.FoldCallback , (-|-), lastStderr, setStdin, lastExitCode , command, command_, command1, command1_ , sshPairs, sshPairs_ , S.ShellCmd(..), S.CmdArg (..) -- * Running commands Using handles , runHandle, runHandles, transferLinesAndCombine, S.transferFoldHandleLines , S.StdHandle(..), S.StdStream(..) -- * 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, echoWith, inspect, inspect_err , tag, trace, S.show_command -- * 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 , mv, rm, rm_f, rm_rf, cp, cp_r, mkdir, mkdir_p, mkdirTree -- * reading/writing Files , readfile, readBinary, writefile, appendfile, touchfile, withTmpDir -- * exiting the program , exit, errorExit, quietExit, terror -- * Exceptions , bracket_sh, catchany, catch_sh, handle_sh, handleany_sh, finally_sh, catches_sh, catchany_sh -- * convert between Text and FilePath , S.toTextIgnore, toTextWarn, S.fromText -- * Utility Functions , S.whenM, S.unlessM, time, sleep -- * Re-exported for your convenience , liftIO, S.when, S.unless, FilePath, (S.<$>) -- * internal functions for writing extensions , Shelly.Lifted.get, Shelly.Lifted.put -- * find functions , S.find, S.findWhen, S.findFold, S.findDirFilter, S.findDirFilterWhen, S.findFoldDirFilter , followSymlink ) where import qualified Shelly as S import qualified Shelly.Base as S import Shelly.Base ( Sh(..), ShIO, Text, (>=>) ) import Control.Monad ( liftM ) import Data.ByteString ( ByteString ) 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.Maybe import Control.Monad.Trans.Cont import Control.Monad.Trans.Except import Control.Monad.Trans.Reader import Control.Monad.Trans.State import qualified Control.Monad.Trans.State.Strict as Strict import Control.Monad.Trans.Writer import qualified Control.Monad.Trans.Writer.Strict as Strict import qualified Control.Monad.Trans.RWS as RWS import qualified Control.Monad.Trans.RWS.Strict as Strict class Monad m => MonadSh m where liftSh :: Sh a -> m a instance MonadSh Sh where liftSh = id instance MonadSh m => MonadSh (IdentityT m) where liftSh = IdentityT . liftSh 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 (MonadSh m) => MonadSh (ExceptT e m) where liftSh m = ExceptT $ do a <- liftSh m return (Right a) instance MonadSh m => MonadSh (ReaderT r m) where liftSh = ReaderT . const . liftSh instance MonadSh m => MonadSh (StateT s m) where liftSh m = StateT $ \s -> do a <- liftSh m return (a, s) instance MonadSh m => MonadSh (Strict.StateT s m) where liftSh m = Strict.StateT $ \s -> do a <- liftSh m return (a, s) instance (Monoid w, MonadSh m) => MonadSh (WriterT w m) where liftSh m = WriterT $ do a <- liftSh m return (a, mempty :: w) instance (Monoid w, MonadSh m) => MonadSh (Strict.WriterT w m) where liftSh m = Strict.WriterT $ do a <- liftSh m return (a, mempty :: w) instance (Monoid w, MonadSh m) => MonadSh (RWS.RWST r w s m) where liftSh m = RWS.RWST $ \_ s -> do a <- liftSh m return (a, s, mempty :: w) instance (Monoid w, MonadSh m) => MonadSh (Strict.RWST r w s m) where liftSh m = Strict.RWST $ \_ s -> do a <- liftSh m return (a, s, mempty :: w) instance MonadSh m => S.ShellCmd (m Text) where cmdAll = (liftSh .) . S.run instance (MonadSh m, s ~ Text, Show s) => S.ShellCmd (m s) where cmdAll = (liftSh .) . S.run instance MonadSh m => S.ShellCmd (m ()) where cmdAll = (liftSh .) . S.run_ class Monad m => MonadShControl m where data ShM m a liftShWith :: ((forall x. m x -> Sh (ShM m x)) -> Sh a) -> m a restoreSh :: ShM m a -> m a instance MonadShControl Sh where newtype ShM Sh a = ShSh a liftShWith f = f $ liftM ShSh restoreSh (ShSh x) = return x {-# INLINE liftShWith #-} {-# INLINE restoreSh #-} instance MonadShControl m => MonadShControl (MaybeT m) where newtype ShM (MaybeT m) a = MaybeTShM (ShM m (Maybe a)) liftShWith f = MaybeT $ liftM return $ liftShWith $ \runInSh -> f $ \k -> liftM MaybeTShM $ runInSh $ runMaybeT k restoreSh (MaybeTShM m) = MaybeT . restoreSh $ m {-# INLINE liftShWith #-} {-# INLINE restoreSh #-} instance MonadShControl m => MonadShControl (IdentityT m) where newtype ShM (IdentityT m) a = IdentityTShM (ShM m a) liftShWith f = IdentityT $ liftM id $ liftShWith $ \runInSh -> f $ \k -> liftM IdentityTShM $ runInSh $ runIdentityT k restoreSh (IdentityTShM m) = IdentityT . restoreSh $ m {-# INLINE liftShWith #-} {-# INLINE restoreSh #-} instance (MonadShControl m, Monoid w) => MonadShControl (WriterT w m) where newtype ShM (WriterT w m) a = WriterTShM (ShM m (a, w)) liftShWith f = WriterT $ liftM (\x -> (x, mempty :: w)) $ liftShWith $ \runInSh -> f $ \k -> liftM WriterTShM $ runInSh $ runWriterT k restoreSh (WriterTShM m) = WriterT . restoreSh $ m {-# INLINE liftShWith #-} {-# INLINE restoreSh #-} instance (MonadShControl m, Monoid w) => 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 :: 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 => MonadShControl (ExceptT e m) where newtype ShM (ExceptT e m) a = ExceptTShM (ShM m (Either e a)) liftShWith f = ExceptT $ liftM return $ liftShWith $ \runInSh -> f $ \k -> liftM ExceptTShM $ runInSh $ runExceptT k restoreSh (ExceptTShM m) = ExceptT . restoreSh $ m {-# INLINE liftShWith #-} {-# INLINE restoreSh #-} instance MonadShControl m => MonadShControl (StateT s m) where newtype ShM (StateT s m) a = StateTShM (ShM m (a, s)) liftShWith f = StateT $ \s -> liftM (\x -> (x,s)) $ liftShWith $ \runInSh -> f $ \k -> liftM StateTShM $ runInSh $ runStateT k s restoreSh (StateTShM m) = StateT . const . restoreSh $ m {-# INLINE liftShWith #-} {-# INLINE restoreSh #-} instance MonadShControl m => MonadShControl (Strict.StateT s m) where newtype ShM (Strict.StateT s m) a = StStateTShM (ShM m (a, s)) liftShWith f = Strict.StateT $ \s -> liftM (\x -> (x,s)) $ liftShWith $ \runInSh -> f $ \k -> liftM StStateTShM $ runInSh $ Strict.runStateT k s restoreSh (StStateTShM m) = Strict.StateT . const . restoreSh $ m {-# INLINE liftShWith #-} {-# INLINE restoreSh #-} instance MonadShControl m => MonadShControl (ReaderT r m) where newtype ShM (ReaderT r m) a = ReaderTShM (ShM m a) liftShWith f = ReaderT $ \r -> liftM id $ liftShWith $ \runInSh -> f $ \k -> liftM ReaderTShM $ runInSh $ runReaderT k r restoreSh (ReaderTShM m) = ReaderT . const . restoreSh $ m {-# INLINE liftShWith #-} {-# INLINE restoreSh #-} instance (MonadShControl m, Monoid w) => 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 :: w)) $ liftShWith $ \runInSh -> f $ \k -> liftM RWSTShM $ runInSh $ RWS.runRWST k r s restoreSh (RWSTShM m) = RWS.RWST . const . const . restoreSh $ m {-# INLINE liftShWith #-} {-# INLINE restoreSh #-} instance (MonadShControl m, Monoid w) => 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 :: w)) $ liftShWith $ \runInSh -> f $ \k -> liftM StRWSTShM $ runInSh $ Strict.runRWST k r s restoreSh (StRWSTShM m) = Strict.RWST . const . const . restoreSh $ m {-# INLINE liftShWith #-} {-# INLINE restoreSh #-} controlSh :: MonadShControl m => ((forall x. m x -> Sh (ShM m x)) -> Sh (ShM m a)) -> m a controlSh = liftShWith >=> restoreSh {-# INLINE controlSh #-} tag :: (MonadShControl m, MonadSh m) => m a -> Text -> m a tag action msg = controlSh $ \runInSh -> S.tag (runInSh action) msg chdir :: MonadShControl m => FilePath -> m a -> m a chdir dir action = controlSh $ \runInSh -> S.chdir dir (runInSh action) chdir_p :: MonadShControl m => FilePath -> m a -> m a chdir_p dir action = controlSh $ \runInSh -> S.chdir_p dir (runInSh action) silently :: MonadShControl m => m a -> m a silently a = controlSh $ \runInSh -> S.silently (runInSh a) 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) print_stderr :: MonadShControl m => Bool -> m a -> m a print_stderr shouldPrint a = controlSh $ \runInSh -> S.print_stderr shouldPrint (runInSh a) 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) trace :: MonadSh m => Text -> m () trace = liftSh . S.trace tracing :: MonadShControl m => Bool -> m a -> m a tracing shouldTrace action = controlSh $ \runInSh -> S.tracing shouldTrace (runInSh action) escaping :: MonadShControl m => Bool -> m a -> m a escaping shouldEscape action = controlSh $ \runInSh -> S.escaping shouldEscape (runInSh action) 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 runInSh $ restoreSh x >>= \x' -> controlSh $ \runInSh' -> return x' S.-|- runInSh' two withTmpDir :: MonadShControl m => (FilePath -> m a) -> m a withTmpDir action = controlSh $ \runInSh -> S.withTmpDir (fmap runInSh action) time :: MonadShControl m => m a -> m (Double, a) time what = controlSh $ \runInSh -> do (d, a) <- S.time (runInSh what) runInSh $ restoreSh a >>= \x -> return (d, x) toTextWarn :: MonadSh m => FilePath -> m Text toTextWarn = liftSh . toTextWarn transferLinesAndCombine :: MonadIO m => Handle -> (Text -> IO ()) -> m Text transferLinesAndCombine = (liftIO .) . S.transferLinesAndCombine get :: MonadSh m => m S.State get = liftSh S.get put :: MonadSh m => S.State -> m () put = liftSh . S.put 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 = handle {-# DEPRECATED handle_sh "use Control.Exception.Lifted.handle instead" #-} finally_sh :: Sh a -> Sh b -> Sh a finally_sh = finally {-# DEPRECATED finally_sh "use Control.Exception.Lifted.finally instead" #-} bracket_sh :: Sh a -> (a -> Sh b) -> (a -> Sh c) -> Sh c bracket_sh = bracket {-# DEPRECATED bracket_sh "use Control.Exception.Lifted.bracket instead" #-} catches_sh :: Sh a -> [Handler Sh a] -> Sh a catches_sh = catches {-# DEPRECATED catches_sh "use Control.Exception.Lifted.catches instead" #-} catchany_sh :: Sh a -> (SomeException -> Sh a) -> Sh a catchany_sh = catchAny {-# DEPRECATED catchany_sh "use Control.Exception.Enclosed.catchAny instead" #-} handleany_sh :: (SomeException -> Sh a) -> Sh a -> Sh a handleany_sh = handleAny {-# DEPRECATED handleany_sh "use Control.Exception.Enclosed.handleAny instead" #-} cd :: MonadSh m => FilePath -> m () cd = liftSh . S.cd mv :: MonadSh m => FilePath -> FilePath -> m () mv = (liftSh .) . S.mv lsT :: MonadSh m => FilePath -> m [Text] lsT = liftSh . S.lsT pwd :: MonadSh m => m FilePath pwd = liftSh S.pwd exit :: MonadSh m => Int -> m a exit = liftSh . S.exit errorExit :: MonadSh m => Text -> m a errorExit = liftSh . S.errorExit quietExit :: MonadSh m => Int -> m a quietExit = liftSh . S.quietExit terror :: MonadSh m => Text -> m a terror = liftSh . S.terror mkdir :: MonadSh m => FilePath -> m () mkdir = liftSh . S.mkdir mkdir_p :: MonadSh m => FilePath -> m () mkdir_p = liftSh . S.mkdir_p mkdirTree :: MonadSh m => Tree FilePath -> m () mkdirTree = liftSh . S.mkdirTree which :: MonadSh m => FilePath -> m (Maybe FilePath) which = liftSh . S.which test_e :: MonadSh m => FilePath -> m Bool test_e = liftSh . S.test_e test_f :: MonadSh m => FilePath -> m Bool test_f = liftSh . S.test_f test_px :: MonadSh m => FilePath -> m Bool test_px = liftSh . S.test_px rm_rf :: MonadSh m => FilePath -> m () rm_rf = liftSh . S.rm_rf rm_f :: MonadSh m => FilePath -> m () rm_f = liftSh . S.rm_f rm :: MonadSh m => FilePath -> m () rm = liftSh . S.rm setenv :: MonadSh m => Text -> Text -> m () setenv = (liftSh .) . S.setenv 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 get_env :: MonadSh m => Text -> m (Maybe Text) get_env = liftSh . S.get_env get_env_text :: MonadSh m => Text -> m Text get_env_text = liftSh . S.get_env_text sshPairs_ :: MonadSh m => Text -> [(FilePath, [Text])] -> m () sshPairs_ = (liftSh .) . S.sshPairs_ sshPairs :: MonadSh m => Text -> [(FilePath, [Text])] -> m Text sshPairs = (liftSh .) . S.sshPairs run :: MonadSh m => FilePath -> [Text] -> m Text run = (liftSh .) . S.run command :: MonadSh m => FilePath -> [Text] -> [Text] -> m Text command com args more_args = liftSh $ S.command com args more_args command_ :: MonadSh m => FilePath -> [Text] -> [Text] -> m () command_ com args more_args = liftSh $ S.command_ com args more_args command1 :: MonadSh m => FilePath -> [Text] -> Text -> [Text] -> m Text command1 com args one_arg more_args = liftSh $ S.command1 com args one_arg more_args command1_ :: MonadSh m => FilePath -> [Text] -> Text -> [Text] -> m () command1_ com args one_arg more_args = liftSh $ S.command1_ com args one_arg more_args run_ :: MonadSh m => FilePath -> [Text] -> m () run_ = (liftSh .) . S.run_ runHandle :: MonadShControl m => FilePath -- ^ command -> [Text] -- ^ arguments -> (Handle -> m a) -- ^ stdout handle -> m a runHandle exe args withHandle = controlSh $ \runInSh -> S.runHandle exe args (fmap runInSh withHandle) runHandles :: MonadShControl m => FilePath -- ^ command -> [Text] -- ^ arguments -> [S.StdHandle] -- ^ optionally connect process i/o handles to existing handles -> (Handle -> Handle -> Handle -> m a) -- ^ stdin, stdout and stderr -> m a runHandles exe args reusedHandles withHandles = controlSh $ \runInSh -> S.runHandles exe args reusedHandles (fmap (fmap (fmap runInSh)) withHandles) runFoldLines :: MonadSh m => a -> S.FoldCallback a -> FilePath -> [Text] -> m a runFoldLines start cb exe args = liftSh $ S.runFoldLines start cb exe args lastStderr :: MonadSh m => m Text lastStderr = liftSh S.lastStderr lastExitCode :: MonadSh m => m Int lastExitCode = liftSh S.lastExitCode setStdin :: MonadSh m => Text -> m () setStdin = liftSh . S.setStdin cp_r :: MonadSh m => FilePath -> FilePath -> m () cp_r = (liftSh .) . S.cp_r cp :: MonadSh m => FilePath -> FilePath -> m () cp = (liftSh .) . S.cp writefile :: MonadSh m => FilePath -> Text -> m () writefile = (liftSh .) . S.writefile touchfile :: MonadSh m => FilePath -> m () touchfile = liftSh . S.touchfile appendfile :: MonadSh m => FilePath -> Text -> m () appendfile = (liftSh .) . S.appendfile readfile :: MonadSh m => FilePath -> m Text readfile = liftSh . S.readfile readBinary :: MonadSh m => FilePath -> m ByteString readBinary = liftSh . S.readBinary sleep :: MonadSh m => Int -> m () sleep = liftSh . S.sleep echo, echo_n, echo_err, echo_n_err :: MonadSh m => Text -> m () echo = liftSh . S.echo echo_n = liftSh . S.echo_n 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 relativeTo :: MonadSh m => FilePath -- ^ anchor path, the prefix -> FilePath -- ^ make this relative to anchor path -> m FilePath relativeTo = (liftSh .) . S.relativeTo canonic :: MonadSh m => FilePath -> m FilePath canonic = liftSh . canonic -- | Obtain a (reasonably) canonic file path to a filesystem object. Based on -- "canonicalizePath". canonicalize :: MonadSh m => FilePath -> m FilePath canonicalize = liftSh . S.canonicalize absPath :: MonadSh m => FilePath -> m FilePath absPath = liftSh . S.absPath test_d :: MonadSh m => FilePath -> m Bool test_d = liftSh . S.test_d test_s :: MonadSh m => FilePath -> m Bool test_s = liftSh . S.test_s ls :: MonadSh m => FilePath -> m [FilePath] ls = liftSh . S.ls inspect :: (Show s, MonadSh m) => s -> m () inspect = liftSh . S.inspect inspect_err :: (Show s, MonadSh m) => s -> m () inspect_err = liftSh . S.inspect_err catchany :: MonadBaseControl IO m => m a -> (SomeException -> m a) -> m a catchany = Control.Exception.Lifted.catch shelly-1.12.1/src/Shelly/Pipe.hs0000644000000000000000000004017607346545000014555 0ustar0000000000000000{-# 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 -- '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. -- A monad bind operator becomes a pipe operator and we can write -- -- > findExt ext = findWhen (pure . hasExt ext) -- > -- > main :: IO () -- > main = shs $ do -- > mkdir "new" -- > findExt "hs" "." >>= flip cp "new" -- > findExt "cpp" "." >>= rm_f -- > liftIO $ putStrLn "done" -- -- Documentation in this module mostly just reference documentation from -- the main "Shelly" module. -- -- > {-# LANGUAGE OverloadedStrings #-} -- > {-# LANGUAGE ExtendedDefaultRules #-} -- > {-# OPTIONS_GHC -fno-warn-type-defaults #-} -- > 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, log_stdout_with, log_stderr_with -- * List functions , roll, unroll, liftSh -- * 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, prependToPath -- * Environment directory , cd, chdir, pwd -- * Printing , echo, echo_n, echo_err, echo_n_err, inspect, inspect_err , tag, trace, show_command -- * Querying filesystem , ls, lsT, test_e, test_f, test_d, test_s, which -- * Filename helpers , absPath, (), (<.>), canonic, canonicalize, relPath, relativeTo , hasExt -- * Manipulating filesystem , mv, rm, rm_f, rm_rf, cp, cp_r, mkdir, mkdir_p, mkdirTree -- * reading/writing Files , readfile, readBinary, writefile, appendfile, touchfile, withTmpDir -- * exiting the program , exit, errorExit, quietExit, terror -- * Exceptions , catchany, catch_sh, finally_sh , ShellyHandler(..), catches_sh , catchany_sh -- * convert between Text and FilePath , toTextIgnore, toTextWarn, S.fromText -- * Utilities , (<$>), whenM, unlessM, time -- * Re-exported for your convenience , liftIO, when, unless, FilePath -- * internal functions for writing extensions , get, put -- * find functions , find, findWhen, findFold , findDirFilter, findDirFilterWhen, findFoldDirFilter , followSymlink ) where import qualified Shelly as S import Shelly ( (), (<.>), hasExt , whenM, unlessM, toTextIgnore , catchany , FoldCallback ) import Shelly.Base (State) import Control.Applicative import Control.Monad import Control.Monad.Trans import Control.Exception import Data.Maybe ( fromMaybe ) import Data.ByteString ( ByteString ) import Data.Tree ( Tree ) import Data.Text as T hiding (concat, all, find, cons) -- | This type is a simple wrapper for a type @Shelly.Sh@. -- 'Sh' contains a list of results. newtype Sh a = Sh { unSh :: S.Sh [a] } instance Functor Sh where 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 = pure a >>= f = Sh $ fmap concat $ mapM (unSh . f) =<< unSh a (>>) = (*>) instance Alternative Sh where empty = mzero (<|>) = mplus instance MonadPlus Sh where mzero = Sh $ return [] mplus a b = Sh $ liftA2 (++) (unSh a) (unSh b) instance MonadIO Sh where liftIO = sh1 liftIO ------------------------------------------------------- -- converters sh0 :: S.Sh a -> Sh a sh0 = Sh . fmap return 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 f = \a b -> sh0 (f a 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 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 f = \a -> sh0s (f a) {- Just in case ... 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 f = \a b c -> sh0s (f a b c) -} lift1 :: (S.Sh a -> S.Sh b) -> (Sh a -> Sh b) lift1 f = Sh . (mapM (f . return) =<< ) . unSh lift2 :: (S.Sh a -> S.Sh b -> S.Sh c) -> (Sh a -> Sh b -> Sh c) lift2 f a b = Sh $ join $ liftA2 (mapM2 f') (unSh a) (unSh b) 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 ----------------------------------------------------------- -- | Unpack list of results. unroll :: Sh a -> Sh [a] 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. liftSh :: ([a] -> [b]) -> Sh a -> Sh b liftSh f = Sh . fmap f . unSh ------------------------------------------------------------------ -- Entering Sh -- | see 'S.shelly' shelly :: MonadIO m => Sh a -> m [a] shelly = S.shelly . unSh -- | Performs 'shelly' and then an empty action @return ()@. shs :: MonadIO m => Sh () -> m () shs x = shelly x >> return () -- | see 'S.shellyFailDir' shellyFailDir :: MonadIO m => Sh a -> m [a] shellyFailDir = S.shellyFailDir . unSh -- | Performs 'shellyFailDir' and then an empty action @return ()@. shsFailDir :: MonadIO m => Sh () -> m () shsFailDir x = shellyFailDir x >> return () -- | see 'S.sub' sub :: Sh a -> Sh a sub = lift1 S.sub -- See 'S.siliently' silently :: Sh a -> Sh a silently = lift1 S.silently -- See 'S.verbosely verbosely :: Sh a -> Sh a verbosely = lift1 S.verbosely -- | see 'S.escaping' 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) -- | see 'S.print_commands print_commands :: Bool -> Sh a -> Sh a print_commands b = lift1 (S.print_commands b) -- | see 'S.tracing' tracing :: Bool -> Sh a -> Sh a tracing b = lift1 (S.tracing b) -- | see 'S.errExit' 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 run a b = sh0 $ S.run a b -- | see 'S.run_' run_ :: FilePath -> [Text] -> Sh () run_ a b = sh0 $ S.run_ a b -- | see 'S.runFoldLines' runFoldLines :: a -> FoldCallback a -> FilePath -> [Text] -> Sh a runFoldLines a cb fp ts = sh0 $ S.runFoldLines a cb fp ts -- | see 'S.-|-' (-|-) :: Sh Text -> Sh b -> Sh b (-|-) = lift2 (S.-|-) -- | see 'S.lastStderr' lastStderr :: Sh Text lastStderr = sh0 S.lastStderr -- | see 'S.setStdin' setStdin :: Text -> Sh () setStdin = sh1 S.setStdin -- | see 'S.lastExitCode' lastExitCode :: Sh Int lastExitCode = sh0 S.lastExitCode -- | see 'S.command' command :: FilePath -> [Text] -> [Text] -> Sh Text command = sh3 S.command -- | see 'S.command_' command_ :: FilePath -> [Text] -> [Text] -> Sh () command_ = sh3 S.command_ -- | see 'S.command1' command1 :: FilePath -> [Text] -> Text -> [Text] -> Sh Text command1 = sh4 S.command1 -- | see 'S.command1_' command1_ :: FilePath -> [Text] -> Text -> [Text] -> Sh () command1_ = sh4 S.command1_ -- | see 'S.sshPairs' sshPairs :: Text -> [(FilePath, [Text])] -> Sh Text sshPairs = sh2 S.sshPairs -- | see 'S.sshPairs_' sshPairs_ :: Text -> [(FilePath, [Text])] -> Sh () sshPairs_ = sh2 S.sshPairs_ -- | see 'S.setenv' setenv :: Text -> Text -> Sh () setenv = sh2 S.setenv -- | see 'S.get_env' get_env :: Text -> Sh (Maybe Text) get_env = sh1 S.get_env -- | see 'S.get_env_text' get_env_text :: Text -> Sh Text get_env_text = sh1 S.get_env_text -- | see 'S.get_env_def' get_env_def :: Text -> Text -> Sh Text get_env_def a d = sh0 $ fmap (fromMaybe d) $ S.get_env a {-# DEPRECATED get_env_def "use fromMaybe DEFAULT get_env" #-} -- | see 'S.appendToPath' 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 -- | see 'S.chdir' chdir :: FilePath -> Sh a -> Sh a chdir p = lift1 (S.chdir p) -- | see 'S.pwd' pwd :: Sh FilePath pwd = sh0 S.pwd ----------------------------------------------------------------- -- Printing -- | Echo text to standard (error, when using _err variants) output. The _n -- variants do not print a final newline. echo, echo_n_err, echo_err, echo_n :: Text -> Sh () echo = sh1 S.echo echo_n_err = sh1 S.echo_n_err echo_err = sh1 S.echo_err echo_n = sh1 S.echo_n -- | see 'S.inspect' inspect :: Show s => s -> Sh () inspect = sh1 S.inspect -- | see 'S.inspect_err' inspect_err :: Show s => s -> Sh () inspect_err = sh1 S.inspect_err -- | see 'S.tag' tag :: Sh a -> Text -> Sh a tag a t = lift1 (flip S.tag t) a -- | see 'S.trace' trace :: Text -> Sh () trace = sh1 S.trace -- | see 'S.show_command' show_command :: FilePath -> [Text] -> Text show_command = S.show_command ------------------------------------------------------------------ -- Querying filesystem -- | see 'S.ls' ls :: FilePath -> Sh FilePath ls = sh1s S.ls -- | see 'S.lsT' lsT :: FilePath -> Sh Text lsT = sh1s S.lsT -- | see 'S.test_e' test_e :: FilePath -> Sh Bool test_e = sh1 S.test_e -- | see 'S.test_f' test_f :: FilePath -> Sh Bool test_f = sh1 S.test_f -- | see 'S.test_d' test_d :: FilePath -> Sh Bool test_d = sh1 S.test_d -- | see 'S.test_s' test_s :: FilePath -> Sh Bool test_s = sh1 S.test_s -- | see 'S.which which :: FilePath -> Sh (Maybe FilePath) which = sh1 S.which --------------------------------------------------------------------- -- Filename helpers -- | see 'S.absPath' absPath :: FilePath -> Sh FilePath absPath = sh1 S.absPath -- | see 'S.canonic' canonic :: FilePath -> Sh FilePath canonic = sh1 S.canonic -- | see 'S.canonicalize' canonicalize :: FilePath -> Sh FilePath canonicalize = sh1 S.canonicalize -- | see 'S.relPath' relPath :: FilePath -> Sh FilePath relPath = sh1 S.relPath -- | see 'S.relativeTo' relativeTo :: FilePath -- ^ anchor path, the prefix -> FilePath -- ^ make this relative to anchor path -> Sh FilePath relativeTo = sh2 S.relativeTo ------------------------------------------------------------- -- Manipulating filesystem -- | see 'S.mv' mv :: FilePath -> FilePath -> Sh () mv = sh2 S.mv -- | see 'S.rm' rm :: FilePath -> Sh () rm = sh1 S.rm -- | see 'S.rm_f' rm_f :: FilePath -> Sh () rm_f = sh1 S.rm_f -- | see 'S.rm_rf' rm_rf :: FilePath -> Sh () rm_rf = sh1 S.rm_rf -- | see 'S.cp' cp :: FilePath -> FilePath -> Sh () cp = sh2 S.cp -- | see 'S.cp_r' cp_r :: FilePath -> FilePath -> Sh () cp_r = sh2 S.cp_r -- | see 'S.mkdir' mkdir :: FilePath -> Sh () mkdir = sh1 S.mkdir -- | see 'S.mkdir_p' mkdir_p :: FilePath -> Sh () mkdir_p = sh1 S.mkdir_p -- | see 'S.mkdirTree' mkdirTree :: Tree FilePath -> Sh () mkdirTree = sh1 S.mkdirTree -- | see 'S.readFile' readfile :: FilePath -> Sh Text readfile = sh1 S.readfile -- | see 'S.readBinary' readBinary :: FilePath -> Sh ByteString readBinary = sh1 S.readBinary -- | see 'S.writeFile' writefile :: FilePath -> Text -> Sh () writefile = sh2 S.writefile -- | see 'S.touchFile' touchfile :: FilePath -> Sh () touchfile = sh1 S.touchfile -- | see 'S.appendFile' appendfile :: FilePath -> Text -> Sh () appendfile = sh2 S.appendfile -- | see 'S.withTmpDir' withTmpDir :: (FilePath -> Sh a) -> Sh a withTmpDir f = Sh $ S.withTmpDir (unSh . f) ----------------------------------------------------------------- -- find -- | see 'S.find' find :: FilePath -> Sh FilePath find = sh1s S.find -- | see 'S.findWhen' findWhen :: (FilePath -> Sh Bool) -> FilePath -> Sh FilePath findWhen p a = Sh $ S.findWhen (fmap and . unSh . p) a -- | see 'S.findFold' findFold :: (a -> FilePath -> Sh a) -> a -> FilePath -> Sh a findFold cons nil a = Sh $ S.findFold cons' nil' a where nil' = return nil cons' as dir = unSh $ roll $ mapM (flip cons dir) as -- | 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) (fmap and . unSh . filePred) a -- | see 'S.findFoldDirFilterWhen' findFoldDirFilter :: (a -> FilePath -> Sh a) -> a -> (FilePath -> Sh Bool) -> FilePath -> Sh a findFoldDirFilter cons nil p a = Sh $ S.findFoldDirFilter cons' nil' p' a where p' = fmap and . unSh . p nil' = return nil cons' as dir = unSh $ roll $ mapM (flip cons dir) as ----------------------------------------------------------- -- exiting the program -- | see 'S.exit' exit :: Int -> Sh () exit = sh1 S.exit -- | see 'S.errorExit' errorExit :: Text -> Sh () errorExit = sh1 S.errorExit -- | see 'S.quietExit' quietExit :: Int -> Sh () quietExit = sh1 S.quietExit -- | see 'S.terror' terror :: Text -> Sh a terror = sh1 S.terror ------------------------------------------------------------ -- Utilities -- | see 'S.catch_sh' catch_sh :: (Exception e) => Sh a -> (e -> Sh a) -> Sh a catch_sh a f = Sh $ S.catch_sh (unSh a) (unSh . f) -- | see 'S.catchany_sh' catchany_sh :: Sh a -> (SomeException -> Sh a) -> Sh a catchany_sh = catch_sh -- | see 'S.finally_sh' finally_sh :: Sh a -> Sh b -> Sh a finally_sh = lift2 S.finally_sh -- | see 'S.time' time :: Sh a -> Sh (Double, a) time = lift1 S.time -- | see 'S.ShellyHandler' data ShellyHandler a = forall e . Exception e => ShellyHandler (e -> Sh a) -- | see 'S.catches_sh' catches_sh :: Sh a -> [ShellyHandler a] -> Sh a catches_sh a hs = Sh $ S.catches_sh (unSh a) (fmap convert hs) where convert :: ShellyHandler a -> S.ShellyHandler [a] convert (ShellyHandler f) = S.ShellyHandler (unSh . f) ------------------------------------------------------------ -- convert between Text and FilePath -- | see 'S.toTextWarn' toTextWarn :: FilePath -> Sh Text toTextWarn = sh1 S.toTextWarn ------------------------------------------------------------- -- internal functions for writing extension get :: Sh State get = sh0 S.get put :: State -> Sh () put = sh1 S.put -------------------------------------------------------- -- polyvariadic vodoo -- | Converter for the variadic argument version of 'run' called 'cmd'. class ShellArg a where -- | @since 1.12.0 toTextArgs :: a -> [Text] instance ShellArg Text where toTextArgs = (: []) 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 {-# INCOHERENT #-} s ~ () => ShellCommand (Sh s) where cmdAll = run_ instance ShellCommand (Sh Text) where cmdAll = run instance (ShellArg arg, ShellCommand result) => ShellCommand (arg -> result) where cmdAll fp acc x = cmdAll fp (acc ++ toTextArgs x) -- | see 'S.cmd' cmd :: (ShellCommand result) => FilePath -> result cmd fp = cmdAll fp [] shelly-1.12.1/src/Shelly/Unix.hs0000644000000000000000000000034707346545000014577 0ustar0000000000000000{-# 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] shelly-1.12.1/test/data/0000755000000000000000000000000007346545000013155 5ustar0000000000000000shelly-1.12.1/test/data/hello.sh0000644000000000000000000000004607346545000014614 0ustar0000000000000000#!/usr/bin/env bash echo -n "Hello!" shelly-1.12.1/test/data/nonascii.txt0000644000000000000000000000004007346545000015513 0ustar0000000000000000Selbstverständlich überraschend shelly-1.12.1/test/data/symlinked_dir/0000755000000000000000000000000007346545000016012 5ustar0000000000000000shelly-1.12.1/test/data/symlinked_dir/hoge_file0000644000000000000000000000000007346545000017644 0ustar0000000000000000shelly-1.12.1/test/data/zshrc0000644000000000000000000027132307346545000014241 0ustar0000000000000000# Filename: /etc/zsh/zshrc # Purpose: config file for zsh (z shell) # Authors: grml-team (grml.org), (c) Michael Prokop # 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: # # 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#
# #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: # # #
# # # Where
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)"$( 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] \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] \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 \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 , 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 # - ## 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: # # # The code is imported from the file 'zsh/functions/accept-line' from # , 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} 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 <' and 'cd -' 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)~~"$(\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 " ; return 1 } || vared aliases'[$1]' ; } compdef _aliases edalias #f1# Edit a function via zle edfunc() { [[ -z "$1" ]] && { echo "Usage: edfunc " ; 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['@']="set MARK" help_zle_keybindings['xj']="vi-join lines" help_zle_keybindings['xb']="jump to matching brace" help_zle_keybindings['xu']="undo" help_zle_keybindings['_']="undo" help_zle_keybindings['xf']="find in cmdline" help_zle_keybindings['a']="goto beginning of line" help_zle_keybindings['e']="goto end of line" help_zle_keybindings['t']="transpose charaters" help_zle_keybindings['t']="transpose words" help_zle_keybindings['s']="spellcheck word" help_zle_keybindings['k']="backward kill buffer" help_zle_keybindings['u']="forward kill buffer" help_zle_keybindings['y']="insert previously killed word/string" help_zle_keybindings["'"]="quote line" help_zle_keybindings['"']="quote from mark to cursor" help_zle_keybindings['']="repeat next cmd/char times (-10a -> -10 times 'a')" help_zle_keybindings['u']="make next word Uppercase" help_zle_keybindings['l']="make next word lowercase" help_zle_keybindings['xd']="preview expansion under cursor" help_zle_keybindings['q']="push current CL into background, freeing it. Restore on next CL" help_zle_keybindings['.']="insert (and interate through) last word from prev CLs" help_zle_keybindings[',']="complete word from newer history (consecutive hits)" help_zle_keybindings['m']="repeat last typed word on current CL" help_zle_keybindings['v']="insert next keypress symbol literally (e.g. for bindkey)" help_zle_keybindings['!!:n*']="insert last n arguments of last command" help_zle_keybindings['!!:n-']="insert arguments n..N-2 of last command (e.g. mv s s d)" help_zle_keybindings['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/}/\\e\^\?/}/\\e\[5~/}/\\e\[6~/}//(\\e|\^\[)/}//\^/}/3~/} #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 " >&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 \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 \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 \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 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 # 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 " ; 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. # preview='http://preview.'${result#http://} # # printf '%s\n\n' "${PN} - Shrinking long URLs via webservice TinyURL ." # 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] ' 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 ` ' 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 '-' 'offset to the current history number; (default: -100)' printf $format_s '<[-]first> []' '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: shelly-1.12.1/test/examples/0000755000000000000000000000000007346545000014062 5ustar0000000000000000shelly-1.12.1/test/examples/color.hs0000644000000000000000000000046007346545000015534 0ustar0000000000000000{-# 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"] shelly-1.12.1/test/examples/drain.hs0000644000000000000000000000070307346545000015513 0ustar0000000000000000{-# 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" shelly-1.12.1/test/examples/drain.sh0000644000000000000000000000006207346545000015511 0ustar0000000000000000#!/bin/sh echo "starting" sleep 2 echo "finished" shelly-1.12.1/test/examples/printer.sh0000644000000000000000000000007007346545000016076 0ustar0000000000000000#!/bin/sh while true; do echo "hello" sleep 1 done shelly-1.12.1/test/examples/run-handles.hs0000644000000000000000000000055307346545000016641 0ustar0000000000000000{-# 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 "" shelly-1.12.1/test/examples/test.sh0000644000000000000000000000002407346545000015371 0ustar0000000000000000#!/bin/bash echo hi shelly-1.12.1/test/src/0000755000000000000000000000000007346545000013033 5ustar0000000000000000shelly-1.12.1/test/src/CopySpec.hs0000644000000000000000000000375507346545000015126 0ustar0000000000000000{-# 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 $ cb cIsDir <- test_d c liftIO $ assert $ cIsDir bIsDir <- test_d $ cb 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 $ cb 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 shelly-1.12.1/test/src/EnvSpec.hs0000644000000000000000000000147407346545000014740 0ustar0000000000000000{-# 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 shelly-1.12.1/test/src/FailureSpec.hs0000644000000000000000000000160407346545000015572 0ustar0000000000000000module 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 ) shelly-1.12.1/test/src/FindSpec.hs0000644000000000000000000001425207346545000015066 0ustar0000000000000000module 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" ] shelly-1.12.1/test/src/Help.hs0000644000000000000000000000062407346545000014261 0ustar0000000000000000module 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 shelly-1.12.1/test/src/LiftedSpec.hs0000644000000000000000000000115607346545000015414 0ustar0000000000000000{-# 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" shelly-1.12.1/test/src/LogWithSpec.hs0000644000000000000000000000105307346545000015556 0ustar0000000000000000{-# 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 shelly-1.12.1/test/src/MoveSpec.hs0000644000000000000000000000365607346545000015122 0ustar0000000000000000module 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 $ cb cIsDir <- test_d c liftIO $ assert cIsDir bIsDir <- test_d $ cb 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 $ cb 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 -} shelly-1.12.1/test/src/PipeSpec.hs0000644000000000000000000000655507346545000015112 0ustar0000000000000000module 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 shelly-1.12.1/test/src/PrintCommandsFnSpec.hs0000644000000000000000000000072507346545000017250 0ustar0000000000000000module 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 shelly-1.12.1/test/src/ReadFileSpec.hs0000644000000000000000000000067507346545000015665 0ustar0000000000000000{-# 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) shelly-1.12.1/test/src/RmSpec.hs0000644000000000000000000000327507346545000014567 0ustar0000000000000000module 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 (db) "b" _ <- cmd "ln" "-s" (T.pack $ db) (T.pack l) rm_rf l test_f (db) assert res shelly $ rm_rf d shelly-1.12.1/test/src/RunSpec.hs0000644000000000000000000001340107346545000014745 0ustar0000000000000000module 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 shelly-1.12.1/test/src/ShowCommandSpec.hs0000644000000000000000000000267507346545000016433 0ustar0000000000000000module 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 \"\\`\"" shelly-1.12.1/test/src/SshSpec.hs0000644000000000000000000000265307346545000014745 0ustar0000000000000000{-# 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 ] shelly-1.12.1/test/src/TestInit.hs0000644000000000000000000000046207346545000015134 0ustar0000000000000000module 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" shelly-1.12.1/test/src/TestMain.hs0000644000000000000000000000105307346545000015112 0ustar0000000000000000 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 shelly-1.12.1/test/src/WhichSpec.hs0000644000000000000000000000065107346545000015246 0ustar0000000000000000module 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 shelly-1.12.1/test/src/WriteSpec.hs0000644000000000000000000000251407346545000015276 0ustar0000000000000000module 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) shelly-1.12.1/test/src/sleep.hs0000644000000000000000000000022307346545000014474 0ustar0000000000000000{-# Language OverloadedStrings #-} import Shelly main :: IO () main = shelly $ do echo "sleeping" run "sleep" ["5"] echo "all done" shelly-1.12.1/test/0000755000000000000000000000000007346545000012244 5ustar0000000000000000shelly-1.12.1/test/testall0000644000000000000000000000137007346545000013640 0ustar0000000000000000#!/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 </dev/null 2>&1 cat <