{-# LANGUAGE CPP, FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, UndecidableInstances #-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
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 :: forall maker text result char.
(ProcessMaker maker, ProcessResult text result,
ListLikeProcessIO text char) =>
maker -> text -> IO result
readCreateProcess = maker -> text -> IO result
forall maker text result char.
(ProcessMaker maker, ProcessResult text result,
ListLikeProcessIO text char) =>
maker -> text -> IO result
readCreateProcessLazy
instance ListLikeProcessIO String Char where
forceOutput :: String -> IO String
forceOutput = String -> IO String
forall a. a -> IO a
evaluate (String -> IO String) -> (String -> String) -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. NFData a => a -> a
force
readChunks :: Handle -> IO [String]
readChunks Handle
h = do
Text
t <- Handle -> IO Text
forall full item. ListLikeIO full item => Handle -> IO full
hGetContents Handle
h :: IO Text
[String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
unpack ([Text] -> [String]) -> [Text] -> [String]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
toChunks Text
t
data Chunk a
= ProcessHandle ProcessHandle
| Stdout a
| Stderr a
| Result ExitCode
| Exception SomeException
deriving Int -> Chunk a -> String -> String
[Chunk a] -> String -> String
Chunk a -> String
(Int -> Chunk a -> String -> String)
-> (Chunk a -> String)
-> ([Chunk a] -> String -> String)
-> Show (Chunk a)
forall a. Show a => Int -> Chunk a -> String -> String
forall a. Show a => [Chunk a] -> String -> String
forall a. Show a => Chunk a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Chunk a -> String -> String
showsPrec :: Int -> Chunk a -> String -> String
$cshow :: forall a. Show a => Chunk a -> String
show :: Chunk a -> String
$cshowList :: forall a. Show a => [Chunk a] -> String -> String
showList :: [Chunk a] -> String -> String
Show
instance Show ProcessHandle where
show :: ProcessHandle -> String
show ProcessHandle
_ = String
"<process>"
instance ListLikeProcessIO a c => ProcessResult a [Chunk a] where
pidf :: ProcessHandle -> [Chunk a]
pidf ProcessHandle
p = [ProcessHandle -> Chunk a
forall a. ProcessHandle -> Chunk a
ProcessHandle ProcessHandle
p]
outf :: a -> [Chunk a]
outf a
x = [a -> Chunk a
forall a. a -> Chunk a
Stdout a
x]
errf :: a -> [Chunk a]
errf a
x = [a -> Chunk a
forall a. a -> Chunk a
Stderr a
x]
intf :: SomeException -> [Chunk a]
intf SomeException
e = SomeException -> [Chunk a]
forall a e. Exception e => e -> a
throw SomeException
e
codef :: ExitCode -> [Chunk a]
codef ExitCode
c = [ExitCode -> Chunk a
forall a. ExitCode -> Chunk a
Result ExitCode
c]
instance ListLikeProcessIO a c => ProcessResult a (ExitCode, [Chunk a]) where
pidf :: ProcessHandle -> (ExitCode, [Chunk a])
pidf ProcessHandle
p = (ExitCode
forall a. Monoid a => a
mempty, [ProcessHandle -> Chunk a
forall a. ProcessHandle -> Chunk a
ProcessHandle ProcessHandle
p])
codef :: ExitCode -> (ExitCode, [Chunk a])
codef ExitCode
c = (ExitCode
c, [Chunk a]
forall a. Monoid a => a
mempty)
outf :: a -> (ExitCode, [Chunk a])
outf a
x = (ExitCode
forall a. Monoid a => a
mempty, [a -> Chunk a
forall a. a -> Chunk a
Stdout a
x])
errf :: a -> (ExitCode, [Chunk a])
errf a
x = (ExitCode
forall a. Monoid a => a
mempty, [a -> Chunk a
forall a. a -> Chunk a
Stderr a
x])
intf :: SomeException -> (ExitCode, [Chunk a])
intf SomeException
e = SomeException -> (ExitCode, [Chunk a])
forall a e. Exception e => e -> a
throw SomeException
e
foldOutput :: (ProcessHandle -> r)
-> (a -> r)
-> (a -> r)
-> (SomeException -> r)
-> (ExitCode -> r)
-> Chunk a
-> r
foldOutput :: forall r a.
(ProcessHandle -> r)
-> (a -> r)
-> (a -> r)
-> (SomeException -> r)
-> (ExitCode -> r)
-> Chunk a
-> r
foldOutput ProcessHandle -> r
p a -> r
_ a -> r
_ SomeException -> r
_ ExitCode -> r
_ (ProcessHandle ProcessHandle
x) = ProcessHandle -> r
p ProcessHandle
x
foldOutput ProcessHandle -> r
_ a -> r
o a -> r
_ SomeException -> r
_ ExitCode -> r
_ (Stdout a
x) = a -> r
o a
x
foldOutput ProcessHandle -> r
_ a -> r
_ a -> r
e SomeException -> r
_ ExitCode -> r
_ (Stderr a
x) = a -> r
e a
x
foldOutput ProcessHandle -> r
_ a -> r
_ a -> r
_ SomeException -> r
i ExitCode -> r
_ (Exception SomeException
x) = SomeException -> r
i SomeException
x
foldOutput ProcessHandle -> r
_ a -> r
_ a -> r
_ SomeException -> r
_ ExitCode -> r
r (Result ExitCode
x) = ExitCode -> r
r ExitCode
x
collectOutput :: ProcessResult a b => [Chunk a] -> b
collectOutput :: forall a b. ProcessResult a b => [Chunk a] -> b
collectOutput [Chunk a]
xs = [b] -> b
forall a. Monoid a => [a] -> a
mconcat ([b] -> b) -> [b] -> b
forall a b. (a -> b) -> a -> b
$ (Chunk a -> b) -> [Chunk a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ((ProcessHandle -> b)
-> (a -> b)
-> (a -> b)
-> (SomeException -> b)
-> (ExitCode -> b)
-> Chunk a
-> b
forall r a.
(ProcessHandle -> r)
-> (a -> r)
-> (a -> r)
-> (SomeException -> r)
-> (ExitCode -> r)
-> Chunk a
-> r
foldOutput ProcessHandle -> b
forall text result.
ProcessResult text result =>
ProcessHandle -> result
pidf a -> b
forall text result. ProcessResult text result => text -> result
outf a -> b
forall text result. ProcessResult text result => text -> result
errf SomeException -> b
forall text result.
ProcessResult text result =>
SomeException -> result
intf ExitCode -> b
forall text result. ProcessResult text result => ExitCode -> result
codef) [Chunk a]
xs
writeOutput :: ListLikeIO a c => [Chunk a] -> IO [Chunk a]
writeOutput :: forall a c. ListLikeIO a c => [Chunk a] -> IO [Chunk a]
writeOutput [] = [Chunk a] -> IO [Chunk a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
writeOutput (Chunk a
x : [Chunk a]
xs) = (:) (Chunk a -> [Chunk a] -> [Chunk a])
-> IO (Chunk a) -> IO ([Chunk a] -> [Chunk a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Chunk a -> IO (Chunk a)
forall a c. ListLikeIO a c => Chunk a -> IO (Chunk a)
writeChunk Chunk a
x IO ([Chunk a] -> [Chunk a]) -> IO [Chunk a] -> IO [Chunk a]
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Chunk a] -> IO [Chunk a]
forall a c. ListLikeIO a c => [Chunk a] -> IO [Chunk a]
writeOutput [Chunk a]
xs
writeChunk :: ListLikeIO a c => Chunk a -> IO (Chunk a)
writeChunk :: forall a c. ListLikeIO a c => Chunk a -> IO (Chunk a)
writeChunk Chunk a
x =
(ProcessHandle -> IO (Chunk a))
-> (a -> IO (Chunk a))
-> (a -> IO (Chunk a))
-> (SomeException -> IO (Chunk a))
-> (ExitCode -> IO (Chunk a))
-> Chunk a
-> IO (Chunk a)
forall r a.
(ProcessHandle -> r)
-> (a -> r)
-> (a -> r)
-> (SomeException -> r)
-> (ExitCode -> r)
-> Chunk a
-> r
foldOutput (\ProcessHandle
_ -> Chunk a -> IO (Chunk a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Chunk a
x)
(\a
s -> Handle -> a -> IO ()
forall full item. ListLikeIO full item => Handle -> full -> IO ()
hPutStr Handle
stdout a
s IO () -> IO (Chunk a) -> IO (Chunk a)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Chunk a -> IO (Chunk a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Chunk a
x)
(\a
s -> Handle -> a -> IO ()
forall full item. ListLikeIO full item => Handle -> full -> IO ()
hPutStr Handle
stderr a
s IO () -> IO (Chunk a) -> IO (Chunk a)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Chunk a -> IO (Chunk a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Chunk a
x)
(\SomeException
_ -> Chunk a -> IO (Chunk a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Chunk a
x)
(\ExitCode
_ -> Chunk a -> IO (Chunk a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Chunk a
x) Chunk a
x