diff --git a/shelly.cabal b/shelly.cabal --- a/shelly.cabal +++ b/shelly.cabal @@ -1,6 +1,6 @@ Name: shelly -Version: 1.3.2 +Version: 1.4.0.1 Synopsis: shell-like (systems) programming in Haskell Description: Shelly provides convenient systems programming in Haskell, diff --git a/src/Shelly.hs b/src/Shelly.hs --- a/src/Shelly.hs +++ b/src/Shelly.hs @@ -1,6 +1,6 @@ {-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, OverloadedStrings, - MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, - TypeFamilies, IncoherentInstances, GADTs #-} + 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. @@ -23,7 +23,9 @@ module Shelly ( -- * Entering Sh. - Sh, ShIO, shelly, shellyNoDir, sub, silently, verbosely, escaping, print_stdout, print_commands, tracing, errExit + Sh, ShIO, shelly, shellyNoDir, sub + , silently, verbosely, escaping, print_stdout, print_stderr, print_commands + , tracing, errExit -- * Running external commands. , run, run_, runFoldLines, cmd, FoldCallback @@ -38,7 +40,7 @@ -- * Modifying and querying environment. - , setenv, get_env, get_env_text, getenv, get_env_def, get_env_all, appendToPath + , setenv, get_env, get_env_text, getenv, get_env_def, get_env_all, get_environment, appendToPath -- * Environment directory , cd, chdir, pwd @@ -84,7 +86,7 @@ import Shelly.Base import Shelly.Find -import Control.Monad ( when, unless, void, forM, filterM ) +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 @@ -333,6 +335,9 @@ #if MIN_VERSION_process(1,1,0) , create_group = False #endif +#if MIN_VERSION_process(1,2,0) + , delegate_ctlc = False +#endif } return ( just $ createdInH <|> toHandle mInH , just $ createdOutH <|> toHandle mOutH @@ -679,7 +684,11 @@ pe <- get_env_text path_env setPath $ pe <> T.singleton searchPathSeparator <> tp --- | get all the environment variables +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 @@ -713,20 +722,35 @@ -- commands are not printed. -- See 'sub'. silently :: Sh a -> Sh a -silently a = sub $ modify (\x -> x { sPrintStdout = False, sPrintCommands = False }) >> 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, sPrintCommands = True }) >> a +verbosely a = sub $ modify (\x -> x + { sPrintStdout = True + , sPrintStderr = True + , sPrintCommands = True + }) >> 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 +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 @@ -810,6 +834,7 @@ , sStdin = Nothing , sStderr = T.empty , sPrintStdout = True + , sPrintStderr = True , sPrintCommands = False , sRun = runCommand , sEnvironment = environment @@ -1077,25 +1102,28 @@ 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 - errVar' <- newEmptyMVar - outVar' <- newEmptyMVar - _ <- forkIO $ transferLinesAndCombine errH stderr >>= putMVar errVar' - return (errVar', outVar') - - state <- get - errs <- liftIO $ do - void $ if sPrintStdout state - then - forkIO $ transferFoldHandleLines start cb outH stdout >>= putMVar outVar - else - forkIO $ foldHandleLines start cb outH >>= putMVar outVar - takeMVar errVar - + liftM2 (,) + (putHandleIntoMVar mempty (|>) errH stderr (sPrintStderr state)) + (putHandleIntoMVar start cb outH stdout (sPrintStdout state)) + errs <- liftIO $ lineSeqToText `fmap` takeMVar errVar modify $ \state' -> state' { sStderr = errs } liftIO $ takeMVar outVar + +putHandleIntoMVar :: a -> FoldCallback a + -> Handle -- ^ out handle + -> Handle -- ^ in handle + -> Bool -- ^ should it be printed while transfered? + -> IO (MVar a) +putHandleIntoMVar start cb outH inHandle shouldPrint = do + outVar <- newEmptyMVar + void $ forkIO $ if shouldPrint + then transferFoldHandleLines start cb outH inHandle >>= putMVar outVar + else foldHandleLines start cb outH >>= putMVar outVar + return outVar -- | The output of last external command. See 'run'. diff --git a/src/Shelly/Base.hs b/src/Shelly/Base.hs --- a/src/Shelly/Base.hs +++ b/src/Shelly/Base.hs @@ -65,6 +65,7 @@ , sStderr :: Text -- ^ stderr for command that ran , sDirectory :: FilePath -- ^ working directory , sPrintStdout :: Bool -- ^ print stdout of command that is executed + , sPrintStderr :: Bool -- ^ print stderr of command that is executed , sPrintCommands :: Bool -- ^ print command that is executed , sRun :: [StdHandle] -> State -> FilePath -> [Text] -> Sh (Handle, Handle, Handle, ProcessHandle) -- ^ command runner, a different runner is used when escaping, probably better to just hold the escaping flag , sEnvironment :: [(String, String)]