diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,18 @@ # Revision history for shh +## 0.7.0.0 -- 2019-08-06 + +This is a fairly major refactor which consolidates a bunch of type classes +and simplifies a few things. + +* ExecArgs, Unit, PipeResult, PipeFailure are all gone and replaced + with Command and Shell type classes. +* Renamed various functions. + * catchFailure -> tryFailure + * catchCode -> exitCode +* Remove some unnecessary utf8 decoding. + + ## 0.6.0.0 -- 2019-06-26 This change doesn't remove any functions or majorly change any semantics, diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,9 +4,40 @@ [![](https://img.shields.io/hackage/v/shh-extras.svg?colorB=%23999&label=shh-extras)](http://hackage.haskell.org/package/shh-extras) [![](https://builds.sr.ht/~lukec/shh/nix.yml.svg)](https://builds.sr.ht/~lukec/shh/nix.yml?) +
Shh is a library to enable convinient shell-like programming in Haskell. It works well in scripts, and from GHCi, allowing you to use GHCi as a shell. + +```haskell +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ExtendedDefaultRules #-} +module Readme (test) where + +import Shh + +import Control.Concurrent.Async +import Prelude hiding (head) +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck +import qualified System.Directory +import qualified Data.ByteString.Lazy.Char8 as Char8 +import Data.List (nub) +import Data.Char + +load SearchPath ["echo", "base64", "cat", "head", "sleep", "mktemp", "ls", "wc", "find", "tr", "users", "sha256sum", "false", "true"] + +curl :: Cmd +curl = true + +test :: IO () +test = do +``` + +
+ It's primary purpose is in replacing shell scripts. As such, many functions are provided to mimic the shell environment, and porting shell scripts to shh should be fairly straightforward. A simple @@ -23,78 +54,93 @@ * Redirction of stdout and stderr - -- Redirect stdout - λ echo "Hello" &> StdErr - λ echo "Hello" &> Truncate ".tmp_file" - - -- Redirect stderr - λ echo "Hello" &!> Append "/dev/null" - λ echo "Hello" &!> StdOut + ```haskell + -- Redirect stdout + echo "Hello" &> StdErr + echo "Hello" &> Truncate ".tmp_file" + + -- Redirect stderr + echo "Hello" &!> Append "/dev/null" + echo "Hello" &!> StdOut + ``` * Piping stdout or stderr to the input of a chained process - - λ cat "/dev/urandom" |> xxd |> head "-n" 5 + + ```haskell + cat "/dev/urandom" |> base64 |> head "-n" 5 + ``` * Multiple processes sequentially feeding a single process - λ (echo 1 >> echo 2) |> cat + ```haskell + (echo 1 >> echo 2) |> cat + ``` * Use of Haskells concurrency primitives. - λ race (sleep 1) $ curl "http://this_needs_to_timeout_after_1_second" + ```haskell + race (sleep 1 >> echo "Slept for 1") (sleep 2 >> echo "Slept for 2") - λ d <- readTrim $ mktemp "-d" - λ :{ - | System.Directory.withCurrentDirectory d $ do - | mapConcurrently_ (curl "-LOJs") - | [ "https://raw.githubusercontent.com/luke-clifton/shh/master/shell.nix" - | , "https://raw.githubusercontent.com/luke-clifton/shh/master/shh.cabal" - | ] - | ls - | :} + ``` + ```haskell + mapConcurrently_ (\url -> curl "-Ls" url |> wc) + [ "https://raw.githubusercontent.com/luke-clifton/shh/master/shell.nix" + , "https://raw.githubusercontent.com/luke-clifton/shh/master/README.md" + ] + ``` + * Capturing of process output - λ s <- echo "Hello" |> tr "-d" "l" |> capture + ```haskell + s <- echo "Hello" |> tr "-d" "l" |> capture + print s - λ loggedIn <- nub . words <$> readProc users - λ putStrLn $ "Logged in users: " ++ show loggedIn + loggedIn <- nub . Char8.words <$> (users |> capture) + putStrLn $ "Logged in users: " ++ show loggedIn - λ mapM_ putStrLn =<< readSplit0 (Shh.Example.find "-maxdepth" 1 "-print0") + mapM_ Char8.putStrLn =<< (find "-maxdepth" 1 "-print0" |> captureEndBy0) + ``` * Capturing infinite output of a process lazily - λ withRead (cat "/dev/urandom" |> xxd) $ mapM_ putStrLn . take 3 . lines - 00000000: 8fcb ebee 9228 a897 3bfc 1d05 491d aceb .....(..;...I... - 00000010: 47de 3ea3 2788 44ac 9b85 0a0f a458 b949 G.>.'.D......X.I - 00000020: 5308 ddfe 5790 5a5f 39e3 bbb6 b689 2b03 S...W.Z_9.....+. + ```haskell + cat "/dev/urandom" + |> base64 + |> readInput (mapM_ Char8.putStrLn . take 3 . Char8.lines) + ``` * Write strings to stdin of a process. - λ writeProc cat "Hello\n" - Hello + ```haskell + writeOutput "Hello\n" |> cat + -- Hello - λ "Hello" >>> shasum - f7ff9e8b7bb2e09b70935a5d785e0cc5d9d0abf0 - + "Hello" >>> sha256sum - λ shasum <<< "Hello" - f7ff9e8b7bb2e09b70935a5d785e0cc5d9d0abf0 - + sha256sum <<< "Hello" + ``` * Proper exceptions, when a process exits with a failure code, an exception is thrown. You can catch these normally. The exception includes the error code, the command, and all it's arguments. - λ false "Ha, it died" - *** Exception: Command `false "Ha, it died"` failed [exit 1] - - λ catchCode false - 1 + ```haskell + false "Ha, it died" + -- *** Exception: Command `false "Ha, it died"` failed [exit 1] + ``` + ```haskell + exitCode false + -- 1 + ``` * "Native" processes, i.e. Haskell functions that behave like a process. - λ echo "Hello" |> pureProc (map toUpper) |> tr "-d" "L" - HEO + ```haskell + echo "Hello" |> pureProc (Char8.map toUpper) |> tr "-d" "L" + -- HEO + ``` * And much, much more! Look at the documentation on Hackage for a comprehensive overview of all the possibilities. diff --git a/app/shh-app.hs b/app/shh-app.hs --- a/app/shh-app.hs +++ b/app/shh-app.hs @@ -83,14 +83,14 @@ setOwnerWritable True $ emptyPermissions doIfMissing "init.ghci" $ do - catchFailure (exe (pack wrapper) "ghc-pkg" "latest" "shh") >>= \case + tryFailure (exe (pack wrapper) "ghc-pkg" "latest" "shh") >>= \case Left _ -> do putStrLn "Please make the shh and shh-extras packages available in the shh" putStrLn "environment (install it globally or modify the wrapper, see docs)." putStrLn "Aborting" exitFailure Right _ -> writeFile "init.ghci" defaultInitGhci - catchFailure (exe (pack wrapper) "ghc-pkg" "latest" "shh-extras") >>= \case + tryFailure (exe (pack wrapper) "ghc-pkg" "latest" "shh-extras") >>= \case Left _ -> do putStrLn "## WARNING ##########################################################" putStrLn "# You do not have the shh-extras library installed, and so we are" diff --git a/shh.cabal b/shh.cabal --- a/shh.cabal +++ b/shh.cabal @@ -1,5 +1,5 @@ name: shh -version: 0.6.0.0 +version: 0.7.0.0 synopsis: Simple shell scripting from Haskell description: Provides a shell scripting environment for Haskell. It helps you use external binaries, and allows you to @@ -32,6 +32,7 @@ mtl >= 2.2.2 && < 2.3, process >= 1.6.3 && < 1.7, split >= 0.2.3 && < 0.3, + stringsearch >= 0.3.6.6 && < 0.4, template-haskell >= 2.13.0 && < 2.15, containers >= 0.5.11 && < 0.7, unix >= 2.7.2 && < 2.8, @@ -66,14 +67,16 @@ test-suite shh-tests - ghc-options: -threaded -with-rtsopts=-N + ghc-options: -threaded -with-rtsopts=-N -pgmL markdown-unlit default-language: Haskell2010 build-depends: + markdown-unlit, base >=4.9, async, bytestring, directory, doctest, + filepath, tasty, tasty-quickcheck, tasty-hunit, @@ -81,4 +84,5 @@ utf8-string hs-source-dirs: test main-is: Test.hs + other-modules: Readme type: exitcode-stdio-1.0 diff --git a/src/Shh.hs b/src/Shh.hs --- a/src/Shh.hs +++ b/src/Shh.hs @@ -3,7 +3,11 @@ -- | Shh provides a shell-like environment for Haskell. module Shh ( initInteractive + -- | == Running a `Proc` + , Shell(..) -- | == Constructing a `Proc` + -- You usually don't need to @`runProc`@ because most functions in shh + -- are polymorphic in their return type. -- | === External Processes -- These allow for the construction of @`Proc`@s that call external -- processes. You will often use the TemplateHaskell functions below @@ -11,80 +15,71 @@ , exe , mkProc , mkProc' - , runProc , Proc() - -- | === "Native" Processes + -- | === "Native" Processes (Lazy) -- You can also create native Haskell @`Proc`@s which behave the same -- way, but simply run Haskell functions instead of external processes. -- - -- NB: The functions here that operate on @String@s from @stdin@ read them - -- lazily, and can be used in a streaming fashion. + -- NB: The functions here that operate on lazy @`ByteString`@s read from + -- @stdin@, and can be used in a streaming fashion. + -- These reads are lazy. The process is run long enough to produce + -- the amount of output that is actually used. It is therefor suitable + -- for use with infinite output streams. The feeding process has it's + -- @stdout@ closed as soon the function finishes. Note that the result + -- is forced to normal form to prevent any accidental reading after + -- the process has terminated. , pureProc , writeOutput, writeError , prefixLines - , capture - , captureTrim - , captureSplit - , captureSplit0 - , captureLines , readInput - , readInputSplit - , readInputSplit0 + , readInputEndBy + , readInputEndBy0 , readInputLines , readInputP - , readInputSplitP - , readInputSplit0P + , readInputEndByP + , readInputEndBy0P , readInputLinesP , xargs1 + -- | === Extracting output to Haskell (Strict) + -- These functions are trivially implemented in terms of the above. Note + -- that they are strict. + , capture + , captureTrim + , captureEndBy + , captureEndBy0 + , captureLines -- | == Piping and Redirection - , PipeResult(..) + , (|>) + , (|!>) + , (&>) + , (&!>) , (<|) , Stream(..) , devNull - -- | === Lazy/Streaming reads - -- These reads are lazy. The process is run long enough to produce - -- the amount of output that is actually used. It is therefor suitable - -- for use with infinite output streams. The process is terminated - -- as soon the function finishes. Note that the result is forced to - -- normal form to prevent any accidental reading after the process has - -- terminated. - -- - -- NB: See `readInput` and `pureProc` for more flexible options to those - -- listed here. - , withRead - , withReadSplit0 - , withReadLines - , withReadWords - -- | === Strict reads - -- NB: See also `capture` - , readProc - , readTrim - , readSplit0 - , readLines - , readWords - , readAuto -- | === Writing to @stdin@ - -- NB: See also `writeOutput` for an `echo`-like option. + -- NB: See also `writeOutput` for an `echo`-like option. These are all + -- implemented in terms of `writeOutput`. , (<<<), (>>>), writeProc - , readWriteProc , apply -- | === String manipulation -- Utility functions for dealing with common string issues in shell -- scripting. , trim - , split0 + , endBy + , endBy0 -- | == Exceptions -- If any exception is allowed to propagate out of a pipeline, all the -- processes comprising the pipeline will be terminated. This is contrary -- to how a shell normally works (even with @-o pipefail@!). , Failure(..) , ignoreFailure - , catchFailure - , catchCode + , tryFailure + , exitCode -- | == Constructing Arguments + , Cmd , ExecArg(..) - , ExecArgs() - , Unit() + , Command() + , displayCommand -- | == Template Haskell helpers , encodeIdentifier , ExecReference(..) diff --git a/src/Shh/Internal.hs b/src/Shh/Internal.hs --- a/src/Shh/Internal.hs +++ b/src/Shh/Internal.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE KindSignatures #-} @@ -17,20 +18,22 @@ import Prelude hiding (lines, unlines) -import Control.Concurrent.MVar import Control.Concurrent.Async +import Control.Concurrent.MVar import Control.DeepSeq (force,NFData) import Control.Exception as C import Control.Monad import Control.Monad.IO.Class -import Data.ByteString.Lazy (ByteString, hGetContents) +import qualified Data.ByteString as ByteString +import Data.ByteString.Lazy (ByteString, hGetContents, toStrict) import qualified Data.ByteString.Lazy as BS import Data.ByteString.Lazy.Builder.ASCII -import Data.ByteString.Lazy.UTF8 (toString, fromString, lines) import qualified Data.ByteString.Lazy.Char8 as BC8 +import qualified Data.ByteString.Lazy.Search as Search +import Data.ByteString.Lazy.UTF8 (fromString, toString) import Data.Char (isLower, isSpace, isAlphaNum, ord) -import Data.List (dropWhileEnd, intercalate) -import Data.List.Split (endBy, splitOn) +import Data.List (intercalate) +import qualified Data.List.Split as Split import qualified Data.Map as Map import Data.Maybe (isJust) import Data.Typeable @@ -42,6 +45,7 @@ import GHC.IO.Handle.Internals import GHC.IO.Handle.Types import GHC.IO.Handle.Types (Handle(..)) +import GHC.Stack import Language.Haskell.TH import qualified System.Directory as Dir import System.Environment (getEnv, setEnv) @@ -57,6 +61,7 @@ -- For doc-tests. Not sure I can use TH in doc tests. -- >>> :seti -XOverloadedStrings -- >>> import Data.Monoid +-- >>> import Data.ByteString.Lazy.Char8 (lines) -- >>> let cat = exe "cat" -- >>> let echo = exe "echo" -- >>> let false = exe "false" @@ -83,10 +88,11 @@ -- The only exception to this is when a process is terminated -- by @SIGPIPE@ in a pipeline, in which case we ignore it. data Failure = Failure - { failureProg :: ByteString - , failureArgs :: [ByteString] - , failureCode :: Int - } deriving (Eq, Ord) + { failureProg :: ByteString + , failureArgs :: [ByteString] + , failureStack :: CallStack + , failureCode :: Int + } instance Show Failure where show f = concat $ @@ -96,7 +102,8 @@ ++ [ "` failed [exit " , show (failureCode f) - , "]" + , "] at " + , prettyCallStack (failureStack f) ] instance Exception Failure @@ -104,72 +111,139 @@ -- | This class is used to allow most of the operators in Shh to be -- polymorphic in their return value. This makes using them in an `IO` context -- easier (we can avoid having to prepend everything with a `runProc`). -class PipeResult f where - -- | Use this to send the output of on process into the input of another. - -- This is just like a shells `|` operator. - -- - -- The result is polymorphic in its output, and can result in either - -- another `Proc a` or an `IO a` depending on the context in which it is - -- used. - -- - -- If any intermediate process throws an exception, the whole pipeline - -- is canceled. - -- - -- The result of the last process in the chain is the result returned - -- by the pipeline. - -- - -- >>> echo "Hello" |> wc - -- 1 1 6 - (|>) :: Proc b -> Proc a -> f a - infixl 1 |> +class Shell f where + runProc :: Proc a -> f a - -- | Similar to `|!>` except that it connects stderr to stdin of the - -- next process in the chain. - -- - -- NB: The next command to be `|>` on will recapture the stdout of - -- both preceding processes, because they are both going to the same - -- handle! - -- - -- See the `&>` and `&!>` operators for redirection. - -- - -- >>> echo "Ignored" |!> wc "-c" - -- Ignored - -- 0 - (|!>) :: Proc b -> Proc a -> f a - infixl 1 |!> +-- | Helper function that creates and potentially executes a @`Proc`@ +buildProc :: Shell f => (Handle -> Handle -> Handle -> IO () -> IO () -> IO a) -> f a +buildProc = runProc . Proc - -- | Redirect stdout of this process to another location - -- - -- >>> echo "Ignore me" &> Append "/dev/null" - (&>) :: Proc a -> Stream -> f a - infixl 9 &> +-- | Like @`|>`@ except that it keeps both return results. Be aware +-- that the @fst@ element of this tuple may be hiding a @SIGPIPE@ +-- exception that will explode on you once you look at it. +-- +-- You probably want to use @`|>`@ unless you know you don't. +pipe :: Shell f => Proc a -> Proc b -> f (a, b) +pipe (Proc a) (Proc b) = buildProc $ \i o e pl pw -> + withPipe $ \r w -> do + let + a' = a i w e (pure ()) (hClose w) + b' = b r o e (pure ()) (hClose r) + (pl >> concurrently a' b') `finally` pw - -- | Redirect stderr of this process to another location - -- - -- >>> echo "Shh" &!> StdOut - -- Shh - (&!>) :: Proc a -> Stream -> f a - infixl 9 &!> - -- | Lift a Haskell function into a @`Proc`@. The handles are the @stdin@ - -- @stdout@ and @stderr@ of the resulting @`Proc`@ - nativeProc :: NFData a => (Handle -> Handle -> Handle -> IO a) -> f a +-- | Like @`pipe`@, but plumbs stderr. See the warning in @`pipe`@. +pipeErr :: Shell f => Proc a -> Proc b -> f (a, b) +pipeErr (Proc a) (Proc b) = buildProc $ \i o e pl pw -> do + withPipe $ \r w -> do + let + a' = a i o w (pure ()) (hClose w) + b' = b r o e (pure ()) (hClose r) + (pl >> concurrently a' b') `finally` pw + +-- | Use this to send the output of on process into the input of another. +-- This is just like a shells `|` operator. +-- +-- The result is polymorphic in its output, and can result in either +-- another `Proc a` or an `IO a` depending on the context in which it is +-- used. +-- +-- If any intermediate process throws an exception, the whole pipeline +-- is canceled. +-- +-- The result of the last process in the chain is the result returned +-- by the pipeline. +-- +-- >>> echo "Hello" |> wc +-- 1 1 6 +(|>) :: Shell f => Proc a -> Proc b -> f b +a |> b = runProc $ do + v <- fmap snd (a `pipe` b) + pure $! v +infixl 1 |> + + +-- | Similar to `|!>` except that it connects stderr to stdin of the +-- next process in the chain. +-- +-- NB: The next command to be `|>` on will recapture the stdout of +-- both preceding processes, because they are both going to the same +-- handle! +-- +-- See the `&>` and `&!>` operators for redirection. +-- +-- >>> echo "Ignored" |!> wc "-c" +-- Ignored +-- 0 +(|!>) :: Shell f => Proc a -> Proc b -> f b +a |!> b = runProc $ do + v <- fmap snd (a `pipeErr` b) + pure $! v +infixl 1 |!> + +-- +-- | Redirect stdout of this process to another location +-- +-- >>> echo "Ignore me" &> Append "/dev/null" +(&>) :: Shell f => Proc a -> Stream -> f a +p &> StdOut = runProc p +(Proc f) &> StdErr = buildProc $ \i _ e pl pw -> f i e e pl pw +(Proc f) &> (Truncate path) = buildProc $ \i _ e pl pw -> + withBinaryFile (BC8.unpack path) WriteMode $ \h -> f i h e pl pw +(Proc f) &> (Append path) = buildProc $ \i _ e pl pw -> + withBinaryFile (BC8.unpack path) AppendMode $ \h -> f i h e pl pw +infixl 9 &> + +-- | Redirect stderr of this process to another location +-- +-- >>> echo "Shh" &!> StdOut +-- Shh +(&!>) :: Shell f => Proc a -> Stream -> f a +p &!> StdErr = runProc $ p +(Proc f) &!> StdOut = buildProc $ \i o _ pl pw -> f i o o pl pw +(Proc f) &!> (Truncate path) = buildProc $ \i o _ pl pw -> + withBinaryFile (BC8.unpack path) WriteMode $ \h -> f i o h pl pw +(Proc f) &!> (Append path) = buildProc $ \i o _ pl pw -> + withBinaryFile (BC8.unpack path) AppendMode $ \h -> f i o h pl pw +infixl 9 &!> + +-- | Lift a Haskell function into a @`Proc`@. The handles are the @stdin@ +-- @stdout@ and @stderr@ of the resulting @`Proc`@ +nativeProc :: (Shell f, NFData a) => (Handle -> Handle -> Handle -> IO a) -> f a +nativeProc f = runProc $ Proc $ \i o e pl pw -> handle handler $ do + pl + -- We duplicate these so that you can't accidentally close the + -- real ones. + withDuplicates i o e $ \i' o' e' -> do + (f i' o' e' >>= C.evaluate . force) + `finally` (hClose i') + `finally` (hClose o') + `finally` (hClose e') + `finally` pw + + where + -- The resource vanished error only occurs when upstream pipe closes. + -- This can only happen with the `|>` combinator, which will discard + -- the result of this `Proc` anyway. If the return value is somehow + -- inspected, or maybe if the exception is somehow legitimate, we + -- simply package it up as an exploding return value. `runProc` will + -- make sure to evaluate all `Proc`'s to WHNF in order to uncover it. + -- This should never happen. *nervous* + handler :: IOError -> IO a + handler e + | ioeGetErrorType e == ResourceVanished = pure (throw e) + | otherwise = throwIO e + + -- | Flipped version of `|>` with lower precedence. -- -- >>> captureTrim <| (echo "Hello" |> wc "-c") -- "6" -(<|) :: PipeResult f => Proc a -> Proc b -> f a +(<|) :: Shell f => Proc a -> Proc b -> f a (<|) = flip (|>) infixr 1 <| -instance PipeResult IO where - a |> b = runProc $ a |> b - a |!> b = runProc $ a |!> b - a &> s = runProc $ a &> s - a &!> s = runProc $ a &!> s - nativeProc f = runProc $ nativeProc f - -- | Create a pipe, and close both ends on exception. The first argument -- is the read end, the second is the write end. -- @@ -182,61 +256,6 @@ (\(r,w) -> hClose r `finally` hClose w) (\(r,w) -> k r w) -instance PipeResult Proc where - (Proc a) |> (Proc b) = Proc $ \i o e pl pw -> - withPipe $ \r w -> do - let - a' = a i w e (pure ()) (hClose w) - b' = b r o e (pure ()) (hClose r) - (_, br) <- (pl >> concurrently a' b') `finally` pw - pure br - - (Proc a) |!> (Proc b) = Proc $ \i o e pl pw -> do - withPipe $ \r w -> do - let - a' = a i o w (pure ()) (hClose w) - b' = b r o e (pure ()) (hClose r) - (_, br) <- (pl >> concurrently a' b') `finally` pw - pure br - - p &> StdOut = p - (Proc f) &> StdErr = Proc $ \i _ e pl pw -> f i e e pl pw - (Proc f) &> (Truncate path) = Proc $ \i _ e pl pw -> - withBinaryFile (BC8.unpack path) WriteMode $ \h -> f i h e pl pw - (Proc f) &> (Append path) = Proc $ \i _ e pl pw -> - withBinaryFile (BC8.unpack path) AppendMode $ \h -> f i h e pl pw - - p &!> StdErr = p - (Proc f) &!> StdOut = Proc $ \i o _ pl pw -> f i o o pl pw - (Proc f) &!> (Truncate path) = Proc $ \i o _ pl pw -> - withBinaryFile (BC8.unpack path) WriteMode $ \h -> f i o h pl pw - (Proc f) &!> (Append path) = Proc $ \i o _ pl pw -> - withBinaryFile (BC8.unpack path) AppendMode $ \h -> f i o h pl pw - - nativeProc f = Proc $ \i o e pl pw -> handle handler $ do - pl - -- We duplicate these so that you can't accidentally close the - -- real ones. - withDuplicates i o e $ \i' o' e' -> do - (f i' o' e' >>= C.evaluate . force) - `finally` (hClose i') - `finally` (hClose o') - `finally` (hClose e') - `finally` pw - - where - -- The resource vanished error only occurs when upstream pipe closes. - -- This can only happen with the `|>` combinator, which will discard - -- the result of this `Proc` anyway. If the return value is somehow - -- inspected, or maybe if the exception is somehow legitimate, we - -- simply package it up as an exploding return value. `runProc` will - -- make sure to evaluate all `Proc`'s to WHNF in order to uncover it. - -- This should never happen. *nervous* - handler :: IOError -> IO a - handler e - | ioeGetErrorType e == ResourceVanished = pure (throw e) - | otherwise = throwIO e - -- | Simple @`Proc`@ that writes its argument to its @stdout@. This behaves -- very much like the standard @printf@ utility, except that there is no -- restriction as to what can be in the argument. @@ -248,7 +267,7 @@ -- -- >>> writeOutput "Hello" -- Hello -writeOutput :: (ExecArg a, PipeResult io) => a -> io () +writeOutput :: (ExecArg a, Shell io) => a -> io () writeOutput s = nativeProc $ \_ o _ -> do mapM_ (BS.hPutStr o) (asArg s) @@ -257,7 +276,7 @@ -- -- >>> writeError "Hello" &> devNull -- Hello -writeError :: (ExecArg a, PipeResult io) => a -> io () +writeError :: (ExecArg a, Shell io) => a -> io () writeError s = nativeProc $ \_ _ e -> do mapM_ (BS.hPutStr e) (asArg s) @@ -269,7 +288,7 @@ -- -- >>> yes |> readInput (pure . unlines . take 3 . lines) -- "y\ny\ny\n" -readInput :: (NFData a, PipeResult io) => (ByteString -> IO a) -> io a +readInput :: (NFData a, Shell io) => (ByteString -> IO a) -> io a readInput f = nativeProc $ \i _ _ -> do hGetContents i >>= f @@ -278,33 +297,33 @@ unlines :: [ByteString] -> ByteString unlines = toLazyByteString . mconcat . map (\l -> lazyByteString l <> char7 '\n') --- | Like @`readInput`@, but @`split`@s the string. +-- | Like @`readInput`@, but @`endBy`@s the string. -- --- >>> yes |> readInputSplit "\n" (pure . take 3) +-- >>> yes |> readInputEndBy "\n" (pure . take 3) -- ["y","y","y"] -readInputSplit :: (NFData a, PipeResult io) => ByteString -> ([ByteString] -> IO a) -> io a -readInputSplit s f = readInput (f . split s) +readInputEndBy :: (NFData a, Shell io) => ByteString -> ([ByteString] -> IO a) -> io a +readInputEndBy s f = readInput (f . endBy s) --- | Like @`readInput`@, but @`split`@s the string on the 0 byte. +-- | Like @`readInput`@, but @`endBy`@s the string on the 0 byte. -- --- >>> writeOutput "1\0\&2\0" |> readInputSplit0 pure +-- >>> writeOutput "1\0\&2\0" |> readInputEndBy0 pure -- ["1","2"] -readInputSplit0 :: (NFData a, PipeResult io) => ([ByteString] -> IO a) -> io a -readInputSplit0 = readInputSplit "\0" +readInputEndBy0 :: (NFData a, Shell io) => ([ByteString] -> IO a) -> io a +readInputEndBy0 = readInputEndBy "\0" --- | Like @`readInput`@, but @`split`@s the string on new lines. +-- | Like @`readInput`@, but @`endBy`@s the string on new lines. -- -- >>> writeOutput "a\nb\n" |> readInputLines pure -- ["a","b"] -readInputLines :: (NFData a, PipeResult io) => ([ByteString] -> IO a) -> io a -readInputLines = readInputSplit "\n" +readInputLines :: (NFData a, Shell io) => ([ByteString] -> IO a) -> io a +readInputLines = readInputEndBy "\n" -- | Creates a pure @`Proc`@ that simple transforms the @stdin@ and writes -- it to @stdout@. The input can be infinite. -- -- >>> yes |> pureProc (BS.take 4) |> capture -- "y\ny\n" -pureProc :: PipeResult io => (ByteString -> ByteString) -> io () +pureProc :: Shell io => (ByteString -> ByteString) -> io () pureProc f = nativeProc $ \i o _ -> do s <- hGetContents i BS.hPutStr o (f s) @@ -315,14 +334,14 @@ -- >>> some_command |> prefixLines "stdout: " |!> prefixLines "stderr: " &> StdErr -- stdout: this is stdout -- stderr: this is stderr -prefixLines :: PipeResult io => ByteString -> io () +prefixLines :: Shell io => ByteString -> io () prefixLines s = pureProc $ \inp -> toLazyByteString $ - mconcat $ map (\l -> lazyByteString s <> lazyByteString l <> char7 '\n') (lines inp) + mconcat $ map (\l -> lazyByteString s <> lazyByteString l <> char7 '\n') (BC8.lines inp) -- | Provide the stdin of a `Proc` from a `ByteString` -- -- Same as @`writeOutput` s |> p@ -writeProc :: PipeResult io => Proc a -> ByteString -> io a +writeProc :: Shell io => Proc a -> ByteString -> io a writeProc p s = writeOutput s |> p -- | Run a process and capture its output lazily. Once the continuation @@ -332,7 +351,7 @@ -- terminate if you close the handle). -- -- Same as @p |> readInput f@ -withRead :: (PipeResult f, NFData b) => Proc a -> (ByteString -> IO b) -> f b +withRead :: (Shell f, NFData b) => Proc a -> (ByteString -> IO b) -> f b withRead p f = p |> readInput f -- | Type used to represent destinations for redirects. @`Truncate` file@ @@ -354,7 +373,7 @@ deriving Functor instance MonadIO Proc where - liftIO a = Proc $ \_ _ _ pl pw -> do + liftIO a = buildProc $ \_ _ _ pl pw -> do (pl >> a) `finally` pw -- | The `Semigroup` instance for `Proc` pipes the stdout of one process @@ -366,10 +385,10 @@ (<>) = (|>) instance (a ~ ()) => Monoid (Proc a) where - mempty = Proc $ \_ _ _ pl pw -> pl `finally` pw + mempty = buildProc $ \_ _ _ pl pw -> pl `finally` pw instance Applicative Proc where - pure a = Proc $ \_ _ _ pw pl -> do + pure a = buildProc $ \_ _ _ pw pl -> do pw `finally` pl pure a @@ -379,18 +398,18 @@ pure (f' a') instance Monad Proc where - (Proc a) >>= f = Proc $ \i o e pl pw -> do + (Proc a) >>= f = buildProc $ \i o e pl pw -> do ar <- a i o e pl (pure ()) let Proc f' = f ar f' i o e (pure ()) pw --- | Run's a `Proc` in `IO`. This is usually not required, as most --- commands in Shh are polymorphic in their return type, and work --- just fine in `IO` directly. -runProc :: Proc a -> IO a -runProc = runProc' stdin stdout stderr +instance Shell IO where + runProc = runProc' stdin stdout stderr +instance Shell Proc where + runProc = id + -- | Run's a `Proc` in `IO`. Like `runProc`, but you get to choose the handles. -- This is UNSAFE to expose externally, because there are restrictions on what -- the Handle can be. Within shh, we never call `runProc'` with invalid handles, @@ -408,12 +427,12 @@ -- | Create a `Proc` from a command and a list of arguments. -- The boolean represents whether we should delegate control-c -- or not. Most uses of @`mkProc'`@ in Shh do not delegate control-c. -mkProc' :: Bool -> ByteString -> [ByteString] -> Proc () +mkProc' :: HasCallStack => Bool -> ByteString -> [ByteString] -> Proc () mkProc' delegate cmd args = Proc $ \i o e pl pw -> do let cmd' = BC8.unpack cmd args' = BC8.unpack <$> args - bracket + (bracket (createProcess_ cmd' (proc cmd' args') { std_in = UseHandle i , std_out = UseHandle o @@ -425,27 +444,23 @@ (\(_,_,_,ph) -> terminateProcess ph) $ \(_,_,_,ph) -> do pl - (waitProc cmd args ph `onException` terminateProcess ph) `finally` pw + (waitProc cmd args ph `onException` terminateProcess ph) + ) `finally` pw -- | Create a `Proc` from a command and a list of arguments. Does not delegate -- control-c handling. -mkProc :: ByteString -> [ByteString] -> Proc () +mkProc :: HasCallStack => ByteString -> [ByteString] -> Proc () mkProc = mkProc' False --- | Read the stdout of a `Proc`. This captures stdout, so further piping will --- not see anything on the input. --- --- This is strict, so the whole output is read into a `ByteString`. See `withRead` --- for a lazy version that can be used for streaming. -readProc :: PipeResult io => Proc a -> io ByteString -readProc p = withRead p pure - -- | A special `Proc` which captures its stdin and presents it as a `ByteString` -- to Haskell. -- -- >>> printf "Hello" |> md5sum |> capture -- "8b1a9953c4611296a827abf8c47804d7 -\n" -capture :: PipeResult io => io ByteString +-- +-- This is just @`readInput` pure@. Note that it is not lazy, and will read +-- the entire @ByteString@ into memory. +capture :: Shell io => io ByteString capture = readInput pure -- | Like @'capture'@, except that it @'trim'@s leading and trailing white @@ -453,115 +468,105 @@ -- -- >>> printf "Hello" |> md5sum |> captureTrim -- "8b1a9953c4611296a827abf8c47804d7 -" -captureTrim :: PipeResult io => io ByteString +captureTrim :: Shell io => io ByteString captureTrim = readInput (pure . trim) -- | Like @'capture'@, but splits the input using the provided separator. -- -- NB: This is strict. If you want a streaming version, use `readInput` -captureSplit :: PipeResult io => ByteString -> io [ByteString] -captureSplit s = readInput (pure . fmap fromString . endBy (toString s) . toString) +captureEndBy :: Shell io => ByteString -> io [ByteString] +captureEndBy s = readInput (pure . endBy s) --- | Same as @'captureSplit' "\0"@. -captureSplit0 :: PipeResult io => io [ByteString] -captureSplit0 = captureSplit "\0" +-- | Same as @'captureEndBy' "\0"@. +captureEndBy0 :: Shell io => io [ByteString] +captureEndBy0 = captureEndBy "\0" -- | Same as @'captureSplit' "\n"@. -captureLines :: PipeResult io => io [ByteString] -captureLines = captureSplit "\n" - --- | Apply a transformation function to the string before the IO action. -withRead' :: (NFData b, PipeResult io) => (ByteString -> a) -> Proc x -> (a -> IO b) -> io b -withRead' f p io = withRead p (io . f) - --- | Like @'withRead'@ except it splits the string with the provided separator. -withReadSplit :: (NFData b, PipeResult io) => ByteString -> Proc a -> ([ByteString] -> IO b) -> io b -withReadSplit = withRead' . split - --- | Like @'withRead'@ except it splits the string with @'split0'@ first. -withReadSplit0 :: (NFData b, PipeResult io) => Proc a -> ([ByteString] -> IO b) -> io b -withReadSplit0 = withRead' split0 - --- | Like @'withRead'@ except it splits the string with @'lines'@ first. --- --- NB: Please consider using @'withReadSplit0'@ where you can. -withReadLines :: (NFData b, PipeResult io) => Proc a -> ([ByteString] -> IO b) -> io b -withReadLines = withRead' lines +captureLines :: Shell io => io [ByteString] +captureLines = captureEndBy "\n" --- | Like @'withRead'@ except it splits the string with @'words'@ first. -withReadWords :: (NFData b, PipeResult io) => Proc a -> ([ByteString] -> IO b) -> io b -withReadWords = withRead' (map fromString . words . toString) +-- | Capture the words of the output. +captureWords :: Shell io => io [ByteString] +captureWords = readInput (pure . BC8.words) --- | Read and write to a `Proc`. Same as --- @readProc proc <<< input@ -readWriteProc :: MonadIO io => Proc a -> ByteString -> io ByteString -readWriteProc p input = liftIO $ readProc p <<< input +-- | Capture the output of the process and attempt to `read` it. +captureRead :: (Shell io, Read a, NFData a) => io a +captureRead = readInput (pure . read . toString) --- | Some as `readWriteProc`. Apply a `Proc` to a `ByteString`. +-- | Apply a `Proc` to a `ByteString`. That is, feed the bytestring to +-- the @stdin@ of the process and read the @stdout@. -- -- >> apply md5sum "Hello" -- "8b1a9953c4611296a827abf8c47804d7 -\n" -apply :: MonadIO io => Proc a -> ByteString -> io ByteString -apply = readWriteProc +apply :: (ExecArg a, Shell io) => Proc v -> a -> io ByteString +apply p b = writeOutput b |> p |> capture -- | Flipped, infix version of `writeProc` -(>>>) :: PipeResult io => ByteString -> Proc a -> io a +(>>>) :: Shell io => ByteString -> Proc a -> io a (>>>) = flip writeProc -- | Infix version of `writeProc` -(<<<) :: PipeResult io => Proc a -> ByteString -> io a +(<<<) :: Shell io => Proc a -> ByteString -> io a (<<<) = writeProc -- | Wait on a given `ProcessHandle`, and throw an exception of -- type `Failure` if its exit code is non-zero (ignoring SIGPIPE) -waitProc :: ByteString -> [ByteString] -> ProcessHandle -> IO () +waitProc :: HasCallStack => ByteString -> [ByteString] -> ProcessHandle -> IO () waitProc cmd arg ph = waitForProcess ph >>= \case ExitFailure c | fromIntegral c == negate sigPIPE -> pure () - | otherwise -> throwIO $ Failure cmd arg c + | otherwise -> throwIO $ Failure cmd arg callStack c ExitSuccess -> pure () + +-- | Drop trailing characters from a @ByteString@ while the given predicate +-- matches. +-- +-- >>> dropWhileEnd isSpace "a line \n" +-- "a line" +dropWhileEnd :: (Char -> Bool) -> ByteString -> ByteString +dropWhileEnd p b = case BC8.unsnoc b of + Just (i, l) -> if p l then dropWhileEnd p i else b + Nothing -> b + -- | Trim leading and tailing whitespace. +-- +-- >>> trim " a string \n" +-- "a string" trim :: ByteString -> ByteString -trim = fromString . dropWhileEnd isSpace . dropWhile isSpace . toString +trim = dropWhileEnd isSpace . BC8.dropWhile isSpace --- | Allow us to catch `Failure` exceptions in `IO` and `Proc` -class ProcFailure m where - -- | Run a `Proc` action, catching an `Failure` exceptions - -- and returning them. - catchFailure :: Proc a -> m (Either Failure a) +-- | Run a `Proc` action, catching any `Failure` exceptions +-- and returning them. +tryFailure :: Shell m => Proc a -> m (Either Failure a) +tryFailure (Proc f) = buildProc $ \i o e pl pw -> do + try $ f i o e pl pw -instance ProcFailure Proc where - catchFailure (Proc f) = Proc $ \i o e pl pw -> do - try $ f i o e pl pw -instance ProcFailure IO where - catchFailure = runProc . catchFailure - -- | Run a `Proc` action, ignoring any `Failure` exceptions. -- This can be used to prevent a process from interrupting a whole pipeline. -- --- >>> false |> (sleep 2 >> echo 1) --- *** Exception: Command `false` failed [exit 1] +-- >>> false |> (sleep "0.1" >> echo 1) +-- *** Exception: Command `false` failed [exit 1] at CallStack (from HasCallStack): +-- ... -- --- >>> (ignoreFailure false) |> (sleep 2 >> echo 1) +-- >>> (ignoreFailure false) |> (sleep "0.1" >> echo 1) -- 1 -ignoreFailure :: (Functor m, ProcFailure m) => Proc a -> m () -ignoreFailure = void . catchFailure +ignoreFailure :: (Functor m, Shell m) => Proc a -> m () +ignoreFailure = void . tryFailure --- | Run an `Proc` action returning the return code if an --- exception was thrown, and 0 if it wasn't. -catchCode :: (Functor m, ProcFailure m) => Proc a -> m Int -catchCode = fmap getCode . catchFailure +-- | Run a `Proc` action returning the exit code of the process instead of +-- throwing an exception. +-- +-- >>> exitCode false +-- 1 +exitCode :: (Functor m, Shell m) => Proc a -> m Int +exitCode = fmap getCode . tryFailure where getCode (Right _) = 0 getCode (Left f) = failureCode f --- | Like `readProc`, but trim leading and tailing whitespace. -readTrim :: (Functor io, PipeResult io) => Proc a -> io ByteString -readTrim = fmap trim . readProc - -- | A class for things that can be converted to arguments on the command -- line. The default implementation is to use `show`. class ExecArg a where @@ -587,30 +592,46 @@ instance ExecArg ByteString where asArg s = [s] +instance ExecArg ByteString.ByteString where + asArg s = [BS.fromStrict s] + instance ExecArg Int instance ExecArg Integer instance ExecArg Word --- | A class for building up a command -class ExecArgs a where - toArgs :: [ByteString] -> a +-- | A class for building up a command. +class Command a where + toArgs :: HasCallStack => [ByteString] -> a -instance ExecArgs (Proc ()) where +instance (a ~ ()) => Command (Proc a) where toArgs (cmd:args) = mkProc cmd args toArgs _ = error "The impossible happened. How did you construct this?" -instance (ExecArg b, ExecArgs a) => ExecArgs (b -> a) where +instance (ExecArg b, Command a) => Command (b -> a) where toArgs f i = toArgs $ f ++ asArg i -- | Commands can be executed directly in IO -instance ExecArgs (IO ()) where +instance (a ~ ()) => Command (IO a) where toArgs = runProc . toArgs --- | Force a `()` result. -class Unit a -instance {-# OVERLAPPING #-} Unit b => Unit (a -> b) -instance {-# OVERLAPPABLE #-} a ~ () => Unit (m a) +instance Command [ByteString] where + toArgs = id +instance Command [ByteString.ByteString] where + toArgs = map toStrict + +-- | This type represents a partially built command. Further arguments +-- can be supplied to it, or it can be turned into a `Proc` or directly +-- executed in a context which supports that (such as `IO`). +type Cmd = HasCallStack => forall a. (Command a) => a + +-- | This function turns a `Cmd` into a list of @`ByteString`@s. +-- +-- >>> displayCommand $ echo "Hello, world!" +-- ["echo","Hello, world!"] +displayCommand :: Cmd -> [ByteString] +displayCommand = toArgs + -- | Get all executables on your `$PATH`. pathBins :: IO [FilePath] pathBins = map takeFileName <$> pathBinsAbs @@ -620,7 +641,7 @@ -- the whole path. First one found wins. pathBinsAbs :: IO [FilePath] pathBinsAbs = do - pathsVar <- splitOn ":" <$> getEnv "PATH" + pathsVar <- Split.splitOn ":" <$> getEnv "PATH" paths <- filterM Dir.doesDirectoryExist pathsVar findBinsIn paths @@ -646,8 +667,15 @@ -- > exe "ls" "-l" -- -- See also `loadExe` and `loadEnv`. -exe :: (Unit a, ExecArgs a, ExecArg str) => str -> a -exe s = toArgs (asArg s) +-- +-- NB: It is recommended that you use the template haskell functions to load +-- executables from your path. If you do it manually, it is recommended to +-- use @withFrozenCallStack@ from @GHC.Stack@ +-- +-- > echo :: Cmd +-- > echo = withFrozenCallStack (exe "echo") +exe :: (Command a, ExecArg str, HasCallStack) => str -> a +exe s = withFrozenCallStack $ toArgs (asArg s) -- | Create a function for the executable named loadExe :: ExecReference -> String -> Q [Dec] @@ -665,10 +693,9 @@ let name = mkName $ fnName impl = valD (varP name) (normalB [| - exe executable + withFrozenCallStack $ exe executable |]) [] - typn = mkName "a" - typ = SigD name (ForallT [PlainTV typn] [AppT (ConT ''Unit) (VarT typn), AppT (ConT ''ExecArgs) (VarT typn)] (VarT typn)) + typ = SigD name (ConT ''Cmd) i <- impl return $ [typ,i] @@ -778,18 +805,31 @@ rawExe (f $ takeFileName bin) bin pure (concat i) --- | Split a string separated by the provided separator. Trailing separators --- are ignored, and do not produce an empty string. Compatible with the + +-- | Split a string separated by the provided separator. A trailing separator +-- is ignored, and does not produce an empty string. Compatible with the -- output of most CLI programs, such as @find -print0@. -- --- >>> split "\n" "a\nb\n" +-- >>> endBy "\n" "a\nb\n" -- ["a","b"] -- --- >>> split "\n" "a\nb" +-- >>> endBy "\n" "a\nb" -- ["a","b"] -split :: ByteString -> ByteString -> [ByteString] -split s str = fmap fromString $ endBy (toString s) (toString str) +-- +-- >>> endBy "\n" "a\nb\n\n" +-- ["a","b",""] +endBy :: ByteString -> ByteString -> [ByteString] +endBy s str = + let splits = Search.split (toStrict s) str + in dropLastNull splits + where + dropLastNull :: [ByteString] -> [ByteString] + dropLastNull [] = [] + dropLastNull [""] = [] + dropLastNull [a] = [a] + dropLastNull (a:as) = a : dropLastNull as + -- | Load executables from the given directories loadFromDirs :: [FilePath] -> Q [Dec] loadFromDirs ps = loadAnnotatedFromDirs ps encodeIdentifier @@ -811,29 +851,8 @@ -- | Function that splits '\0' separated list of strings. Useful in conjunction -- with @find . "-print0"@. -split0 :: ByteString -> [ByteString] -split0 = split "\0" - --- | A convenience function for reading in a @"\\NUL"@ separated list of --- strings. This is commonly used when dealing with paths. --- --- > readSplit0 $ find "-print0" -readSplit0 :: Proc () -> IO [ByteString] -readSplit0 p = withReadSplit0 p pure - --- | A convenience function for reading the output lines of a `Proc`. --- --- Note: Please consider using @'readSplit0'@ instead if you can. -readLines :: Proc () -> IO [ByteString] -readLines p = withReadLines p pure - --- | Read output into a list of words -readWords :: Proc () -> IO [ByteString] -readWords p = withReadWords p pure - --- | Like `readProc`, but attempts to `Prelude.read` the result. -readAuto :: Read a => Proc () -> IO a -readAuto p = read . toString <$> readProc p +endBy0 :: ByteString -> [ByteString] +endBy0 = endBy "\0" -- | Mimics the shell builtin "cd". cd' :: FilePath -> IO () @@ -874,28 +893,28 @@ -- >>> yes |> head "-n" 5 |> xargs1 "\n" (const $ pure $ Sum 1) -- Sum {getSum = 5} xargs1 :: (NFData a, Monoid a) => ByteString -> (ByteString -> Proc a) -> Proc a -xargs1 n f = readInputSplitP n (fmap mconcat . mapM f) +xargs1 n f = readInputEndByP n (fmap mconcat . mapM f) -- | Simple @`Proc`@ that reads its input and can react to the output by -- calling other @`Proc`@'s which can write something to its stdout. -- The internal @`Proc`@ is given @/dev/null@ as its input. -readInputP :: (NFData a, PipeResult io) => (ByteString -> Proc a) -> io a +readInputP :: (NFData a, Shell io) => (ByteString -> Proc a) -> io a readInputP f = nativeProc $ \i o e -> do s <- hGetContents i withNullInput $ \i' -> liftIO $ runProc' i' o e (f s) -- | Like @`readInputP`@, but splits the input. -readInputSplitP :: (NFData a, PipeResult io) => ByteString -> ([ByteString] -> Proc a) -> io a -readInputSplitP s f = readInputP (f . split s) +readInputEndByP :: (NFData a, Shell io) => ByteString -> ([ByteString] -> Proc a) -> io a +readInputEndByP s f = readInputP (f . endBy s) -- | Like @`readInputP`@, but splits the input on 0 bytes. -readInputSplit0P :: (NFData a, PipeResult io) => ([ByteString] -> Proc a) -> io a -readInputSplit0P = readInputSplitP "\0" +readInputEndBy0P :: (NFData a, Shell io) => ([ByteString] -> Proc a) -> io a +readInputEndBy0P = readInputEndByP "\0" -- | Like @`readInputP`@, but splits the input on new lines. -readInputLinesP :: (NFData a, PipeResult io) => ([ByteString] -> Proc a) -> io a -readInputLinesP = readInputSplitP "\n" +readInputLinesP :: (NFData a, Shell io) => ([ByteString] -> Proc a) -> io a +readInputLinesP = readInputEndByP "\n" -- | Create a null file handle. withNullInput :: (Handle -> IO a) -> IO a diff --git a/test/Readme.lhs b/test/Readme.lhs new file mode 100644 --- /dev/null +++ b/test/Readme.lhs @@ -0,0 +1,307 @@ +# Shh + +[![](https://img.shields.io/hackage/v/shh.svg?colorB=%23999&label=shh)](http://hackage.haskell.org/package/shh) +[![](https://img.shields.io/hackage/v/shh-extras.svg?colorB=%23999&label=shh-extras)](http://hackage.haskell.org/package/shh-extras) +[![](https://builds.sr.ht/~lukec/shh/nix.yml.svg)](https://builds.sr.ht/~lukec/shh/nix.yml?) + +
+Shh is a library to enable convinient shell-like programming in Haskell. +It works well in scripts, and from GHCi, allowing you to use GHCi as a shell. + + +```haskell +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ExtendedDefaultRules #-} +module Readme (test) where + +import Shh + +import Control.Concurrent.Async +import Prelude hiding (head) +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck +import qualified System.Directory +import qualified Data.ByteString.Lazy.Char8 as Char8 +import Data.List (nub) +import Data.Char + +load SearchPath ["echo", "base64", "cat", "head", "sleep", "mktemp", "ls", "wc", "find", "tr", "users", "sha256sum", "false", "true"] + +curl :: Cmd +curl = true + +test :: IO () +test = do +``` + +
+ +It's primary purpose is in replacing shell scripts. As such, many +functions are provided to mimic the shell environment, and porting shell +scripts to shh should be fairly straightforward. A simple +["cargo culting" port](docs/porting.md) should work in most situations, +and perhaps be even more robust than the original. + +It is also a wrapper tool around launching GHCi as a shell. + +It supports + + * Automatically defining a function for each executable on your `$PATH` + using template Haskell, as well as a runtime check to ensure they all + exist on startup. + + * Redirction of stdout and stderr + + ```haskell + -- Redirect stdout + echo "Hello" &> StdErr + echo "Hello" &> Truncate ".tmp_file" + + -- Redirect stderr + echo "Hello" &!> Append "/dev/null" + echo "Hello" &!> StdOut + ``` + + + * Piping stdout or stderr to the input of a chained process + + ```haskell + cat "/dev/urandom" |> base64 |> head "-n" 5 + ``` + + * Multiple processes sequentially feeding a single process + + ```haskell + (echo 1 >> echo 2) |> cat + ``` + + * Use of Haskells concurrency primitives. + + ```haskell + race (sleep 1 >> echo "Slept for 1") (sleep 2 >> echo "Slept for 2") + + ``` + + ```haskell + mapConcurrently_ (\url -> curl "-Ls" url |> wc) + [ "https://raw.githubusercontent.com/luke-clifton/shh/master/shell.nix" + , "https://raw.githubusercontent.com/luke-clifton/shh/master/README.md" + ] + ``` + + * Capturing of process output + + ```haskell + s <- echo "Hello" |> tr "-d" "l" |> capture + print s + + loggedIn <- nub . Char8.words <$> (users |> capture) + putStrLn $ "Logged in users: " ++ show loggedIn + + mapM_ Char8.putStrLn =<< (find "-maxdepth" 1 "-print0" |> captureEndBy0) + ``` + + * Capturing infinite output of a process lazily + + ```haskell + cat "/dev/urandom" + |> base64 + |> readInput (mapM_ Char8.putStrLn . take 3 . Char8.lines) + ``` + + * Write strings to stdin of a process. + + ```haskell + writeOutput "Hello\n" |> cat + -- Hello + + "Hello" >>> sha256sum + + sha256sum <<< "Hello" + ``` + + * Proper exceptions, when a process exits with a failure code, an exception + is thrown. You can catch these normally. The exception includes the error + code, the command, and all it's arguments. + + ```haskell + false "Ha, it died" + -- *** Exception: Command `false "Ha, it died"` failed [exit 1] + ``` + ```haskell + exitCode false + -- 1 + ``` + + * "Native" processes, i.e. Haskell functions that behave like a process. + + ```haskell + echo "Hello" |> pureProc (Char8.map toUpper) |> tr "-d" "L" + -- HEO + ``` + + * And much, much more! Look at the documentation on Hackage for a + comprehensive overview of all the possibilities. + +## Mnemonics + +Shh has many symbols that might seem intimidating at first, but there +is a simple mnemonic for them. + + | Piping. Looks like a pipe, same as in POSIX shells. + & Redirection, think of the shell `2>&1` + >,< The direction of flow of a command + ! Operate on stderr instead of stdout + +So, for example, + + ls |> cat Pipe the stdout of `ls` into stdin of `cat` + cat <| ls Same as above + ls &> StdErr Redirect stdout of `ls` to wherever stderr is going. + StdErr <& ls Same as above + ls &!> StdOut Redirect stderr of `ls` to wherever stdout is going. + StdOut trim l == trim (trim l) , testProperty "encodeIdentifier creates a unique encoding" - $ \(l1,l2) -> (encodeIdentifier l1 == encodeIdentifier l2) == (l1 == l2) + $ \(l1,l2) -> (encodeIdentifier l1 == encodeIdentifier l2) == (takeFileName l1 == takeFileName l2) , testProperty "writeOutput" $ \s -> ioProperty $ do let s' = bytesToString s @@ -58,10 +61,10 @@ , testProperty "pureProc id" $ \s -> ioProperty $ do let s' = bytesToString s - k <- readProc $ s' >>> pureProc id + k <- apply (pureProc id) s' pure $ s' === k , testProperty "pureProc (map toUpper)" $ \s -> ioProperty $ do - k <- readProc $ s >>> pureProc (C8.map toUpper) + k <- apply (pureProc (C8.map toUpper)) s pure $ C8.map toUpper s === k , testProperty "pureProc . const === writeOutput" $ \s -> ioProperty $ do let @@ -87,78 +90,85 @@ ] withTmp :: (ByteString -> IO a) -> IO a -withTmp = bracket (readTrim mktemp) rm +withTmp = bracket (mktemp |> captureTrim) rm +checkFailure :: Failure -> ByteString -> [ByteString] -> Int -> IO () +checkFailure f prog args code = do + failureProg f @?= prog + failureArgs f @?= args + failureCode f @?= code + unitTests :: TestTree unitTests = testGroup "Unit tests" [ testCase "Read stdout" $ do - l <- readProc $ echo "test" + l <- echo "test" |> capture l @?= "test\n" , testCase "Redirect to /dev/null" $ do - l <- readProc $ echo "test" &> devNull + l <- echo "test" &> devNull |> capture l @?= "" , testCase "Redirct stderr" $ do l <- echo "test" &> StdErr |!> capture l @?= "test\n" , testCase "Redirect to file (Truncate)" $ withTmp $ \t -> do echo "test" &> Truncate t - r <- readProc $ cat t + r <- cat t |> capture "test\n" @?= r , testCase "Redirect to file (Append)" $ withTmp $ \t -> do echo "test" &> Truncate t echo "test" &> Append t - r <- readProc $ cat t + r <- cat t |> capture "test\ntest\n" @?= r , testCase "Long pipe" $ do - r <- readProc $ echo "test" |> tr "-d" "e" |> tr "-d" "s" + r <- echo "test" |> tr "-d" "e" |> tr "-d" "s" |> capture r @?= "tt\n" , testCase "Pipe stderr" $ replicateM_ 100 $ do - r <- readProc $ echo "test" &> StdErr |!> cat + r <- echo "test" &> StdErr |!> cat |> capture r @?= "test\n" , testCase "Lazy read" $ replicateM_ 100 $ do - withRead (cat "/dev/zero") $ \s -> do + cat "/dev/zero" |> readInput (\s -> do BS.take 6 s @?= "\0\0\0\0\0\0" + ) , testCase "Multiple outputs" $ do - l <- readProc $ (echo (1 :: Int) >> echo (2 :: Int)) |> cat + l <- (echo (1 :: Int) >> echo (2 :: Int)) |> cat |> capture l @?= "1\n2\n" , testCase "Terminate upstream processes" $ do - Left x <- catchFailure (mkProc "false" ["dummy"] |> (sleep 1 >> false "Didn't kill")) - x @?= Shh.Failure "false" ["dummy"] 1 + Left x <- tryFailure (mkProc "false" ["dummy"] |> (sleep 1 >> false "Didn't kill")) + checkFailure x "false" ["dummy"] 1 , testCase "Write to process" $ withTmp $ \t -> do writeProc (cat &> Truncate t) "Hello" - r <- readProc (cat t) + r <- cat t |> capture r @?= "Hello" writeProc (cat &> Truncate t) "Goodbye" - r <- readProc (cat t) + r <- cat t |> capture r @?= "Goodbye" , testCase "apply" $ do r <- apply (tr "-d" "es") "test" r @?= "tt" , testCase "ignoreFailure" $ replicateM_ 30 $ do - r <- readProc $ ignoreFailure false |> echo "Hello" + r <- ignoreFailure false |> echo "Hello" |> capture r @?= "Hello\n" , testCase "Read failure" $ replicateM_ 30 $ do - Left r <- catchFailure $ readProc $ false "dummy" - r @?= Shh.Failure "false" ["dummy"] 1 + Left r <- tryFailure $ false "dummy" |> capture + checkFailure r "false" ["dummy"] 1 , testCase "Read failure chain start" $ replicateM_ 30 $ do - Left r <- catchFailure $ readProc $ false "dummy" |> echo "test" |> true - r @?= Shh.Failure "false" ["dummy"] 1 + Left r <- tryFailure $ false "dummy" |> echo "test" |> true |> capture + checkFailure r "false" ["dummy"] 1 , testCase "Read failure chain middle" $ replicateM_ 30 $ do - Left r <- catchFailure $ readProc $ echo "test" |> false "dummy" |> true - r @?= Shh.Failure "false" ["dummy"] 1 + Left r <- tryFailure $ echo "test" |> false "dummy" |> true |> capture + checkFailure r "false" ["dummy"] 1 , testCase "Read failure chain end" $ replicateM_ 30 $ do - Left r <- catchFailure $ readProc $ echo "test" |> true |> false "dummy" - r @?= Shh.Failure "false" ["dummy"] 1 + Left r <- tryFailure $ echo "test" |> true |> false "dummy" |> capture + checkFailure r "false" ["dummy"] 1 , testCase "Lazy read checks code" $ replicateM_ 30 $ do - Left r <- catchFailure $ withRead (cat "/dev/urandom" |> false "dummy") $ pure . BS.take 3 - r @?= Shh.Failure "false" ["dummy"] 1 + Left r <- tryFailure $ cat "/dev/urandom" |> false "dummy" |> readInput (pure . BS.take 3) + checkFailure r "false" ["dummy"] 1 , testCase "Identifier odd chars" $ encodeIdentifier "1@3.-" @?= "_1'40'3''_" , testCase "Identifier make lower" $ encodeIdentifier "T.est" @?= "_T''est" , testCase "pureProc closes input" $ do - r <- readProc $ cat "/dev/urandom" |> pureProc (const "test") + r <- cat "/dev/urandom" |> pureProc (const "test") |> capture r @?= "test" , testCase "pureProc closes output" $ do - r <- readProc $ pureProc (const "test") |> cat + r <- pureProc (const "test") |> cat |> capture r @?= "test" , testCase "pureProc doesn't close std handles" $ do runProc $ pureProc (const "") @@ -170,7 +180,7 @@ b <- hIsOpen stderr b @?= True , testCase "pureProc sanity check" $ do - r <- readProc $ printf "Hello" |> pureProc id |> cat + r <- printf "Hello" |> pureProc id |> cat |> capture r @?= "Hello" , testCase "bind nativeProc" $ do r <- writeOutput "te" >> writeOutput "st" |> capture @@ -211,10 +221,10 @@ a @?= b , testCase "complex example with intermediate handles (>BUFSIZ)" $ do let c = 20000000 - s <- readTrim $ cat "/dev/urandom" |> readInputP (\s -> writeOutput (C8.map toUpper s) |> cat) |> Main.head "-c" c |> wc "-c" + s <- cat "/dev/urandom" |> readInputP (\s -> writeOutput (C8.map toUpper s) |> cat) |> Main.head "-c" c |> wc "-c" |> captureTrim show c @?= toString s , testCase "subshells" $ do - s <- readProc $ echo "ac" |> (cat >> echo "bc") |> tr "-d" "c" + s <- echo "ac" |> (cat >> echo "bc") |> tr "-d" "c" |> capture s @?= "a\nb\n" , testCase "unicode" $ do s <- writeOutput "üか" |> cat |> capture