shelly 1.12.0.1 → 1.12.1
raw patch · 8 files changed
+59/−13 lines, 8 filesdep ~time
Dependency ranges changed: time
Files
- ChangeLog.md +8/−0
- shelly.cabal +2/−1
- src/Shelly.hs +11/−3
- src/Shelly/Base.hs +6/−1
- src/Shelly/Lifted.hs +10/−2
- test/src/FindSpec.hs +6/−6
- test/src/PrintCommandsFnSpec.hs +14/−0
- test/src/TestMain.hs +2/−0
ChangeLog.md view
@@ -1,3 +1,11 @@+# 1.12.1++Andreas Abel, 2023-04-03+* Add `print_commands_with` and `echoWith` which can be used to override+ the default printing functions (e.g. to add color).+ (Chris Wendt, PR [#228](https://github.com/gregwebs/Shelly.hs/pull/228).)+* Tested with GHC 8.2 - 9.6 (cabal) and GHC 8.10 - 9.6 (stack).+ # 1.12.0.1 Andreas Abel, 2023-04-02
shelly.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.0 Name: shelly-Version: 1.12.0.1+Version: 1.12.1 Synopsis: shell-like (systems) programming in Haskell @@ -131,6 +131,7 @@ LiftedSpec MoveSpec PipeSpec+ PrintCommandsFnSpec ReadFileSpec RmSpec RunSpec
src/Shelly.hs view
@@ -28,7 +28,7 @@ ( -- * Entering Sh Sh, ShIO, shelly, shellyNoDir, shellyFailDir, asyncSh, sub- , silently, verbosely, escaping, print_stdout, print_stderr, print_commands+ , silently, verbosely, escaping, print_stdout, print_stderr, print_commands, print_commands_with , onCommandHandles , tracing, errExit , log_stdout_with, log_stderr_with@@ -56,7 +56,7 @@ , cd, chdir, chdir_p, pwd -- * Printing- , echo, echo_n, echo_err, echo_n_err, inspect, inspect_err+ , echo, echo_n, echo_err, echo_n_err, echoWith, inspect, inspect_err , tag, trace, show_command -- * Querying filesystem@@ -851,6 +851,13 @@ print_commands :: Bool -> Sh a -> Sh a print_commands shouldPrint a = sub $ modify (\st -> st { sPrintCommands = shouldPrint }) >> a ++-- | Create a sub-Sh in which commands are sent to the user-defined function.+--+-- @since 1.12.1+print_commands_with :: (Text -> IO ()) -> Sh a -> Sh a+print_commands_with fn a = sub $ modify (\st -> st { sPrintCommandsFn = fn }) >> a+ -- | Enter a sub-Sh that inherits the environment -- The original state will be restored when the sub-Sh completes. -- Exceptions are propagated normally.@@ -954,6 +961,7 @@ , sPrintStdout = True , sPrintStderr = True , sPrintCommands = False+ , sPrintCommandsFn = TIO.hPutStrLn stdout , sInitCommandHandles = initAllHandles (const $ return ()) , sCommandEscaping = True , sEnvironment = environment@@ -1266,7 +1274,7 @@ state <- get let cmdString = show_command exe args- when (sPrintCommands state) $ echo cmdString+ when (sPrintCommands state) $ echoWith (sPrintCommandsFn state) cmdString trace cmdString let doRun = if sCommandEscaping state then runCommand else runCommandNoEscape
src/Shelly/Base.hs view
@@ -20,7 +20,7 @@ unpack, gets, get, modify, trace, ls, lsRelAbs, toTextIgnore,- echo, echo_n, echo_err, echo_n_err, inspect, inspect_err,+ echo, echo_n, echo_err, echo_n_err, echoWith, inspect, inspect_err, catchany, liftIO, (>=>), eitherRelativeTo, relativeTo, maybeRelativeTo,@@ -105,6 +105,7 @@ , sPutStderr :: Text -> IO () -- ^ by default, hPutStrLn stderr , sPrintStderr :: Bool -- ^ print stderr of command that is executed , sPrintCommands :: Bool -- ^ print command that is executed+ , sPrintCommandsFn :: Text -> IO () -- ^ how to print commands, default is hputStrLn stdout , sInitCommandHandles :: StdInit -- ^ initializers for the standard process handles -- when running a command , sCommandEscaping :: Bool -- ^ when running a command, escape shell characters such as '*' rather@@ -305,6 +306,10 @@ echo_n msg = traceEcho msg >> liftIO (TIO.putStr msg >> hFlush stdout) echo_err msg = traceEcho msg >> liftIO (TIO.hPutStrLn stderr msg >> hFlush stdout) echo_n_err msg = traceEcho msg >> liftIO (TIO.hPutStr stderr msg >> hFlush stderr)++-- | @since 1.12.1+echoWith :: (Text -> IO ()) -> Text -> Sh ()+echoWith f msg = traceEcho msg >> liftIO (f msg >> hFlush stdout) traceEcho :: Text -> Sh () traceEcho msg = trace ("echo " `mappend` "'" `mappend` msg `mappend` "'")
src/Shelly/Lifted.hs view
@@ -34,7 +34,7 @@ -- * Entering Sh Sh, ShIO, S.shelly, S.shellyNoDir, S.shellyFailDir, sub- , silently, verbosely, escaping, print_stdout, print_stderr, print_commands+ , silently, verbosely, escaping, print_stdout, print_stderr, print_commands, print_commands_with , tracing, errExit , log_stdout_with, log_stderr_with @@ -57,7 +57,7 @@ , cd, chdir, chdir_p, pwd -- * Printing- , echo, echo_n, echo_err, echo_n_err, inspect, inspect_err+ , echo, echo_n, echo_err, echo_n_err, echoWith, inspect, inspect_err , tag, trace, S.show_command -- * Querying filesystem@@ -324,6 +324,10 @@ print_commands :: MonadShControl m => Bool -> m a -> m a print_commands shouldPrint a = controlSh $ \runInSh -> S.print_commands shouldPrint (runInSh a) +-- | @since 1.12.1+print_commands_with :: MonadShControl m => (Text -> IO ()) -> m a -> m a+print_commands_with fn a = controlSh $ \runInSh -> S.print_commands_with fn (runInSh a)+ sub :: MonadShControl m => m a -> m a sub a = controlSh $ \runInSh -> S.sub (runInSh a) @@ -553,6 +557,10 @@ echo_n = liftSh . S.echo_n echo_err = liftSh . S.echo_err echo_n_err = liftSh . S.echo_n_err++-- | @since 1.12.1+echoWith :: MonadSh m => (Text -> IO ()) -> Text -> m ()+echoWith f msg = liftSh $ S.echoWith f msg relPath :: MonadSh m => FilePath -> m FilePath relPath = liftSh . S.relPath
test/src/FindSpec.hs view
@@ -51,7 +51,7 @@ res <- shelly $ cd "test/src" >> ls "." sort res @?= map toWindowsStyleIfNecessary ["./CopySpec.hs", "./EnvSpec.hs", "./FailureSpec.hs", "./FindSpec.hs", "./Help.hs", "./LiftedSpec.hs", "./LogWithSpec.hs", "./MoveSpec.hs",- "./PipeSpec.hs", "./ReadFileSpec.hs", "./RmSpec.hs", "./RunSpec.hs", "./ShowCommandSpec.hs", "./SshSpec.hs",+ "./PipeSpec.hs", "./PrintCommandsFnSpec.hs", "./ReadFileSpec.hs", "./RmSpec.hs", "./RunSpec.hs", "./ShowCommandSpec.hs", "./SshSpec.hs", "./TestInit.hs", "./TestMain.hs", "./WhichSpec.hs", "./WriteSpec.hs", "./sleep.hs"] @@ -59,7 +59,7 @@ res <- shelly $ cd "test" >> ls "src" sort res @?= map toWindowsStyleIfNecessary ["src/CopySpec.hs", "src/EnvSpec.hs", "src/FailureSpec.hs", "src/FindSpec.hs", "src/Help.hs", "src/LiftedSpec.hs", "src/LogWithSpec.hs", "src/MoveSpec.hs",- "src/PipeSpec.hs", "src/ReadFileSpec.hs", "src/RmSpec.hs", "src/RunSpec.hs", "src/ShowCommandSpec.hs", "src/SshSpec.hs",+ "src/PipeSpec.hs", "src/PrintCommandsFnSpec.hs", "src/ReadFileSpec.hs", "src/RmSpec.hs", "src/RunSpec.hs", "src/ShowCommandSpec.hs", "src/SshSpec.hs", "src/TestInit.hs", "src/TestMain.hs", "src/WhichSpec.hs", "src/WriteSpec.hs", "src/sleep.hs"] @@ -67,7 +67,7 @@ res <- shelly $ cd "test/src" >> find "." sort res @?= map toWindowsStyleIfNecessary ["./CopySpec.hs", "./EnvSpec.hs", "./FailureSpec.hs", "./FindSpec.hs", "./Help.hs", "./LiftedSpec.hs", "./LogWithSpec.hs", "./MoveSpec.hs",- "./PipeSpec.hs", "./ReadFileSpec.hs", "./RmSpec.hs", "./RunSpec.hs", "./ShowCommandSpec.hs", "./SshSpec.hs",+ "./PipeSpec.hs", "./PrintCommandsFnSpec.hs", "./ReadFileSpec.hs", "./RmSpec.hs", "./RunSpec.hs", "./ShowCommandSpec.hs", "./SshSpec.hs", "./TestInit.hs", "./TestMain.hs", "./WhichSpec.hs", "./WriteSpec.hs", "./sleep.hs"] @@ -86,13 +86,13 @@ if isWindows then sort res @?= ["test/src\\CopySpec.hs", "test/src\\EnvSpec.hs", "test/src\\FailureSpec.hs", "test/src\\FindSpec.hs", "test/src\\Help.hs", "test/src\\LiftedSpec.hs",- "test/src\\LogWithSpec.hs", "test/src\\MoveSpec.hs", "test/src\\PipeSpec.hs", "test/src\\ReadFileSpec.hs",+ "test/src\\LogWithSpec.hs", "test/src\\MoveSpec.hs", "test/src\\PipeSpec.hs", "test/src\\PrintCommandsFnSpec.hs", "test/src\\ReadFileSpec.hs", "test/src\\RmSpec.hs", "test/src\\RunSpec.hs", "test/src\\ShowCommandSpec.hs", "test/src\\SshSpec.hs", "test/src\\TestInit.hs", "test/src\\TestMain.hs", "test/src\\WhichSpec.hs", "test/src\\WriteSpec.hs", "test/src\\sleep.hs"] else sort res @?= ["test/src/CopySpec.hs", "test/src/EnvSpec.hs", "test/src/FailureSpec.hs", "test/src/FindSpec.hs", "test/src/Help.hs", "test/src/LiftedSpec.hs",- "test/src/LogWithSpec.hs", "test/src/MoveSpec.hs", "test/src/PipeSpec.hs", "test/src/ReadFileSpec.hs",+ "test/src/LogWithSpec.hs", "test/src/MoveSpec.hs", "test/src/PipeSpec.hs", "test/src/PrintCommandsFnSpec.hs", "test/src/ReadFileSpec.hs", "test/src/RmSpec.hs", "test/src/RunSpec.hs", "test/src/ShowCommandSpec.hs", "test/src/SshSpec.hs", "test/src/TestInit.hs", "test/src/TestMain.hs", "test/src/WhichSpec.hs", "test/src/WriteSpec.hs", "test/src/sleep.hs"]@@ -101,7 +101,7 @@ res <- shelly $ relPath "test/src" >>= find >>= mapM (relativeTo "test/src") sort res @?= ["CopySpec.hs", "EnvSpec.hs", "FailureSpec.hs", "FindSpec.hs", "Help.hs", "LiftedSpec.hs", "LogWithSpec.hs", "MoveSpec.hs",- "PipeSpec.hs", "ReadFileSpec.hs", "RmSpec.hs", "RunSpec.hs",+ "PipeSpec.hs", "PrintCommandsFnSpec.hs", "ReadFileSpec.hs", "RmSpec.hs", "RunSpec.hs", "ShowCommandSpec.hs", "SshSpec.hs", "TestInit.hs", "TestMain.hs", "WhichSpec.hs", "WriteSpec.hs", "sleep.hs"]
+ test/src/PrintCommandsFnSpec.hs view
@@ -0,0 +1,14 @@+module PrintCommandsFnSpec (printCommandsFnSpec) where++import TestInit+import Data.IORef++printCommandsFnSpec :: Spec+printCommandsFnSpec = do+ describe "sPrintCommandsFn" $ do+ it "calls the custom print function" $ do+ calledRef <- newIORef False+ let printFn = \_ -> writeIORef calledRef True+ _ <- shelly $ print_commands True $ print_commands_with printFn $ run "echo" []+ called <- readIORef calledRef+ called @?= True
test/src/TestMain.hs view
@@ -7,6 +7,7 @@ import MoveSpec import RmSpec import FindSpec+import PrintCommandsFnSpec import EnvSpec import FailureSpec import CopySpec@@ -26,6 +27,7 @@ moveSpec rmSpec findSpec+ printCommandsFnSpec envSpec failureSpec copySpec