module System.Process.ListLike
(
ListLikeProcessIO(forceOutput)
, ProcessText
, ProcessResult(pidf, outf, errf, codef, intf)
, ProcessMaker(process, showProcessMakerForUser)
, readCreateProcess
, readCreateProcessStrict
, readCreateProcessLazy
, readCreateProcessWithExitCode
, readProcessWithExitCode
, showCreateProcessForUser
, showCmdSpecForUser
, Chunk(..)
, collectOutput
, foldOutput
, writeOutput
, writeChunk
, CmdSpec(..)
, CreateProcess(..)
, proc
, shell
, showCommandForUser
) where
import Control.DeepSeq (force)
import Control.Exception as C (evaluate, SomeException, throw)
import Data.ListLike.IO (hGetContents, hPutStr, ListLikeIO)
#if __GLASGOW_HASKELL__ <= 709
import Control.Applicative ((<$>), (<*>))
import Data.Monoid (mempty, mconcat)
#endif
import Data.Text (unpack)
import Data.Text.Lazy (Text, toChunks)
import System.Exit (ExitCode)
import System.IO (stdout, stderr)
import System.Process (CmdSpec(..), CreateProcess(..), proc, ProcessHandle, shell, showCommandForUser)
import System.Process.ByteString ()
import System.Process.ByteString.Lazy ()
import System.Process.Common
(ProcessMaker(process, showProcessMakerForUser), ListLikeProcessIO(forceOutput, readChunks),
ProcessText, ProcessResult(pidf, outf, errf, codef, intf), readCreateProcessStrict, readCreateProcessLazy,
readCreateProcessWithExitCode, readProcessWithExitCode, showCmdSpecForUser, showCreateProcessForUser)
import System.Process.Text ()
import System.Process.Text.Builder ()
import System.Process.Text.Lazy ()
instance ProcessText String Char
readCreateProcess :: (ProcessMaker maker, ProcessResult text result, ListLikeProcessIO text char) => maker -> text -> IO result
readCreateProcess = readCreateProcessLazy
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
deriving Show
instance Show ProcessHandle where
show _ = "<process>"
instance ListLikeProcessIO a c => ProcessResult 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 => ProcessResult 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
foldOutput :: (ProcessHandle -> r)
-> (a -> r)
-> (a -> r)
-> (SomeException -> r)
-> (ExitCode -> r)
-> Chunk a
-> r
foldOutput p _ _ _ _ (ProcessHandle x) = p x
foldOutput _ o _ _ _ (Stdout x) = o x
foldOutput _ _ e _ _ (Stderr x) = e x
foldOutput _ _ _ i _ (Exception x) = i x
foldOutput _ _ _ _ r (Result x) = r x
collectOutput :: ProcessResult a b => [Chunk a] -> b
collectOutput xs = mconcat $ map (foldOutput pidf outf errf intf codef) xs
writeOutput :: ListLikeIO a c => [Chunk a] -> IO [Chunk a]
writeOutput [] = return []
writeOutput (x : xs) = (:) <$> writeChunk x <*> writeOutput xs
writeChunk :: ListLikeIO a c => Chunk a -> IO (Chunk a)
writeChunk x =
foldOutput (\_ -> return x)
(\s -> hPutStr stdout s >> return x)
(\s -> hPutStr stderr s >> return x)
(\_ -> return x)
(\_ -> return x) x