module System.Process.ListLike
( ListLikeProcessIO(forceOutput)
, ProcessOutput(pidf, outf, errf, codef, intf)
, readCreateProcess
, readCreateProcessLazy
, readCreateProcessWithExitCode
, readProcessWithExitCode
, Chunk(..)
, collectOutput
, showCreateProcessForUser
, showCmdSpecForUser
) where
import Control.DeepSeq (force)
import Control.Exception as C (evaluate, SomeException, throw)
import Data.ListLike.IO (hGetContents)
import Data.Monoid (mempty, mconcat)
import Data.Text (unpack)
import Data.Text.Lazy (Text, toChunks)
import System.Exit (ExitCode)
import System.Process (CmdSpec(..), CreateProcess(..), ProcessHandle, showCommandForUser)
import System.Process.ByteString ()
import System.Process.ByteString.Lazy ()
import System.Process.Common (ListLikeProcessIO(forceOutput, readChunks), ProcessOutput(pidf, outf, errf, codef, intf),
readCreateProcess, readCreateProcessLazy, readCreateProcessWithExitCode, readProcessWithExitCode)
import System.Process.Text ()
import System.Process.Text.Lazy ()
showCreateProcessForUser :: CreateProcess -> String
showCreateProcessForUser p =
showCmdSpecForUser (cmdspec p) ++ maybe "" (\ d -> " (in " ++ d ++ ")") (cwd p)
showCmdSpecForUser :: CmdSpec -> String
showCmdSpecForUser (ShellCommand s) = s
showCmdSpecForUser (RawCommand p args) = showCommandForUser p args
instance ListLikeProcessIO String Char where
forceOutput = evaluate . force
readChunks h = do
t <- hGetContents h :: IO Text
return $ map unpack $ toChunks t
data Chunk a
= ProcessHandle ProcessHandle
| Stdout a
| Stderr a
| Result ExitCode
| Exception SomeException
instance ListLikeProcessIO a c => ProcessOutput a [Chunk a] where
pidf p = [ProcessHandle p]
outf x = [Stdout x]
errf x = [Stderr x]
intf e = throw e
codef c = [Result c]
instance ListLikeProcessIO a c => ProcessOutput a (ExitCode, [Chunk a]) where
pidf p = (mempty, [ProcessHandle p])
codef c = (c, mempty)
outf x = (mempty, [Stdout x])
errf x = (mempty, [Stderr x])
intf e = throw e
collectOutput :: ProcessOutput a b => [Chunk a] -> b
collectOutput xs = mconcat $ map (\ chunk -> case chunk of
ProcessHandle x -> pidf x
Stdout x -> outf x
Stderr x -> errf x
Result x -> codef x
Exception x -> intf x) xs