shelly-1.8.1/src/0000755000000000000000000000000013303634176012004 5ustar0000000000000000shelly-1.8.1/src/Shelly/0000755000000000000000000000000013303634176013244 5ustar0000000000000000shelly-1.8.1/test/0000755000000000000000000000000013253265025012171 5ustar0000000000000000shelly-1.8.1/test/data/0000755000000000000000000000000013231501272013073 5ustar0000000000000000shelly-1.8.1/test/data/symlinked_dir/0000755000000000000000000000000013066034126015735 5ustar0000000000000000shelly-1.8.1/test/examples/0000755000000000000000000000000013066031405014002 5ustar0000000000000000shelly-1.8.1/test/src/0000755000000000000000000000000013253265115012760 5ustar0000000000000000shelly-1.8.1/src/Shelly.hs0000644000000000000000000015715113303634176013612 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, OverloadedStrings, FlexibleInstances, IncoherentInstances, TypeFamilies, ExistentialQuantification #-} -- | 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 , 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, 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, FP.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.Monad ( when, unless, void, forM, filterM, liftM2 ) import Control.Monad.Trans ( MonadIO ) import Control.Monad.Reader (ask) #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706 import Prelude hiding ( readFile, FilePath, catch) #else import Prelude hiding ( readFile, FilePath) #endif import Data.Char ( isAlphaNum, isSpace, toLower ) import Data.Typeable import Data.IORef import Data.Sequence (Seq, (|>)) import Data.Foldable (toList) import Data.Maybe import System.IO ( hClose, stderr, stdout, openTempFile) import System.IO.Error (isPermissionError, catchIOError, isEOFError, isIllegalOperation) import System.Exit import System.Environment import Control.Applicative import Control.Exception import Control.Concurrent import Control.Concurrent.Async (async, wait, Async) import Data.Time.Clock( getCurrentTime, diffUTCTime ) import qualified Data.Text.IO as TIO import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding.Error as TE import System.Process( CmdSpec(..), StdStream(CreatePipe, UseHandle), CreateProcess(..), createProcess, waitForProcess, terminateProcess, ProcessHandle, StdStream(..) ) import qualified Data.Text as T import qualified Data.ByteString as BS import Data.ByteString (ByteString) import Data.Monoid (Monoid, mempty, mappend) #if __GLASGOW_HASKELL__ < 704 infixr 5 <> (<>) :: Monoid m => m -> m -> m (<>) = mappend #else import Data.Monoid ((<>)) #endif import Filesystem.Path.CurrentOS hiding (concat, fromText, (), (<.>)) import Filesystem hiding (canonicalizePath) import qualified Filesystem.Path.CurrentOS as FP import System.Directory ( setPermissions, getPermissions, Permissions(..), getTemporaryDirectory, pathIsSymbolicLink ) import Data.Char (isDigit) import Data.Tree(Tree(..)) import qualified Data.Set as S import qualified Data.List as L searchPathSeparator :: Char #if defined(mingw32_HOST_OS) searchPathSeparator = ';' #else searchPathSeparator = ':' #endif {- GHC won't default to Text with this, even with extensions! - see: http://hackage.haskell.org/trac/ghc/ticket/6030 class CmdArgs a where toTextArgs :: a -> [Text] instance CmdArgs Text where toTextArgs t = [t] instance CmdArgs FilePath where toTextArgs t = [toTextIgnore t] instance CmdArgs [Text] where toTextArgs = id instance CmdArgs [FilePath] where toTextArgs = map toTextIgnore instance CmdArgs (Text, Text) where toTextArgs (t1,t2) = [t1, t2] instance CmdArgs (FilePath, FilePath) where toTextArgs (fp1,fp2) = [toTextIgnore fp1, toTextIgnore fp2] instance CmdArgs (Text, FilePath) where toTextArgs (t1, fp1) = [t1, toTextIgnore fp1] instance CmdArgs (FilePath, Text) where toTextArgs (fp1,t1) = [toTextIgnore fp1, t1] cmd :: (CmdArgs args) => FilePath -> args -> Sh Text cmd fp args = run fp $ toTextArgs args -} -- | Argument converter for the variadic argument version of 'run' called 'cmd'. -- Useful for a type signature of a function that uses 'cmd' class CmdArg a where toTextArg :: a -> Text instance CmdArg Text where toTextArg = id instance CmdArg FilePath where toTextArg = toTextIgnore instance CmdArg String where toTextArg = T.pack -- | For the variadic function 'cmd' -- -- partially applied variadic functions require type signatures class ShellCmd t where cmdAll :: FilePath -> [Text] -> t instance ShellCmd (Sh Text) where cmdAll = run instance (s ~ Text, Show s) => ShellCmd (Sh s) where cmdAll = run -- note that Sh () actually doesn't work for its case (_<- cmd) when there is no type signature instance ShellCmd (Sh ()) where cmdAll = run_ instance (CmdArg arg, ShellCmd result) => ShellCmd (arg -> result) where cmdAll fp acc x = cmdAll fp (acc ++ [toTextArg x]) instance (CmdArg arg, ShellCmd result) => ShellCmd ([arg] -> result) where cmdAll fp acc x = cmdAll fp (acc ++ map toTextArg x) -- | 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 [] -- | Helper to convert a Text to a FilePath. Used by '()' and '(<.>)' class ToFilePath a where toFilePath :: a -> FilePath instance ToFilePath FilePath where toFilePath = id instance ToFilePath Text where toFilePath = FP.fromText instance ToFilePath String where toFilePath = FP.fromText . T.pack -- | uses System.FilePath.CurrentOS, but can automatically convert a Text () :: (ToFilePath filepath1, ToFilePath filepath2) => filepath1 -> filepath2 -> FilePath x y = toFilePath x FP. toFilePath y -- | uses System.FilePath.CurrentOS, but can automatically convert a Text (<.>) :: (ToFilePath filepath) => filepath -> Text -> FilePath x <.> y = toFilePath x FP.<.> y toTextWarn :: FilePath -> Sh Text toTextWarn efile = case toText efile of Left f -> encodeError f >> return f Right f -> return f 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 use it combinator style 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 (encodeString fullExe) (map T.unpack args) where findExe :: FilePath -> Sh FilePath findExe #if defined(mingw32_HOST_OS) || (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 708) 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) || (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 708) Left _ -> return fp #else Left err -> liftIO $ throwIO $ userError err #endif shellyProcess :: [StdHandle] -> State -> CmdSpec -> IO (Handle, Handle, Handle, ProcessHandle) shellyProcess reusedHandles st cmdSpec = do (createdInH, createdOutH, createdErrorH, pHandle) <- createProcess CreateProcess { cmdspec = cmdSpec , cwd = Just $ encodeString $ sDirectory st , env = Just $ sEnvironment st , std_in = createUnless mInH , std_out = createUnless mOutH , std_err = createUnless mErrorH , close_fds = False #if MIN_VERSION_process(1,1,0) , create_group = False #endif #if MIN_VERSION_process(1,2,0) , delegate_ctlc = False #endif #if MIN_VERSION_process(1,3,0) , detach_console = False , create_new_console = False , new_session = False #endif #if MIN_VERSION_process(1,4,0) , child_group = Nothing , child_user = Nothing #endif #if MIN_VERSION_process(1,5,0) , use_process_jobs = False #endif } 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 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 -- | apply a String IO operations to a Text FilePath {- liftStringIO :: (String -> IO String) -> FilePath -> Sh FilePath liftStringIO f = liftIO . f . unpack >=> return . pack -- | @asString f = pack . f . unpack@ asString :: (String -> String) -> FilePath -> FilePath asString f = pack . f . unpack -} pack :: String -> FilePath pack = decodeString -- | Move a file. The second path could be a directory, in which case the -- original file is moved into that directory. -- wraps system-fileio 'FileSystem.rename', which may not work across FS boundaries mv :: FilePath -> FilePath -> Sh () mv from' to' = do trace $ "mv " <> toTextIgnore from' <> " " <> toTextIgnore to' from <- absPath from' to <- absPath to' to_dir <- test_d to let to_loc = if not to_dir then to else to FP. filename from liftIO $ rename from to_loc `catchany` (\e -> throwIO $ ReThrownException e (extraMsg to_loc from) ) where extraMsg t f = "during copy from: " ++ encodeString f ++ " to: " ++ encodeString 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 . createDirectory False -- | Create a new directory, including parents (succeeds if the directory -- already exists). mkdir_p :: FilePath -> Sh () mkdir_p = traceAbsPath ("mkdir -p " <>) >=> liftIO . createTree -- | 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 (encodeString 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 extension originalFp of Nothing -> originalFp <.> "exe" Just _ -> originalFp #else originalFp #endif where whichFull fp = do (trace . mappend "which " . toTextIgnore) fp >> whichUntraced where whichUntraced | absolute fp = checkFile | dotSlash splitOnDirs = checkFile | length splitOnDirs > 0 = lookupPath >>= leftPathError | otherwise = lookupCache >>= leftPathError splitOnDirs = splitDirectories fp dotSlash ("./":_) = True dotSlash _ = False checkFile :: Sh (Either String FilePath) checkFile = do exists <- liftIO $ isFile fp return $ if exists then Right fp else Left $ "did not find file: " <> encodeString 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` encodeString 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 lookupCache :: Sh (Maybe FilePath) lookupCache = do pathExecutables <- cachedPathExecutables return $ fmap (flip () fp . fst) $ L.find (S.member fp . snd) pathExecutables pathDirs = mapM absPath =<< ((map FP.fromText . filter (not . T.null) . T.split (== searchPathSeparator)) `fmap` get_env_text "PATH") cachedPathExecutables :: Sh [(FilePath, S.Set FilePath)] cachedPathExecutables = do mPathExecutables <- gets sPathExecutables case mPathExecutables of Just pExecutables -> return pExecutables Nothing -> do dirs <- pathDirs executables <- forM dirs (\dir -> do files <- (liftIO . listDirectory) dir `catch_sh` (\(_ :: IOError) -> return []) exes <- fmap (map snd) $ liftIO $ filterM (isExecutable . fst) $ map (\f -> (f, filename f)) files return $ S.fromList exes ) let cachedExecutables = zip dirs executables modify $ \x -> x { sPathExecutables = Just cachedExecutables } return $ cachedExecutables -- | 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 <- isFile f if file then return True else isDirectory f -- | Does a path point to an existing file? test_f :: FilePath -> Sh Bool test_f = absPath >=> liftIO . isFile -- | 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 'removeTree' rm_rf :: FilePath -> Sh () rm_rf infp = do f <- traceAbsPath ("rm -rf " <>) infp isDir <- (test_d f) if not isDir then whenM (test_f f) $ rm_f f else (liftIO_ $ removeTree f) `catch_sh` (\(e :: IOError) -> when (isPermissionError e) $ do find f >>= mapM_ (\file -> liftIO_ $ fixPermissions (encodeString file) `catchany` \_ -> return ()) liftIO $ removeTree 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 filename) 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 -- On Windows, normalize all environment variable names (to lowercase) -- to account for case insensitivity. #if defined(mingw32_HOST_OS) normalizeEnvVarNameText :: Text -> Text normalizeEnvVarNameText = T.toLower normalizeEnvVarNameString :: String -> String normalizeEnvVarNameString = fmap toLower -- On other systems, keep the variable names as-is. #else normalizeEnvVarNameText :: Text -> Text normalizeEnvVarNameText = id normalizeEnvVarNameString :: String -> String normalizeEnvVarNameString = 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 -- | deprecated 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 -- | 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) -> (normalizeEnvVarNameString 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 getWorkingDirectory let def = State { sCode = 0 , sStdin = Nothing , sStderr = T.empty , sPutStdout = TIO.hPutStrLn stdout , sPutStderr = TIO.hPutStrLn stderr , sPrintStdout = True , sPrintStderr = True , sPrintCommands = False , 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: " <> encodeString 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 . encodeString . filename) $ 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 = T.intercalate " " $ map quote (toTextIgnore exe : args) where quote t | T.any (== '\'') t = t quote t | T.any isSpace t = surround '\'' t quote t | otherwise = t -- 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 'sshPairsP', 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 parallell. 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' -- -- 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 -- 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) $ echo 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'. fold over stdout line-by-line as it is read to avoid keeping it in memory -- stderr is still being placed in memory under the assumption it is always relatively small 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 mkdir to >> return to else do let d = to dirname (addTrailingSlash from) mkdir_p d >> return d ls from >>= mapM_ (\item -> cp_r (from FP. filename item) (finalTo FP. filename item)) -- | 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. filename from else to if shouldFollowSymlinks then copyNormal from to_loc else do isSymlink <- liftIO $ pathIsSymbolicLink (encodeString from) if not isSymlink then copyNormal from to_loc else do target <- liftIO $ getSymbolicLinkTarget (encodeString from) liftIO $ createFileLink target (encodeString to_loc) where extraMsg t f = "during copy from: " ++ encodeString f ++ " to: " ++ encodeString 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 (encodeString f) bits) writeBinary :: FilePath -> ByteString -> Sh () writeBinary f' bytes = do f <- traceAbsPath ("writeBinary " <>) f' liftIO (BS.writeFile (encodeString 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 (encodeString f) bits) readfile :: FilePath -> Sh Text readfile = traceAbsPath ("readfile " <>) >=> \fp -> readBinary fp >>= return . TE.decodeUtf8With TE.lenientDecode -- | wraps ByteSting readFile readBinary :: FilePath -> Sh ByteString readBinary = traceAbsPath ("readBinary " <>) >=> liftIO . BS.readFile . encodeString -- | flipped hasExtension for Text hasExt :: Text -> FilePath -> Bool hasExt = flip hasExtension -- | 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.8.1/src/Shelly/Lifted.hs0000644000000000000000000005146113066034126015011 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 , 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, 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, FP.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 Shelly.Base (Sh(..), ShIO, Text, (>=>), FilePath) import qualified Shelly.Base as S import Control.Monad ( liftM ) import Prelude hiding ( FilePath ) import Data.ByteString ( ByteString ) import Data.Monoid import System.IO ( Handle ) import Data.Tree ( Tree ) import qualified Filesystem.Path.CurrentOS as FP import Control.Exception.Lifted import Control.Exception.Enclosed import Control.Monad.IO.Class import Control.Monad.Trans.Control import Control.Monad.Trans.Identity import Control.Monad.Trans.List import Control.Monad.Trans.Maybe import Control.Monad.Trans.Cont import Control.Monad.Trans.Error import Control.Monad.Trans.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 (ListT m) where liftSh m = ListT $ do a <- liftSh m return [a] instance MonadSh m => MonadSh (MaybeT m) where liftSh = MaybeT . liftM Just . liftSh instance MonadSh m => MonadSh (ContT r m) where liftSh m = ContT (liftSh m >>=) instance (Error e, MonadSh m) => MonadSh (ErrorT e m) where liftSh m = ErrorT $ do 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 (ListT m) where newtype ShM (ListT m) a = ListTShM (ShM m [a]) liftShWith f = ListT $ liftM return $ liftShWith $ \runInSh -> f $ \k -> liftM ListTShM $ runInSh $ runListT k restoreSh (ListTShM m) = ListT . restoreSh $ m {-# INLINE liftShWith #-} {-# INLINE restoreSh #-} instance MonadShControl m => MonadShControl (MaybeT m) where newtype ShM (MaybeT m) a = MaybeTShM (ShM m (Maybe a)) liftShWith f = 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, Error e) => MonadShControl (ErrorT e m) where newtype ShM (ErrorT e m) a = ErrorTShM (ShM m (Either e a)) liftShWith f = ErrorT $ liftM return $ liftShWith $ \runInSh -> f $ \k -> liftM ErrorTShM $ runInSh $ runErrorT k restoreSh (ErrorTShM m) = ErrorT . restoreSh $ m {-# 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) 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 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" in system-fileio. 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.8.1/src/Shelly/Pipe.hs0000644000000000000000000004101213066034126014466 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" -- -- Monad methods "return" and ">>=" behave like methods for -- @ListT Shelly.Sh@, but ">>" forgets the number of -- the empty effects. So the last line prints @\"done\"@ only once. -- -- Documentation in this module mostly just reference documentation from -- the main "Shelly" module. -- -- > {-# 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, 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 Prelude hiding (FilePath) import Control.Applicative import Control.Monad import Control.Monad.Trans import Control.Exception hiding (handle) import Filesystem.Path(FilePath) import qualified Shelly as S import Shelly( (), (<.>), hasExt , whenM, unlessM, toTextIgnore , fromText, catchany , FoldCallback) import Data.Maybe(fromMaybe) import Shelly.Base(State) 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 Monad Sh where return = Sh . return . return a >>= f = Sh $ fmap concat $ mapM (unSh . f) =<< unSh a a >> b = Sh $ unSh a >> unSh b instance Applicative Sh where pure = return (<*>) = ap instance Alternative Sh where empty = mzero (<|>) = mplus instance MonadPlus Sh where mzero = Sh $ return [] 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 toTextArg :: a -> Text instance ShellArg Text where toTextArg = id instance ShellArg FilePath where toTextArg = toTextIgnore -- Voodoo to create the variadic function 'cmd' class ShellCommand t where cmdAll :: FilePath -> [Text] -> t instance ShellCommand (Sh Text) where cmdAll fp args = run fp args instance (s ~ Text, Show s) => ShellCommand (Sh s) where cmdAll fp args = run fp args -- note that Sh () actually doesn't work for its case (_<- cmd) when there is no type signature instance ShellCommand (Sh ()) where cmdAll fp args = run_ fp args instance (ShellArg arg, ShellCommand result) => ShellCommand (arg -> result) where cmdAll fp acc = \x -> cmdAll fp (acc ++ [toTextArg x]) -- | see 'S.cmd' cmd :: (ShellCommand result) => FilePath -> result cmd fp = cmdAll fp [] shelly-1.8.1/src/Shelly/Unix.hs0000644000000000000000000000034613066031405014516 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.8.1/src/Shelly/Base.hs0000644000000000000000000002626113253265115014456 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE InstanceSigs#-} -- | I started exposing multiple module (starting with one for finding) -- Base prevented circular dependencies -- However, Shelly went back to exposing a single module 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, inspect, inspect_err, catchany, liftIO, (>=>), eitherRelativeTo, relativeTo, maybeRelativeTo, whenM -- * utilities not yet exported , addTrailingSlash ) where #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706 import Prelude hiding (FilePath, catch) #else import Prelude hiding (FilePath) #endif import Data.Text (Text) import System.Process( ProcessHandle, StdStream(..) ) import System.IO ( Handle, hFlush, stderr, stdout ) import Control.Monad (when, (>=>), liftM ) import Control.Monad.Base import Control.Monad.Trans.Control import Control.Applicative (Applicative, (<$>)) import Filesystem (isDirectory, listDirectory) import System.PosixCompat.Files( getSymbolicLinkStatus, isSymbolicLink ) import Filesystem.Path.CurrentOS (FilePath, encodeString, relative) import qualified Filesystem.Path.CurrentOS as FP import qualified Filesystem as FS import Data.IORef (readIORef, modifyIORef, IORef) import Data.Monoid (mappend) import qualified Data.Text as T import qualified Data.Text.IO as TIO import Control.Exception (SomeException, catch, throwIO, Exception) 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, 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 , 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 rel toStrip nada = case FP.stripPrefix rel toStrip of Just stripped -> if stripped == toStrip then nada else return $ Right stripped Nothing -> nada -- | make the second path relative to the first -- Uses 'Filesystem.stripPrefix', but will canonicalize the paths if necessary relativeTo :: FilePath -- ^ anchor path, the prefix -> FilePath -- ^ make this relative to anchor path -> 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 p = if FP.null (FP.filename p) then p else p FP. FP.empty -- | makes an absolute path. -- Like 'canonicalize', but on an exception returns 'absPath' canonic :: FilePath -> Sh FilePath canonic fp = do p <- absPath fp liftIO $ canonicalizePath p `catchany` \_ -> return p -- | Obtain a (reasonably) canonic file path to a filesystem object. Based on -- "canonicalizePath" in system-fileio. canonicalize :: FilePath -> Sh FilePath canonicalize = absPath >=> liftIO . canonicalizePath -- | bugfix older version of canonicalizePath (system-fileio <= 0.3.7) loses trailing slash canonicalizePath :: FilePath -> IO FilePath canonicalizePath p = let was_dir = FP.null (FP.filename 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 | FP.null p = liftIO $ throwIO EmptyFilePathError | relative p = (FP. p) <$> gets sDirectory | otherwise = return p -- | deprecated path :: FilePath -> Sh FilePath path = absPath {-# DEPRECATED path "use absPath, canonic, or relPath instead" #-} -- | Does a path point to an existing directory? test_d :: FilePath -> Sh Bool test_d = absPath >=> liftIO . isDirectory -- | Does a path point to a symlink? test_s :: FilePath -> Sh Bool test_s = absPath >=> liftIO . \f -> do stat <- getSymbolicLinkStatus (encodeString f) return $ isSymbolicLink stat unpack :: FilePath -> String unpack = encodeString 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 filt <- if not (relative f) then return return else do wd <- gets sDirectory return (relativeTo wd) absolute <- liftIO $ listDirectory fp relativized <- mapM filt absolute return (relativized, absolute) -- | silently uses the Right or Left value of "Filesystem.Path.CurrentOS.toText" toTextIgnore :: FilePath -> Text toTextIgnore fp = case FP.toText fp of Left f -> f Right f -> f -- | a print lifted into 'Sh' inspect :: (Show s) => s -> Sh () inspect x = do (trace . T.pack . show) x liftIO $ print 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) 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.8.1/src/Shelly/Find.hs0000644000000000000000000000704013066034126014454 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 Prelude hiding (FilePath) import Shelly.Base import Control.Monad (foldM) import Data.Monoid (mappend) import System.PosixCompat.Files( getSymbolicLinkStatus, isSymbolicLink ) import Filesystem (isDirectory) import Filesystem.Path.CurrentOS (encodeString) -- | 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 '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 $ isDirectory absolutePath sym <- liftIO $ fmap isSymbolicLink $ getSymbolicLinkStatus (encodeString absolutePath) newAcc <- folder acc relativePath follow <- fmap sFollowSymlink get if isDir && (follow || not sym) then findFoldDirFilter folder newAcc dirFilter relativePath else return newAcc shelly-1.8.1/src/Shelly/Directory.hs0000644000000000000000000000173613303634176015553 0ustar0000000000000000{-# OPTIONS -Wall #-} module Shelly.Directory where import System.IO.Error (modifyIOError, ioeSetLocation, ioeGetLocation) import qualified Filesystem.Path.CurrentOS as FP #ifdef mingw32_HOST_OS import qualified System.Win32 as Win32 #else import qualified System.Posix as Posix #endif createFileLink :: String -> String -> IO () createFileLink target link = (`ioeAddLocation` "createFileLink") `modifyIOError` do #ifdef mingw32_HOST_OS Win32.createSymbolicLink False target link #else Posix.createSymbolicLink target link #endif getSymbolicLinkTarget :: String -> IO String getSymbolicLinkTarget path = (`ioeAddLocation` "getSymbolicLinkTarget") `modifyIOError` do #ifdef mingw32_HOST_OS Win32.readSymbolicLink path #else Posix.readSymbolicLink path #endif 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.8.1/test/examples/color.hs0000644000000000000000000000046613066031405015462 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", "../dist"] run_ "ls" ["--color=auto", "../dist"] shelly-1.8.1/test/examples/run-handles.hs0000644000000000000000000000054613066031405016563 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" ["examples/test.sh"] handles doNothing where handles = [InHandle Inherit, OutHandle Inherit, ErrorHandle Inherit] doNothing _ _ _ = return "" shelly-1.8.1/test/examples/drain.hs0000644000000000000000000000073613066031405015441 0ustar0000000000000000{-# Language OverloadedStrings, ExtendedDefaultRules #-} import Prelude hiding (FilePath) import Shelly import Control.Monad (void) import Data.Text (Text) default (Text) main :: IO () main = do let exDir = "./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.8.1/test/src/TestMain.hs0000644000000000000000000000066013211426340015033 0ustar0000000000000000 module Main where import ReadFileSpec import WhichSpec import WriteSpec import MoveSpec import RmSpec import FindSpec import EnvSpec import FailureSpec import CopySpec import LiftedSpec import RunSpec import SshSpec import Test.Hspec main :: IO () main = hspec $ do readFileSpec whichSpec writeSpec moveSpec rmSpec findSpec envSpec failureSpec copySpec liftedSpec runSpec sshSpec shelly-1.8.1/test/src/CopySpec.hs0000644000000000000000000000420413066031405015034 0ustar0000000000000000{-# Language CPP #-} module CopySpec ( copySpec ) where import TestInit #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706 import Prelude hiding ( FilePath, catch) #else import Prelude hiding ( FilePath) #endif import Control.Monad (forM_) import System.IO.Error import Help copySpec :: Spec copySpec = do let b = "b" let 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.8.1/test/src/EnvSpec.hs0000644000000000000000000000172313253265115014662 0ustar0000000000000000{-# LANGUAGE CPP #-} module EnvSpec ( envSpec ) where import TestInit #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706 import Prelude hiding ( FilePath, catch) #else import Prelude hiding ( FilePath) #endif import Data.Maybe envSpec :: Spec 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.8.1/test/src/FailureSpec.hs0000644000000000000000000000160413066031405015512 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.8.1/test/src/FindSpec.hs0000644000000000000000000001045713231501252015005 0ustar0000000000000000module FindSpec ( findSpec ) where import TestInit import Data.List (sort) import System.Directory (createDirectoryIfMissing) import System.PosixCompat.Files (createSymbolicLink, fileExist) import qualified System.FilePath as SF createSymlinkForTest :: IO () createSymlinkForTest = do createDirectoryIfMissing False 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" 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 @?= ["./CopySpec.hs", "./EnvSpec.hs", "./FailureSpec.hs", "./FindSpec.hs", "./Help.hs", "./LiftedSpec.hs", "./LogWithSpec.hs", "./MoveSpec.hs", "./ReadFileSpec.hs", "./RmSpec.hs", "./RunSpec.hs", "./SshSpec.hs", "./TestInit.hs", "./TestMain.hs", "./WhichSpec.hs", "./WriteSpec.hs", "./sleep.hs"] it "finds relative files" $ do res <- shelly $ cd "test/src" >> find "." sort res @?= ["./CopySpec.hs", "./EnvSpec.hs", "./FailureSpec.hs", "./FindSpec.hs", "./Help.hs", "./LiftedSpec.hs", "./LogWithSpec.hs", "./MoveSpec.hs", "./ReadFileSpec.hs", "./RmSpec.hs", "./RunSpec.hs", "./SshSpec.hs", "./TestInit.hs", "./TestMain.hs", "./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 $ find "test/src" sort res @?= ["test/src/CopySpec.hs", "test/src/EnvSpec.hs", "test/src/FailureSpec.hs", "test/src/FindSpec.hs", "test/src/Help.hs", "test/src/LiftedSpec.hs", "test/src/LogWithSpec.hs", "test/src/MoveSpec.hs", "test/src/ReadFileSpec.hs", "test/src/RmSpec.hs", "test/src/RunSpec.hs", "test/src/SshSpec.hs", "test/src/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", "ReadFileSpec.hs", "RmSpec.hs", "RunSpec.hs", "SshSpec.hs", "TestInit.hs", "TestMain.hs", "WhichSpec.hs", "WriteSpec.hs", "sleep.hs"] before createSymlinkForTest $ do it "follow symlinks" $ do res <- shelly $ followSymlink True $ relPath "test/data" >>= find >>= mapM (relativeTo "test/data") sort res @?= [ "dir" , "nonascii.txt" , "symlinked_dir" , "zshrc" , "dir/symlinked_dir" , "dir/symlinked_dir/hoge_file" , "symlinked_dir/hoge_file" ] it "not follow symlinks" $ do res <- shelly $ followSymlink False $ relPath "test/data" >>= find >>= mapM (relativeTo "test/data") sort res @?= [ "dir" , "nonascii.txt" , "symlinked_dir" , "zshrc" , "dir/symlinked_dir" , "symlinked_dir/hoge_file" ] shelly-1.8.1/test/src/Help.hs0000644000000000000000000000105413066031405014177 0ustar0000000000000000module Help ( with_dir, within_dir, (@==) ) where import Shelly #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706 import Prelude hiding ( catch, FilePath ) #else import Prelude hiding ( FilePath ) #endif import Test.HUnit import Control.Monad.Trans ( MonadIO ) (@==) :: (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.8.1/test/src/LiftedSpec.hs0000644000000000000000000000115613253265115015341 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.8.1/test/src/MoveSpec.hs0000644000000000000000000000370313066031405015033 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.8.1/test/src/ReadFileSpec.hs0000644000000000000000000000112613066031405015575 0ustar0000000000000000{-# LANGUAGE CPP #-} module ReadFileSpec (readFileSpec) where import TestInit #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706 import Prelude hiding ( FilePath, catch) #else import Prelude hiding ( FilePath) #endif import qualified Data.ByteString as BS import qualified Data.Text as T 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.8.1/test/src/RmSpec.hs0000644000000000000000000000314213066031405014500 0ustar0000000000000000module RmSpec (rmSpec) where import TestInit 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" b l rm l test_f b assert res shelly $ rm b it "rm_f" $ do res <- shelly $ do writefile b "b" cmd "ln" "-s" b 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" (db) l rm_rf l test_f (db) assert res shelly $ rm_rf d shelly-1.8.1/test/src/RunSpec.hs0000644000000000000000000000351013066031405014665 0ustar0000000000000000module RunSpec ( runSpec ) where import TestInit import qualified Data.Text as T 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" [ "*" ] assert $ "README.md" `elem` T.words res it "with binary handle mode" $ do res <- shelly $ onCommandHandles (initOutputHandles (flip hSetBinaryMode True)) $ run "cat" [ "test/data/nonascii.txt" ] res @?= "Selbstverst\228ndlich \252berraschend\n" -- 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" ] 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 <- bash "echo" [ "'foo'", "|", "echo", "'bar'" ] eCode <- lastExitCode return (eCode, res) res @?= "bar\n" eCode @?= 0 shelly-1.8.1/test/src/SshSpec.hs0000644000000000000000000000265313213141323014660 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.8.1/test/src/TestInit.hs0000644000000000000000000000034213253265115015056 0ustar0000000000000000module TestInit (module Export) 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 () shelly-1.8.1/test/src/WhichSpec.hs0000644000000000000000000000065213066031405015167 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.8.1/test/src/WriteSpec.hs0000644000000000000000000000255513066031405015223 0ustar0000000000000000module WriteSpec ( writeSpec ) where import TestInit import Prelude hiding (FilePath) 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.8.1/LICENSE0000644000000000000000000000300213066031405012205 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.8.1/Setup.hs0000644000000000000000000000005613066031405012642 0ustar0000000000000000import Distribution.Simple main = defaultMain shelly-1.8.1/shelly.cabal0000644000000000000000000001204713303634474013506 0ustar0000000000000000Name: shelly Version: 1.8.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. . * is modern, using Text and system-filepath/system-fileio . Shelly is originally forked from the Shellish package. . See the shelly-extra package for additional functionality. . An overview is available in the README: Homepage: https://github.com/yesodweb/Shelly.hs License: BSD3 License-file: LICENSE Author: Greg Weber, Petr Rockai Maintainer: Greg Weber Category: Development Build-type: Simple Cabal-version: >=1.8 -- 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/testall README.md ChangeLog.md Library Exposed-modules: Shelly, Shelly.Lifted, Shelly.Pipe, Shelly.Unix other-modules: Shelly.Base, Shelly.Find, Shelly.Directory hs-source-dirs: src Build-depends: containers >= 0.4.2.0, time >= 1.3 && < 1.9, directory >= 1.3.0.0 && < 1.4.0.0, mtl >= 2, process >= 1.0, unix-compat < 0.6, unix, system-filepath >= 0.4.7 && < 0.5, system-fileio < 0.4, monad-control >= 0.3.2 && < 1.1, lifted-base, lifted-async, exceptions >= 0.6, enclosed-exceptions, text, bytestring, async, transformers, transformers-base if impl(ghc >= 7.6.1) build-depends: base >= 4.6 && < 5 else build-depends: base >= 4 && < 5 ghc-options: -Wall if impl(ghc >= 7.6.1) CPP-Options: -DNO_PRELUDE_CATCH extensions: CPP source-repository head type: git location: https://github.com/yesodweb/Shelly.hs Flag lifted Description: run the tests against Shelly.Lifted Default: False Test-Suite shelly-testsuite type: exitcode-stdio-1.0 hs-source-dirs: src test/src main-is: TestMain.hs other-modules: CopySpec EnvSpec FailureSpec FindSpec Help LiftedSpec MoveSpec ReadFileSpec RmSpec RunSpec SshSpec Shelly Shelly.Base Shelly.Find Shelly.Lifted TestInit WhichSpec WriteSpec ghc-options: -O2 -Wall -fwarn-tabs -funbox-strict-fields -threaded -fno-warn-unused-do-bind -fno-warn-type-defaults extensions: OverloadedStrings, ExtendedDefaultRules if flag(lifted) cpp-options: -DLIFTED build-depends: base >= 4.6, text >= 0.11, async, bytestring >= 0.10, containers >= 0.5.0.0, directory >= 1.3.0.0 && < 1.4.0.0, process >= 1.1.0, unix-compat < 0.6, unix, system-filepath >= 0.4.7 && < 0.5, system-fileio < 0.4, time >= 1.3 && < 1.9, mtl >= 2, HUnit >= 1.2, hspec >= 2.0, hspec-contrib, transformers, transformers-base, filepath, monad-control, lifted-base, lifted-async, enclosed-exceptions, exceptions extensions: CPP Flag build-examples Description: build some example programs Default: False Manual: True -- demonstarated 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 if flag(build-examples) buildable: True build-depends: base >= 4.6 , shelly , text extensions: CPP else buildable: False Executable run-handles hs-source-dirs: test/examples main-is: run-handles.hs if flag(build-examples) buildable: True build-depends: base >= 4.6 , shelly , text extensions: CPP else buildable: False Executable Color hs-source-dirs: test/examples main-is: color.hs if flag(build-examples) buildable: True build-depends: base >= 4.6 , process , shelly , text else buildable: False shelly-1.8.1/test/src/LogWithSpec.hs0000644000000000000000000000111413066031405015474 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module LogWithSpec ( logWithSpec ) where import TestInit import Prelude hiding (FilePath) 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.8.1/test/src/sleep.hs0000644000000000000000000000022313066031405014414 0ustar0000000000000000{-# Language OverloadedStrings #-} import Shelly main :: IO () main = shelly $ do echo "sleeping" run "sleep" ["5"] echo "all done" shelly-1.8.1/test/examples/test.sh0000644000000000000000000000002413066031405015311 0ustar0000000000000000#!/bin/bash echo hi shelly-1.8.1/test/examples/drain.sh0000755000000000000000000000006213066031405015434 0ustar0000000000000000#!/bin/sh echo "starting" sleep 2 echo "finished" shelly-1.8.1/test/examples/printer.sh0000755000000000000000000000007013066031405016021 0ustar0000000000000000#!/bin/sh while true; do echo "hello" sleep 1 done shelly-1.8.1/test/data/zshrc0000644000000000000000000027132313066031405014161 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.8.1/test/data/nonascii.txt0000644000000000000000000000004013066031405015433 0ustar0000000000000000Selbstverständlich überraschend shelly-1.8.1/test/data/symlinked_dir/hoge_file0000644000000000000000000000000013066034126017567 0ustar0000000000000000shelly-1.8.1/test/testall0000755000000000000000000000137013211426340013561 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 < 1.0` uses strict text. ## More shelly packages The [shelly-extra](http://hackage.haskell.org/package/shelly-extra) package has some additional functionality that requires additional dependencies, currently including a convenient concurrency/futures implementation. If you are following along the above article you need to install it. ## Examples * [A small deployment script](http://www.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](http://www.scholarslab.org/dh-developer/shell-programming-in-haskell-converting-s5-slides-to-pdf/) ### Testimonials * [a beginning Haskeller does automation](http://www.reddit.com/r/haskell/comments/w86gu/my_current_job_task_is_boring_so_i_wrote_a_simple/) ### Help * [google group for Haskell shell scripting](https://groups.google.com/forum/#!forum/haskell-shell-scripting) ## Alternatives ### Haskell shell scripting libraries * [HSH](http://hackage.haskell.org/package/HSH) - A good alternative if you want to mixup usage of String and ByteString rather than just use Text. * [HsShellScript](http://hackage.haskell.org/packages/archive/hsshellscript/3.1.0/doc/html/HsShellScript.html) - Has extensive low-level shell capabilities. * [shell-conduit](http://hackage.haskell.org/package/shell-conduit) - efficient streaming via conduits. Makes some portability sacrifices by * encouraging one to just use the shell instead of cross-platform Haskell code * encouraging one to use a convenience function that searches the PATH at compile-time * [shell-monad](http://hackage.haskell.org/package/shell-monad) - compile Haskell code down to shell script. This is a different approach from all the rest of the libraries. Writing your script is not as user-friendly as the other Haskell libraries, but it nicely solves the deployment issue. * [turtle](http://hackage.haskell.org/package/turtle) - In some sense a [redesign of Shelly designed for beginner-friendliness](http://www.reddit.com/r/haskell/comments/2u6b8m/use_haskell_for_shell_scripting/co5ucq9) HSH and HsShellScript (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](http://hackage.haskell.org/package/find-conduit) - uses conduits, similar speed to GNU find * [FileManip](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 is probably the best known. * [Haskell project](https://github.com/pkamenarsky/ytools) using typed JSON * [RecordStream](https://github.com/benbernard/RecordStream) 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 Data.Text as T default (T.Text) 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 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. -- 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 system-filepath means you may need to convert between Text and FilePath sometimes. This should be infrequent though because * `cmd` will convert FilePath to Text * The `` and `<.>` combinators convert String/Text into a FilePath automatically Manual conversion is done through `toTextIgnore` or `toTextWarn`. ### Thread-safe working directory and relative paths `cd` does not change the process working directory (essentially a global variable), but instead changes the shelly state (which is thread safe). 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 don't use the existing Shelly API, you can create a wrapper in the Sh monad that use `trace` or `tag` to log what they are doing. You can turn tracing off (not generally recommended) by setting `tracing False`. ## Future plans * Don't use the filepath library shelly-1.8.1/ChangeLog.md0000644000000000000000000000155213303634467013374 0ustar0000000000000000# 1.8.1 There is a new function `cp_should_follow_symlinks` to specify whether a copy should follow symlinks. # 1.8.0 * `cp_r` now uses upper case R: `cp -R` # 1.7.2 * Support exceptions-0.9 # 1.7.0.1 * Fix FindSpec.hs tests. Fixes [#150](https://github.com/yesodweb/Shelly.hs/issues/150), [#162](https://github.com/yesodweb/Shelly.hs/issues/162) # 1.6.8.7 * Relax unix-compat constraints # 1.6.8.6 * Fix Build issue [#156](https://github.com/yesodweb/Shelly.hs/issues/156) # 1.6.8.5 * Fix Windows build [#155](https://github.com/yesodweb/Shelly.hs/pull/155) # 1.6.8 * added sshPairsWithOptions function # 1.6.7 * flush stdout when using `echo`, not just `echo_n` * fix should be able to silence stderr when using `runHandle` * expose RunFailed # 1.6.6 * add prependToPath function # 1.6.5 * expose MonadShControl # 1.6.4.1 * add writeBinary function