shelly 0.8.0.2 → 0.9.0
raw patch · 2 files changed
+82/−59 lines, 2 files
Files
- Shelly.hs +81/−58
- shelly.cabal +1/−1
Shelly.hs view
@@ -64,7 +64,7 @@ , toTextIgnore, toTextWarn, fromText -- * Re-exported for your convenience- , liftIO, when, unless+ , liftIO, when, unless, FilePath ) where -- TODO:@@ -91,7 +91,7 @@ import Prelude hiding ( catch, readFile, FilePath ) import Data.List( isInfixOf )-import Data.Char( isAlphaNum )+import Data.Char( isAlphaNum, isSpace ) import Data.Typeable import Data.IORef import Data.Maybe@@ -264,7 +264,7 @@ -- | log actions that occur trace :: Text -> ShIO ()-trace msg = modify $ \st -> st { sTrace = sTrace st `mappend` "\n" `mappend` B.fromLazyText msg }+trace msg = modify $ \st -> st { sTrace = sTrace st `mappend` B.fromLazyText msg `mappend` "\n" } type ShIO a = ReaderT (IORef State) IO a @@ -274,9 +274,9 @@ liftIO (readIORef stateVar) put :: State -> ShIO ()-put state = do+put newState = do stateVar <- ask - liftIO (writeIORef stateVar state)+ liftIO (writeIORef stateVar newState) modify :: (State -> State) -> ShIO () modify f = do@@ -293,7 +293,7 @@ liftIO $ runInteractiveProcess (unpack exe) (map LT.unpack args) (Just $ unpack $ sDirectory st)- (Just $ sEnvironment st) -- TODO: is PATH buggy?+ (Just $ sEnvironment st) {- -- | use for commands requiring usage of sudo. see 'run_sudo'.@@ -483,6 +483,7 @@ -- own. Use carefully. rm_rf :: FilePath -> ShIO () rm_rf f = absPath f >>= \f' -> do+ trace $ "rm_rf " `mappend` toTextIgnore f whenM (test_d f) $ do _<- find f' >>= mapM (\file -> liftIO_ $ fixPermissions (unpack file) `catchany` \_ -> return ()) liftIO_ $ removeTree f'@@ -495,9 +496,9 @@ -- | Remove a file. Does not fail if the file already is not there. Does fail -- if the file is not a file. rm_f :: FilePath -> ShIO ()-rm_f f = whenM (test_e f) $ absPath f >>= \fp -> do- trace $ "rm_f " `mappend` toTextIgnore fp- liftIO $ removeFile fp+rm_f f = do+ trace $ "rm_f " `mappend` toTextIgnore f+ whenM (test_e f) $ absPath f >>= liftIO . removeFile -- | Set an environment variable. The environment is maintained in ShIO -- internally, and is passed to any external commands to be executed.@@ -508,6 +509,7 @@ in modify $ \x -> x { sEnvironment = wibble $ sEnvironment x } -- | add the filepath onto the PATH env variable+-- FIXME: see comments for "which" appendToPath :: FilePath -> ShIO () appendToPath filepath = do tp <- toTextWarn filepath@@ -527,18 +529,23 @@ getenv_def k d = gets sEnvironment >>= return . LT.pack . fromMaybe (LT.unpack d) . lookup (LT.unpack k) --- | Create a sub-ShIO in which external command outputs are not echoed. See "sub".+-- | Create a sub-ShIO in which external command outputs are not echoed.+-- Also commands are not printed.+-- See "sub". silently :: ShIO a -> ShIO a silently a = sub $ modify (\x -> x { sPrintStdout = False, sPrintCommands = False }) >> a --- | Create a sub-ShIO in which external command outputs are echoed. See "sub".+-- | Create a sub-ShIO in which external command outputs are echoed.+-- Executed commands are printed+-- See "sub". verbosely :: ShIO a -> ShIO a verbosely a = sub $ modify (\x -> x { sPrintStdout = True, sPrintCommands = True }) >> a -print_stdout :: ShIO a -> ShIO a-print_stdout a = sub $ modify (\x -> x { sPrintStdout = True }) >> a+-- | Turn on/off printing stdout+print_stdout :: Bool -> ShIO a -> ShIO a+print_stdout shouldPrint a = sub $ modify (\x -> x { sPrintStdout = shouldPrint }) >> a --- | Create a sub-ShIO which has a 'limit' on the max number of background tasks.+-- | Create a 'BgJobManager' which has a 'limit' on the max number of background tasks. -- an invocation of jobs is independent of any others, and not tied to the ShIO monad in any way. -- This blocks the execution of the program until all 'background' jobs are finished. jobs :: Int -> (BgJobManager -> ShIO a) -> ShIO a@@ -586,21 +593,26 @@ return $ BgResult mvar --- | Create a sub-ShIO in which external command outputs are echoed. See "sub".-print_commands :: ShIO a -> ShIO a-print_commands a = sub $ modify (\x -> x { sPrintCommands = True }) >> a+-- | Turn on/off command echoing.+print_commands :: Bool -> ShIO a -> ShIO a+print_commands shouldPrint a = sub $ modify (\st -> st { sPrintCommands = shouldPrint }) >> a --- | Enter a sub-ShIO that inherits the environment and working directory+-- | Enter a sub-ShIO that inherits the environment -- The original state will be restored when the sub-ShIO completes.- --Exceptions are propagated normally.+-- Exceptions are propagated normally. sub :: ShIO a -> ShIO a sub a = do- state <- get+ oldState <- get+ modify $ \st -> st { sTrace = B.fromText "" } r <- a `catchany_sh` (\e -> do- put state+ restoreState oldState liftIO $ throwIO e)- put state+ restoreState oldState return r+ where+ restoreState oldState = do+ newState <- get+ put oldState { sTrace = sTrace oldState `mappend` sTrace newState } -- | Enter a ShIO from (Monad)IO. The environment and working directories are -- inherited from the current process-wide values. Any subsequent changes in@@ -622,36 +634,45 @@ stref <- liftIO $ newIORef def let caught = action `catchany_sh` \e ->- get >>= liftIO . throwIO . ReThrownException e . LT.unpack . B.toLazyText . sTrace+ get >>= liftIO . throwIO . ReThrownException e . errorMsg . LT.unpack . B.toLazyText . sTrace liftIO $ runReaderT caught stref+ where+ errorMsg trc = "Ran commands: \n" `mappend` trc data RunFailed = RunFailed FilePath [Text] Int Text deriving (Typeable) instance Show RunFailed where show (RunFailed exe args code errs) =- "error running " ++- unpack exe ++ " " ++ show args +++ "error running: " ++ LT.unpack (show_command exe args) ++ "\nexit status: " ++ show code ++ "\nstderr: " ++ LT.unpack errs instance Exception RunFailed +show_command :: FilePath -> [Text] -> Text+show_command exe args =+ LT.intercalate " " $ map quote (toTextIgnore exe : args)+ where+ quote t = if LT.any isSpace t then surround '\'' t else t+ surround c t = LT.cons c $ LT.snoc t c++ data Exception e => ReThrownException e = ReThrownException e String deriving (Typeable) instance Exception e => Exception (ReThrownException e) instance Exception e => Show (ReThrownException e) where- show (ReThrownException ex msg) =- "Exception: " ++ show ex ++ "\n" ++ msg+ show (ReThrownException ex msg) = "\n" +++ msg ++ "\n" ++ "Exception: " ++ show ex -- | Execute an external command. Takes the command name (no shell allowed, -- just a name of something that can be found via @PATH@; FIXME: setenv'd--- @PATH@ is not taken into account, only the one inherited from the actual--- outside environment). Nothing is provided on "stdin" of the process, and--- "stdout" and "stderr" are collected and stored. The "stdout" is returned as+-- @PATH@ is not taken into account when finding the exe name)+--+-- "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 but still consume the result by using "run'",--- or if you need to process the output than "runFoldLines"+-- You can avoid this but still consume the result by using "run_",+-- If you want to avoid the memory and need to process the output then use "runFoldLines". run :: FilePath -> [Text] -> ShIO Text run exe args = fmap B.toLazyText $ runFoldLines (B.fromText "") foldBuilder exe args @@ -690,12 +711,24 @@ -- stderr is still placed in memory (this could be changed in the future) runFoldLines :: a -> FoldCallback a -> FilePath -> [Text] -> ShIO a runFoldLines start cb exe args = do+ -- clear stdin before beginning command execution+ origstate <- get+ let mStdin = sStdin origstate+ put $ origstate { sStdin = Nothing, sCode = 0, sStderr = LT.empty } state <- get- when (sPrintCommands state) $ do- c <- toTextWarn exe- echo $ LT.intercalate " " (c:args)++ let cmdString = show_command exe args+ when (sPrintCommands state) $ echo cmdString+ trace cmdString+ (inH,outH,errH,procH) <- sRun state exe args + case mStdin of+ Just input ->+ liftIO $ TIO.hPutStr inH input >> hClose inH+ -- stdin is cleared from state below+ Nothing -> return ()+ errV <- liftIO newEmptyMVar outV <- liftIO newEmptyMVar if sPrintStdout state@@ -706,31 +739,19 @@ liftIO_ $ forkIO $ getContent errH >>= putMVar errV liftIO_ $ forkIO $ foldHandleLines start cb outH >>= putMVar outV - -- If input was provided write it to the input handle.- case sStdin state of- Just input ->- liftIO $ TIO.hPutStr inH input >> hClose inH- -- stdin is cleared from state below- Nothing -> return ()- errs <- liftIO $ takeMVar errV- outs <- liftIO $ takeMVar outV ex <- liftIO $ waitForProcess procH - let code = case ex of ExitSuccess -> 0 ExitFailure n -> n- put $ state {- sStdin = Nothing- , sStderr = errs- , sCode = code- }- case ex of- ExitSuccess -> return outs- ExitFailure n ->- liftIO $ throwIO $ RunFailed exe args n errs + put $ state { sStderr = errs , sCode = code }++ liftIO $ case ex of+ ExitSuccess -> takeMVar outV+ ExitFailure n -> throwIO $ RunFailed exe args n errs+ -- | The output of last external command. See "run". lastStderr :: ShIO Text lastStderr = gets sStderr@@ -742,7 +763,7 @@ -- | Pipe operator. set the stdout the first command as the stdin of the second. (-|-) :: ShIO Text -> ShIO b -> ShIO b one -|- two = do- res <- silently one+ res <- (print_stdout False) one setStdin res two @@ -783,9 +804,11 @@ trace $ "cp_r " `mappend` toTextIgnore from `mappend` " " `mappend` toTextIgnore to from_d <- (test_d from) if not from_d then cp from to else do- unlessM (test_d to) $ mkdir to- ls from >>= mapM_- (\item -> cp_r (from FP.</> filename item) (to FP.</> filename item))+ let fromName = filename from+ let toDir = if filename to == fromName then to else to FP.</> fromName+ unlessM (test_d toDir) $ mkdir toDir+ ls from >>= mapM_+ (\item -> cp_r (from FP.</> filename item) (toDir 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.@@ -800,7 +823,7 @@ ReThrownException e (extraMsg to_loc from') ) where- extraMsg t f = "when copying from: " ++ unpack f ++ " to: " ++ unpack t+ extraMsg t f = "during copy from: " ++ unpack f ++ " to: " ++ unpack t -- | for 'grep' class PredicateLike pattern hay where
shelly.cabal view
@@ -1,6 +1,6 @@ Name: shelly -Version: 0.8.0.2+Version: 0.9.0 Synopsis: shell-like (systems) programming in Haskell Description: Shelly provides a single module for convenient