shelly 1.1.0.0 → 1.2.0.0

raw patch · 3 files changed

+105/−58 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• shelly.cabal +1/−1
• src/Shelly.hs +98/−55
• src/Shelly/Base.hs +6/−2

@@ -1,6 +1,6 @@ Name:       shelly -Version:     1.1.0.0+Version:     1.2.0.0 Synopsis:    shell-like (systems) programming in Haskell  Description: Shelly provides convenient systems programming in Haskell,

@@ -26,12 +26,17 @@          Sh, ShIO, shelly, shellyNoDir, sub, silently, verbosely, escaping, print_stdout, print_commands, tracing, errExit           -- * Running external commands.-         , run, run_, runFoldLines, cmd, FoldCallback, runHandle, runHandles+         , run, run_, runFoldLines, cmd, FoldCallback          , (-|-), lastStderr, setStdin, lastExitCode          , command, command_, command1, command1_          , sshPairs, sshPairs_          , ShellArg (..) +         -- * Running commands Using handles+         , runHandle, runHandles, transferLinesAndCombine, transferFoldHandleLines+         , ReusedHandle(..)++          -- * Modifying and querying environment.          , setenv, get_env, get_env_text, getenv, get_env_def, appendToPath @@ -94,6 +99,7 @@ import Data.Foldable (foldl') 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@@ -105,20 +111,18 @@ 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 )-import System.IO.Error (isPermissionError)  import qualified Data.Text as T import qualified Data.ByteString as BS import Data.ByteString (ByteString) -import Data.Monoid (mempty)+import Data.Monoid (Monoid, mempty, mappend) #if __GLASGOW_HASKELL__ < 704-import Data.Monoid (Monoid, mappend) infixr 5 <> (<>) :: Monoid m => m -> m -> m (<>) = mappend #else-import Data.Monoid ( mappend, (<>))+import Data.Monoid ((<>)) #endif  import Filesystem.Path.CurrentOS hiding (concat, fromText, (</>), (<.>))@@ -169,7 +173,6 @@ instance ShellArg FilePath where toTextArg = toTextIgnore instance ShellArg String   where toTextArg = T.pack - -- | used to create the variadic function 'cmd' class ShellCommand t where     cmdAll :: FilePath -> [Text] -> t@@ -236,27 +239,38 @@ fromText :: Text -> FilePath fromText = FP.fromText -printGetTextList :: Handle -> Handle -> IO Text-printGetTextList h1 h2 = printFoldHandleLines mempty (|>) h1 h2 >>=+-- | 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 -> Handle -> IO Text+transferLinesAndCombine h1 h2 = transferFoldHandleLines mempty (|>) h1 h2 >>=     return . lineSeqToText  lineSeqToText :: Seq Text -> Text lineSeqToText = T.intercalate "\n" . foldl' (flip (:)) [] -{--getContent :: Handle -> IO Text-getContent h = fmap B.toLazyText $ foldHandleLines (B.fromText "") foldBuilder h--}- type FoldCallback a = (a -> Text -> a) -printFoldHandleLines :: a -> FoldCallback a -> Handle -> Handle -> IO a-printFoldHandleLines start foldLine readHandle writeHandle = go start+-- | 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 -> Handle -> IO a+transferFoldHandleLines start foldLine readHandle writeHandle = go start   where+    catchIOErrors action = catchIOError+                   (fmap Just action)+                   (\e -> if isEOFError e || isIllegalOperation e -- handle was closed+                           then return Nothing+                           else ioError e)     go acc = do-      line <- TIO.hGetLine readHandle-      TIO.hPutStrLn writeHandle line >> go (foldLine acc line)-     `catchany` \_ -> return acc+        mLine <- catchIOErrors (TIO.hGetLine readHandle)+        case mLine of+            Nothing -> return acc+            Just line -> TIO.hPutStrLn writeHandle line >> go (foldLine acc line)  foldHandleLines :: a -> FoldCallback a -> Handle -> IO a foldHandleLines start foldLine readHandle = go start@@ -277,13 +291,13 @@   stateVar <- ask   liftIO (writeIORef stateVar newState) -runCommandNoEscape :: (Maybe Handle) -> State -> FilePath -> [Text] -> Sh (Handle, Handle, Handle, ProcessHandle)-runCommandNoEscape mstdin st exe args = liftIO $ shellyProcess mstdin st $+runCommandNoEscape :: [ReusedHandle] -> 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 :: (Maybe Handle) -> State -> FilePath -> [Text] -> Sh (Handle, Handle, Handle, ProcessHandle)-runCommand mstdin st exe args = findExe exe >>= \fullExe ->-  liftIO $ shellyProcess mstdin st $+runCommand :: [ReusedHandle] -> State -> FilePath -> [Text] -> Sh (Handle, Handle, Handle, ProcessHandle)+runCommand handles st exe args = findExe exe >>= \fullExe ->+  liftIO $ shellyProcess handles st $     RawCommand (unpack fullExe) (map T.unpack args)   where     findExe :: FilePath -> Sh FilePath@@ -310,23 +324,54 @@   -shellyProcess :: (Maybe Handle) -> State -> CmdSpec -> IO (Handle, Handle, Handle, ProcessHandle)-shellyProcess mstdin st cmdSpec =  do-  (Just hin, Just hout, Just herr, pHandle) <- createProcess CreateProcess {-        cmdspec = cmdSpec-      , cwd = Just $ unpack $ sDirectory st-      , env = Just $ sEnvironment st-      , std_in = case mstdin of-                   Nothing     -> CreatePipe-                   Just handle -> UseHandle handle-      , std_out = CreatePipe, std_err = CreatePipe-      , close_fds = False+shellyProcess :: [ReusedHandle] -> State -> CmdSpec -> IO (Handle, Handle, Handle, ProcessHandle)+shellyProcess reusedHandles st cmdSpec =  do+    (createdInH, createdOutH, createdErrorH, pHandle) <- createProcess CreateProcess {+          cmdspec = cmdSpec+        , cwd = Just $ unpack $ sDirectory st+        , env = Just $ sEnvironment st+        , std_in  = reuse mIn+        , std_out = reuse mOut+        , std_err = reuse mError+        , close_fds = False #if MIN_VERSION_process(1,1,0)-      , create_group = False+        , create_group = False #endif-      }-  return (hin, hout, herr, pHandle)+        }+    return (just $ createdInH <|> mInH,+            just $ createdOutH <|> mOutH,+            just $ createdErrorH <|> mErrorH, pHandle)+  where+    just :: Maybe a -> a+    just Nothing  = error "error in shelly creating process"+    just (Just j) = j +    mInH    = getHandle mIn reusedHandles+    mOutH   = getHandle mOut reusedHandles+    mErrorH = getHandle mError reusedHandles++    reuse :: (ReusedHandle -> Maybe Handle) -> StdStream+    reuse mHandle = createOrUse $ getHandle mHandle reusedHandles++    getHandle :: (ReusedHandle -> Maybe Handle) -> [ReusedHandle] -> Maybe Handle+    getHandle _ [] = Nothing+    getHandle mHandle (h:hs) = case mHandle h of+        Just already -> Just already+        Nothing -> getHandle mHandle hs++    createOrUse :: Maybe Handle -> StdStream+    createOrUse mHandle = case mHandle of+        Just already -> UseHandle already+        Nothing -> CreatePipe++    mIn, mOut, mError :: (ReusedHandle -> Maybe Handle)+    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@@ -935,15 +980,13 @@           -> (Handle -> Sh a) -- ^ stdout handle           -> Sh a runHandle exe args withHandle = -  runHandles exe args Nothing $ \outH errH -> do+  runHandles exe args [] $ \_ outH errH -> do     errVar <- liftIO $ do       errVar' <- newEmptyMVar-      _ <- forkIO $ printGetTextList errH stderr >>= putMVar errVar'+      _ <- forkIO $ transferLinesAndCombine errH stderr >>= putMVar errVar'       return errVar'-      -- liftIO_ $ forkIO $ getContent errH >>= putMVar errVar-      ---    res <- withHandle outH +    res <- withHandle outH     errs <- liftIO $ takeMVar errVar      modify $ \state' -> state' { sStderr = errs }@@ -952,10 +995,10 @@ -- | Similar to 'run' but gives direct access to all input and output handles. runHandles :: FilePath -- ^ command            -> [Text] -- ^ arguments-           -> (Maybe Handle) -- ^ stdin-           -> (Handle -> Handle -> Sh a) -- ^ stdout and stderr+           -> [ReusedHandle] -- ^ optionally connect process i/o handles to existing handles+           -> (Handle -> Handle -> Handle -> Sh a) -- ^ stdin, stdout and stderr            -> Sh a-runHandles exe args mStdinHandle withHandles = do+runHandles exe args reusedHandles withHandles = do     -- clear stdin before beginning command execution     origstate <- get     let mStdin = sStdin origstate@@ -967,22 +1010,22 @@     trace cmdString      bracketOnWindowsError-      ((sRun state) mStdinHandle state exe args)+      ((sRun state) reusedHandles state exe args)       (\(_,_,_,procH) -> (liftIO $ terminateProcess procH))       (\(inH,outH,errH,procH) -> do         liftIO $ case mStdin of-          Just input ->-            TIO.hPutStr inH input >> hClose inH-            -- stdin is cleared from state below+          Just input -> TIO.hPutStr inH input           Nothing -> return () -        result <- withHandles outH errH+        result <- withHandles inH outH errH          (ex, code) <- liftIO $ do+          ex' <- waitForProcess procH+           hClose outH           hClose errH+          hClose inH -          ex' <- waitForProcess procH           return $ case ex' of             ExitSuccess -> (ex', 0)             ExitFailure n -> (ex', n)@@ -1013,19 +1056,19 @@ -- 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 Nothing $ \outH errH -> do+  runHandles exe args [] $ \inH outH errH -> do     (errVar, outVar) <- liftIO $ do+      hClose inH -- setStdin was taken care of before the process even ran       errVar' <- newEmptyMVar       outVar' <- newEmptyMVar-      _ <- forkIO $ printGetTextList errH stderr >>= putMVar errVar'+      _ <- forkIO $ transferLinesAndCombine errH stderr >>= putMVar errVar'       return (errVar', outVar')-      -- liftIO_ $ forkIO $ getContent errH >>= putMVar errVar      state <- get     errs <- liftIO $ do       void $ if sPrintStdout state         then-          forkIO $ printFoldHandleLines start cb outH stdout >>= putMVar outVar+          forkIO $ transferFoldHandleLines start cb outH stdout >>= putMVar outVar         else           forkIO $ foldHandleLines start cb outH >>= putMVar outVar       takeMVar errVar

@@ -6,7 +6,7 @@ -- However, Shelly went back to exposing a single module module Shelly.Base   (-    ShIO, Sh, unSh, runSh, State(..), FilePath, Text,+    ShIO, Sh, unSh, runSh, State(..), ReusedHandle(..), FilePath, Text,     relPath, path, absPath, canonic, canonicalize,     test_d, test_s,     unpack, gets, get, modify, trace,@@ -67,13 +67,17 @@    , sDirectory :: FilePath -- ^ working directory    , sPrintStdout :: Bool   -- ^ print stdout of command that is executed    , sPrintCommands :: Bool -- ^ print command that is executed-   , sRun :: (Maybe Handle) -> 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+   , sRun :: [ReusedHandle] -> 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)]    , 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    }++data ReusedHandle = InHandle Handle+                  | OutHandle Handle+                  | ErrorHandle Handle  -- | A monadic-conditional version of the "when" guard. whenM :: Monad m => m Bool -> m () -> m ()