{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Data.Conduit.Shell.Process
(
run
,text
,bytes
,conduit
,conduitEither
,Data.Conduit.Shell.Process.shell
,Data.Conduit.Shell.Process.proc
,($|)
,Segment
,ProcessException(..)
,ToChunk(..)
,tryS
)
where
import Control.Applicative
import Control.Concurrent.Async
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Data.ByteString (ByteString)
import qualified Data.ByteString as S
import Data.Conduit
import Data.Conduit.Binary
import qualified Data.Conduit.List as CL
import Data.Conduit.Text (encodeUtf8, decodeUtf8)
import Data.Text (Text)
import Data.Typeable
import System.Exit
import System.IO
import System.Posix.IO (createPipe, fdToHandle)
import System.Process hiding (createPipe)
data Segment r
= SegmentConduit (ConduitM ByteString (Either ByteString ByteString) IO r)
| SegmentProcess (Handles -> IO r)
instance Monad Segment where
return :: a -> Segment a
return = ConduitM ByteString (Either ByteString ByteString) IO a
-> Segment a
forall r.
ConduitM ByteString (Either ByteString ByteString) IO r
-> Segment r
SegmentConduit (ConduitM ByteString (Either ByteString ByteString) IO a
-> Segment a)
-> (a -> ConduitM ByteString (Either ByteString ByteString) IO a)
-> a
-> Segment a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ConduitM ByteString (Either ByteString ByteString) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
SegmentConduit c :: ConduitM ByteString (Either ByteString ByteString) IO a
c >>= :: Segment a -> (a -> Segment b) -> Segment b
>>= f :: a -> Segment b
f =
(Handles -> IO a) -> Segment a
forall r. (Handles -> IO r) -> Segment r
SegmentProcess (ConduitM ByteString (Either ByteString ByteString) IO a
-> Handles -> IO a
forall r.
ConduitT ByteString (Either ByteString ByteString) IO r
-> Handles -> IO r
conduitToProcess ConduitM ByteString (Either ByteString ByteString) IO a
c) Segment a -> (a -> Segment b) -> Segment b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
a -> Segment b
f
SegmentProcess f :: Handles -> IO a
f >>= g :: a -> Segment b
g =
(Handles -> IO b) -> Segment b
forall r. (Handles -> IO r) -> Segment r
SegmentProcess
(\handles :: Handles
handles ->
do a
x <- Handles -> IO a
f Handles
handles
case a -> Segment b
g a
x of
SegmentConduit c :: ConduitM ByteString (Either ByteString ByteString) IO b
c ->
ConduitM ByteString (Either ByteString ByteString) IO b
-> Handles -> IO b
forall r.
ConduitT ByteString (Either ByteString ByteString) IO r
-> Handles -> IO r
conduitToProcess ConduitM ByteString (Either ByteString ByteString) IO b
c Handles
handles
SegmentProcess p :: Handles -> IO b
p -> Handles -> IO b
p Handles
handles)
instance Functor Segment where
fmap :: (a -> b) -> Segment a -> Segment b
fmap = (a -> b) -> Segment a -> Segment b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Applicative Segment where
<*> :: Segment (a -> b) -> Segment a -> Segment b
(<*>) = Segment (a -> b) -> Segment a -> Segment b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap; pure :: a -> Segment a
pure = a -> Segment a
forall (m :: * -> *) a. Monad m => a -> m a
return
instance Alternative Segment where
this :: Segment a
this <|> :: Segment a -> Segment a -> Segment a
<|> that :: Segment a
that =
do Either ProcessException a
ex <- Segment a -> Segment (Either ProcessException a)
forall e r. Exception e => Segment r -> Segment (Either e r)
tryS Segment a
this
case Either ProcessException a
ex of
Right x :: a
x -> a -> Segment a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
Left (ProcessException
_ :: ProcessException) -> Segment a
that
empty :: Segment a
empty = ProcessException -> Segment a
forall a e. Exception e => e -> a
throw ProcessException
ProcessEmpty
tryS :: Exception e => Segment r -> Segment (Either e r)
tryS :: Segment r -> Segment (Either e r)
tryS s :: Segment r
s =
case Segment r
s of
SegmentConduit c :: ConduitM ByteString (Either ByteString ByteString) IO r
c -> ConduitM ByteString (Either ByteString ByteString) IO (Either e r)
-> Segment (Either e r)
forall r.
ConduitM ByteString (Either ByteString ByteString) IO r
-> Segment r
SegmentConduit (ConduitM ByteString (Either ByteString ByteString) IO r
-> ConduitM
ByteString (Either ByteString ByteString) IO (Either e r)
forall (m :: * -> *) e i o r.
(MonadUnliftIO m, Exception e) =>
ConduitT i o m r -> ConduitT i o m (Either e r)
tryC ConduitM ByteString (Either ByteString ByteString) IO r
c)
SegmentProcess f :: Handles -> IO r
f -> (Handles -> IO (Either e r)) -> Segment (Either e r)
forall r. (Handles -> IO r) -> Segment r
SegmentProcess (\h :: Handles
h -> IO r -> IO (Either e r)
forall e a. Exception e => IO a -> IO (Either e a)
try (Handles -> IO r
f Handles
h))
instance MonadIO Segment where
liftIO :: IO a -> Segment a
liftIO x :: IO a
x = (Handles -> IO a) -> Segment a
forall r. (Handles -> IO r) -> Segment r
SegmentProcess (IO a -> Handles -> IO a
forall a b. a -> b -> a
const IO a
x)
data Handles =
Handles Handle
Handle
Handle
data ProcessException
= ProcessException CreateProcess
ExitCode
| ProcessEmpty
deriving (Typeable)
instance Exception ProcessException
instance Show ProcessException where
show :: ProcessException -> String
show ProcessEmpty = "empty process"
show (ProcessException cp :: CreateProcess
cp ec :: ExitCode
ec) =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ "The "
, case CreateProcess -> CmdSpec
cmdspec CreateProcess
cp of
ShellCommand s :: String
s -> "shell command " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s
RawCommand f :: String
f args :: [String]
args -> "raw command: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (String
f String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
forall a. Show a => a -> String
show [String]
args)
, " returned a failure exit code: "
, case ExitCode
ec of
ExitFailure i :: Int
i -> Int -> String
forall a. Show a => a -> String
show Int
i
_ -> ExitCode -> String
forall a. Show a => a -> String
show ExitCode
ec
]
class ToSegment a where
type SegmentResult a
toSegment :: a -> Segment (SegmentResult a)
instance ToSegment (Segment r) where
type SegmentResult (Segment r) = r
toSegment :: Segment r -> Segment (SegmentResult (Segment r))
toSegment = Segment r -> Segment (SegmentResult (Segment r))
forall a. a -> a
id
instance (a ~ ByteString, ToChunk b, m ~ IO) =>
ToSegment (ConduitT a b m r) where
type SegmentResult (ConduitT a b m r) = r
toSegment :: ConduitT a b m r -> Segment (SegmentResult (ConduitT a b m r))
toSegment f :: ConduitT a b m r
f = ConduitM ByteString (Either ByteString ByteString) IO r
-> Segment r
forall r.
ConduitM ByteString (Either ByteString ByteString) IO r
-> Segment r
SegmentConduit (ConduitT a b m r
f ConduitT a b m r
-> Conduit b m (Either ByteString ByteString)
-> ConduitT a (Either ByteString ByteString) m r
forall (m :: * -> *) a b r c.
Monad m =>
ConduitT a b m r -> Conduit b m c -> ConduitT a c m r
`fuseUpstream` (b -> Either ByteString ByteString)
-> Conduit b m (Either ByteString ByteString)
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
CL.map b -> Either ByteString ByteString
forall a. ToChunk a => a -> Either ByteString ByteString
toChunk)
instance ToSegment CreateProcess where
type SegmentResult CreateProcess = ()
toSegment :: CreateProcess -> Segment (SegmentResult CreateProcess)
toSegment = CreateProcess -> Segment ()
CreateProcess -> Segment (SegmentResult CreateProcess)
liftProcess
class ToChunk a where
toChunk :: a -> Either ByteString ByteString
instance ToChunk ByteString where
toChunk :: ByteString -> Either ByteString ByteString
toChunk = ByteString -> Either ByteString ByteString
forall a b. a -> Either a b
Left
instance ToChunk (Either ByteString ByteString) where
toChunk :: Either ByteString ByteString -> Either ByteString ByteString
toChunk = Either ByteString ByteString -> Either ByteString ByteString
forall a. a -> a
id
shell :: String -> Segment ()
shell :: String -> Segment ()
shell = CreateProcess -> Segment ()
liftProcess (CreateProcess -> Segment ())
-> (String -> CreateProcess) -> String -> Segment ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CreateProcess
System.Process.shell
proc :: String -> [String] -> Segment ()
proc :: String -> [String] -> Segment ()
proc name :: String
name args :: [String]
args = CreateProcess -> Segment ()
liftProcess (String -> [String] -> CreateProcess
System.Process.proc String
name [String]
args)
run :: Segment r -> IO r
run :: Segment r -> IO r
run (SegmentConduit c :: ConduitM ByteString (Either ByteString ByteString) IO r
c) = Segment r -> IO r
forall r. Segment r -> IO r
run ((Handles -> IO r) -> Segment r
forall r. (Handles -> IO r) -> Segment r
SegmentProcess (ConduitM ByteString (Either ByteString ByteString) IO r
-> Handles -> IO r
forall r.
ConduitT ByteString (Either ByteString ByteString) IO r
-> Handles -> IO r
conduitToProcess ConduitM ByteString (Either ByteString ByteString) IO r
c))
run (SegmentProcess p :: Handles -> IO r
p) = Handles -> IO r
p (Handle -> Handle -> Handle -> Handles
Handles Handle
stdin Handle
stdout Handle
stderr)
($|) :: Segment () -> Segment b -> Segment b
x :: Segment ()
x $| :: Segment () -> Segment b -> Segment b
$| y :: Segment b
y = Segment ()
x Segment () -> Segment b -> Segment b
forall r. Segment () -> Segment r -> Segment r
`fuseSegment` Segment b
y
infixl 0 $|
text
:: (r ~ (), m ~ IO)
=> ConduitT Text Text m r -> Segment r
text :: ConduitT Text Text m r -> Segment r
text conduit' :: ConduitT Text Text m r
conduit' = ConduitT ByteString ByteString m () -> Segment ()
forall a (m :: * -> *) r.
(a ~ ByteString, m ~ IO) =>
ConduitT a ByteString m r -> Segment r
bytes (ConduitT ByteString Text m ()
forall (m :: * -> *). MonadThrow m => ConduitT ByteString Text m ()
decodeUtf8 ConduitT ByteString Text m ()
-> ConduitM Text ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT Text Text m r
ConduitT Text Text m ()
conduit' ConduitT Text Text m ()
-> ConduitM Text ByteString m () -> ConduitM Text ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM Text ByteString m ()
forall (m :: * -> *) text binary.
(Monad m, Utf8 text binary) =>
ConduitT text binary m ()
encodeUtf8)
bytes
:: (a ~ ByteString, m ~ IO)
=> ConduitT a ByteString m r -> Segment r
bytes :: ConduitT a ByteString m r -> Segment r
bytes f :: ConduitT a ByteString m r
f = ConduitM ByteString (Either ByteString ByteString) IO r
-> Segment r
forall r.
ConduitM ByteString (Either ByteString ByteString) IO r
-> Segment r
SegmentConduit (ConduitT a ByteString m r
f ConduitT a ByteString m r
-> Conduit ByteString m (Either ByteString ByteString)
-> ConduitT a (Either ByteString ByteString) m r
forall (m :: * -> *) a b r c.
Monad m =>
ConduitT a b m r -> Conduit b m c -> ConduitT a c m r
`fuseUpstream` (ByteString -> Either ByteString ByteString)
-> Conduit ByteString m (Either ByteString ByteString)
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
CL.map ByteString -> Either ByteString ByteString
forall a. ToChunk a => a -> Either ByteString ByteString
toChunk)
conduit
:: (a ~ ByteString, m ~ IO)
=> ConduitT a ByteString m r -> Segment r
conduit :: ConduitT a ByteString m r -> Segment r
conduit f :: ConduitT a ByteString m r
f = ConduitM ByteString (Either ByteString ByteString) IO r
-> Segment r
forall r.
ConduitM ByteString (Either ByteString ByteString) IO r
-> Segment r
SegmentConduit (ConduitT a ByteString m r
f ConduitT a ByteString m r
-> Conduit ByteString m (Either ByteString ByteString)
-> ConduitT a (Either ByteString ByteString) m r
forall (m :: * -> *) a b r c.
Monad m =>
ConduitT a b m r -> Conduit b m c -> ConduitT a c m r
`fuseUpstream` (ByteString -> Either ByteString ByteString)
-> Conduit ByteString m (Either ByteString ByteString)
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
CL.map ByteString -> Either ByteString ByteString
forall a. ToChunk a => a -> Either ByteString ByteString
toChunk)
conduitEither
:: (a ~ ByteString, m ~ IO)
=> ConduitT a (Either ByteString ByteString) m r -> Segment r
conduitEither :: ConduitT a (Either ByteString ByteString) m r -> Segment r
conduitEither f :: ConduitT a (Either ByteString ByteString) m r
f = ConduitM ByteString (Either ByteString ByteString) IO r
-> Segment r
forall r.
ConduitM ByteString (Either ByteString ByteString) IO r
-> Segment r
SegmentConduit (ConduitT a (Either ByteString ByteString) m r
f ConduitT a (Either ByteString ByteString) m r
-> Conduit
(Either ByteString ByteString) m (Either ByteString ByteString)
-> ConduitT a (Either ByteString ByteString) m r
forall (m :: * -> *) a b r c.
Monad m =>
ConduitT a b m r -> Conduit b m c -> ConduitT a c m r
`fuseUpstream` (Either ByteString ByteString -> Either ByteString ByteString)
-> Conduit
(Either ByteString ByteString) m (Either ByteString ByteString)
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
CL.map Either ByteString ByteString -> Either ByteString ByteString
forall a. ToChunk a => a -> Either ByteString ByteString
toChunk)
liftProcess :: CreateProcess -> Segment ()
liftProcess :: CreateProcess -> Segment ()
liftProcess cp :: CreateProcess
cp =
(Handles -> IO ()) -> Segment ()
forall r. (Handles -> IO r) -> Segment r
SegmentProcess
(\(Handles inh :: Handle
inh outh :: Handle
outh errh :: Handle
errh) ->
let config :: CreateProcess
config =
CreateProcess
cp
{ std_in :: StdStream
std_in = Handle -> StdStream
UseHandle Handle
inh
, std_out :: StdStream
std_out = Handle -> StdStream
UseHandle Handle
outh
, std_err :: StdStream
std_err = Handle -> StdStream
UseHandle Handle
errh
, close_fds :: Bool
close_fds = Bool
True
}
in do (Nothing, Nothing, Nothing, ph :: ProcessHandle
ph) <- String
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess_ "liftProcess" CreateProcess
config
ExitCode
ec <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph
case ExitCode
ec of
ExitSuccess -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> ProcessException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (CreateProcess -> ExitCode -> ProcessException
ProcessException CreateProcess
cp ExitCode
ec))
conduitToProcess :: ConduitT ByteString (Either ByteString ByteString) IO r
-> (Handles -> IO r)
conduitToProcess :: ConduitT ByteString (Either ByteString ByteString) IO r
-> Handles -> IO r
conduitToProcess c :: ConduitT ByteString (Either ByteString ByteString) IO r
c (Handles inh :: Handle
inh outh :: Handle
outh errh :: Handle
errh) =
ConduitT () Void IO r -> IO r
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void IO r -> IO r) -> ConduitT () Void IO r -> IO r
forall a b. (a -> b) -> a -> b
$ Handle -> ConduitT () ByteString IO ()
forall (m :: * -> *) i.
MonadIO m =>
Handle -> ConduitT i ByteString m ()
sourceHandle Handle
inh ConduitT () ByteString IO ()
-> ConduitM ByteString Void IO r -> ConduitT () Void IO r
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT ByteString (Either ByteString ByteString) IO r
c ConduitT ByteString (Either ByteString ByteString) IO r
-> Conduit (Either ByteString ByteString) IO Void
-> ConduitM ByteString Void IO r
forall (m :: * -> *) a b r c.
Monad m =>
ConduitT a b m r -> Conduit b m c -> ConduitT a c m r
`fuseUpstream` Handle -> Handle -> Conduit (Either ByteString ByteString) IO Void
sinkHandles Handle
outh Handle
errh
sinkHandles :: Handle
-> Handle
-> ConduitT (Either ByteString ByteString) Void IO ()
sinkHandles :: Handle -> Handle -> Conduit (Either ByteString ByteString) IO Void
sinkHandles out :: Handle
out err :: Handle
err =
(Either ByteString ByteString -> IO ())
-> Conduit (Either ByteString ByteString) IO Void
forall (m :: * -> *) a o.
Monad m =>
(a -> m ()) -> ConduitT a o m ()
CL.mapM_
(\ebs :: Either ByteString ByteString
ebs ->
case Either ByteString ByteString
ebs of
Left bs :: ByteString
bs -> Handle -> ByteString -> IO ()
S.hPut Handle
out ByteString
bs
Right bs :: ByteString
bs -> Handle -> ByteString -> IO ()
S.hPut Handle
err ByteString
bs)
createHandles :: IO (Handle, Handle)
createHandles :: IO (Handle, Handle)
createHandles =
IO (Handle, Handle) -> IO (Handle, Handle)
forall a. IO a -> IO a
mask_
(do (inFD :: Fd
inFD, outFD :: Fd
outFD) <- IO (Fd, Fd)
createPipe
Handle
x <- Fd -> IO Handle
fdToHandle Fd
inFD
Handle
y <- Fd -> IO Handle
fdToHandle Fd
outFD
Handle -> BufferMode -> IO ()
hSetBuffering Handle
x BufferMode
NoBuffering
Handle -> BufferMode -> IO ()
hSetBuffering Handle
y BufferMode
NoBuffering
(Handle, Handle) -> IO (Handle, Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
x, Handle
y))
fuseProcess :: (Handles -> IO ()) -> (Handles -> IO r) -> (Handles -> IO r)
fuseProcess :: (Handles -> IO ()) -> (Handles -> IO r) -> Handles -> IO r
fuseProcess left :: Handles -> IO ()
left right :: Handles -> IO r
right (Handles in1 :: Handle
in1 out2 :: Handle
out2 err :: Handle
err) = do
(in2 :: Handle
in2, out1 :: Handle
out1) <- IO (Handle, Handle)
createHandles
Concurrently r -> IO r
forall a. Concurrently a -> IO a
runConcurrently
(IO () -> Concurrently ()
forall a. IO a -> Concurrently a
Concurrently (Handles -> IO ()
left (Handle -> Handle -> Handle -> Handles
Handles Handle
in1 Handle
out1 Handle
err) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
hClose Handle
out1) Concurrently () -> Concurrently r -> Concurrently r
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
IO r -> Concurrently r
forall a. IO a -> Concurrently a
Concurrently (Handles -> IO r
right (Handle -> Handle -> Handle -> Handles
Handles Handle
in2 Handle
out2 Handle
err) IO r -> IO () -> IO r
forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
hClose Handle
in2))
fuseConduit
:: Monad m
=> ConduitT ByteString (Either ByteString ByteString) m ()
-> ConduitT ByteString (Either ByteString ByteString) m r
-> ConduitT ByteString (Either ByteString ByteString) m r
fuseConduit :: ConduitT ByteString (Either ByteString ByteString) m ()
-> ConduitT ByteString (Either ByteString ByteString) m r
-> ConduitT ByteString (Either ByteString ByteString) m r
fuseConduit left :: ConduitT ByteString (Either ByteString ByteString) m ()
left right :: ConduitT ByteString (Either ByteString ByteString) m r
right = ConduitT ByteString (Either ByteString ByteString) m ()
left ConduitT ByteString (Either ByteString ByteString) m ()
-> ConduitM
(Either ByteString ByteString) (Either ByteString ByteString) m r
-> ConduitT ByteString (Either ByteString ByteString) m r
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ZipConduit
(Either ByteString ByteString) (Either ByteString ByteString) m r
-> ConduitM
(Either ByteString ByteString) (Either ByteString ByteString) m r
forall i o (m :: * -> *) r. ZipConduit i o m r -> ConduitT i o m r
getZipConduit ZipConduit
(Either ByteString ByteString) (Either ByteString ByteString) m r
right'
where
right' :: ZipConduit
(Either ByteString ByteString) (Either ByteString ByteString) m r
right' =
ConduitT
(Either ByteString ByteString) (Either ByteString ByteString) m ()
-> ZipConduit
(Either ByteString ByteString) (Either ByteString ByteString) m ()
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit ((Either ByteString ByteString -> Bool)
-> ConduitT
(Either ByteString ByteString) (Either ByteString ByteString) m ()
forall (m :: * -> *) a. Monad m => (a -> Bool) -> ConduitT a a m ()
CL.filter Either ByteString ByteString -> Bool
forall a b. Either a b -> Bool
isRight) ZipConduit
(Either ByteString ByteString) (Either ByteString ByteString) m ()
-> ZipConduit
(Either ByteString ByteString) (Either ByteString ByteString) m r
-> ZipConduit
(Either ByteString ByteString) (Either ByteString ByteString) m r
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
ConduitM
(Either ByteString ByteString) (Either ByteString ByteString) m r
-> ZipConduit
(Either ByteString ByteString) (Either ByteString ByteString) m r
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit ((Either ByteString ByteString -> Maybe ByteString)
-> ConduitT (Either ByteString ByteString) ByteString m ()
forall (m :: * -> *) a b.
Monad m =>
(a -> Maybe b) -> ConduitT a b m ()
CL.mapMaybe ((ByteString -> Maybe ByteString)
-> (ByteString -> Maybe ByteString)
-> Either ByteString ByteString
-> Maybe ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ByteString -> ByteString -> Maybe ByteString
forall a b. a -> b -> a
const Maybe ByteString
forall a. Maybe a
Nothing) ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just) ConduitT (Either ByteString ByteString) ByteString m ()
-> ConduitT ByteString (Either ByteString ByteString) m r
-> ConduitM
(Either ByteString ByteString) (Either ByteString ByteString) m r
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT ByteString (Either ByteString ByteString) m r
right)
isRight :: Either a b -> Bool
isRight Right {} = Bool
True
isRight Left {} = Bool
False
fuseConduitProcess
:: ConduitT ByteString (Either ByteString ByteString) IO ()
-> (Handles -> IO r)
-> (Handles -> IO r)
fuseConduitProcess :: ConduitT ByteString (Either ByteString ByteString) IO ()
-> (Handles -> IO r) -> Handles -> IO r
fuseConduitProcess left :: ConduitT ByteString (Either ByteString ByteString) IO ()
left right :: Handles -> IO r
right (Handles in1 :: Handle
in1 out2 :: Handle
out2 err :: Handle
err) = do
(in2 :: Handle
in2, out1 :: Handle
out1) <- IO (Handle, Handle)
createHandles
Concurrently r -> IO r
forall a. Concurrently a -> IO a
runConcurrently
(IO () -> Concurrently ()
forall a. IO a -> Concurrently a
Concurrently
((ConduitT () Void IO () -> IO ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void IO () -> IO ())
-> ConduitT () Void IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> ConduitT () ByteString IO ()
forall (m :: * -> *) i.
MonadIO m =>
Handle -> ConduitT i ByteString m ()
sourceHandle Handle
in1 ConduitT () ByteString IO ()
-> ConduitM ByteString Void IO () -> ConduitT () Void IO ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT ByteString (Either ByteString ByteString) IO ()
left ConduitT ByteString (Either ByteString ByteString) IO ()
-> Conduit (Either ByteString ByteString) IO Void
-> ConduitM ByteString Void IO ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Handle -> Handle -> Conduit (Either ByteString ByteString) IO Void
sinkHandles Handle
out1 Handle
err) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally`
Handle -> IO ()
hClose Handle
out1) Concurrently () -> Concurrently r -> Concurrently r
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
IO r -> Concurrently r
forall a. IO a -> Concurrently a
Concurrently (Handles -> IO r
right (Handle -> Handle -> Handle -> Handles
Handles Handle
in2 Handle
out2 Handle
err) IO r -> IO () -> IO r
forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
hClose Handle
in2))
fuseProcessConduit
:: (Handles -> IO ())
-> ConduitT ByteString (Either ByteString ByteString) IO r
-> (Handles -> IO r)
fuseProcessConduit :: (Handles -> IO ())
-> ConduitT ByteString (Either ByteString ByteString) IO r
-> Handles
-> IO r
fuseProcessConduit left :: Handles -> IO ()
left right :: ConduitT ByteString (Either ByteString ByteString) IO r
right (Handles in1 :: Handle
in1 out2 :: Handle
out2 err :: Handle
err) = do
(in2 :: Handle
in2, out1 :: Handle
out1) <- IO (Handle, Handle)
createHandles
Concurrently r -> IO r
forall a. Concurrently a -> IO a
runConcurrently
(IO () -> Concurrently ()
forall a. IO a -> Concurrently a
Concurrently (Handles -> IO ()
left (Handle -> Handle -> Handle -> Handles
Handles Handle
in1 Handle
out1 Handle
err) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
hClose Handle
out1) Concurrently () -> Concurrently r -> Concurrently r
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
IO r -> Concurrently r
forall a. IO a -> Concurrently a
Concurrently
((ConduitT () Void IO r -> IO r
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void IO r -> IO r) -> ConduitT () Void IO r -> IO r
forall a b. (a -> b) -> a -> b
$
Handle -> ConduitT () ByteString IO ()
forall (m :: * -> *) i.
MonadIO m =>
Handle -> ConduitT i ByteString m ()
sourceHandle Handle
in2 ConduitT () ByteString IO ()
-> ConduitM ByteString Void IO r -> ConduitT () Void IO r
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT ByteString (Either ByteString ByteString) IO r
right ConduitT ByteString (Either ByteString ByteString) IO r
-> Conduit (Either ByteString ByteString) IO Void
-> ConduitM ByteString Void IO r
forall (m :: * -> *) a b r c.
Monad m =>
ConduitT a b m r -> Conduit b m c -> ConduitT a c m r
`fuseUpstream` Handle -> Handle -> Conduit (Either ByteString ByteString) IO Void
sinkHandles Handle
out2 Handle
err) IO r -> IO () -> IO r
forall a b. IO a -> IO b -> IO a
`finally`
Handle -> IO ()
hClose Handle
in2))
fuseSegment :: Segment () -> Segment r -> Segment r
SegmentConduit x :: ConduitT ByteString (Either ByteString ByteString) IO ()
x fuseSegment :: Segment () -> Segment r -> Segment r
`fuseSegment` SegmentConduit y :: ConduitM ByteString (Either ByteString ByteString) IO r
y =
ConduitM ByteString (Either ByteString ByteString) IO r
-> Segment r
forall r.
ConduitM ByteString (Either ByteString ByteString) IO r
-> Segment r
SegmentConduit (ConduitT ByteString (Either ByteString ByteString) IO ()
-> ConduitM ByteString (Either ByteString ByteString) IO r
-> ConduitM ByteString (Either ByteString ByteString) IO r
forall (m :: * -> *) r.
Monad m =>
ConduitT ByteString (Either ByteString ByteString) m ()
-> ConduitT ByteString (Either ByteString ByteString) m r
-> ConduitT ByteString (Either ByteString ByteString) m r
fuseConduit ConduitT ByteString (Either ByteString ByteString) IO ()
x ConduitM ByteString (Either ByteString ByteString) IO r
y)
SegmentConduit x :: ConduitT ByteString (Either ByteString ByteString) IO ()
x `fuseSegment` SegmentProcess y :: Handles -> IO r
y =
(Handles -> IO r) -> Segment r
forall r. (Handles -> IO r) -> Segment r
SegmentProcess (ConduitT ByteString (Either ByteString ByteString) IO ()
-> (Handles -> IO r) -> Handles -> IO r
forall r.
ConduitT ByteString (Either ByteString ByteString) IO ()
-> (Handles -> IO r) -> Handles -> IO r
fuseConduitProcess ConduitT ByteString (Either ByteString ByteString) IO ()
x Handles -> IO r
y)
SegmentProcess x :: Handles -> IO ()
x `fuseSegment` SegmentConduit y :: ConduitM ByteString (Either ByteString ByteString) IO r
y =
(Handles -> IO r) -> Segment r
forall r. (Handles -> IO r) -> Segment r
SegmentProcess ((Handles -> IO ())
-> ConduitM ByteString (Either ByteString ByteString) IO r
-> Handles
-> IO r
forall r.
(Handles -> IO ())
-> ConduitT ByteString (Either ByteString ByteString) IO r
-> Handles
-> IO r
fuseProcessConduit Handles -> IO ()
x ConduitM ByteString (Either ByteString ByteString) IO r
y)
SegmentProcess x :: Handles -> IO ()
x `fuseSegment` SegmentProcess y :: Handles -> IO r
y =
(Handles -> IO r) -> Segment r
forall r. (Handles -> IO r) -> Segment r
SegmentProcess ((Handles -> IO ()) -> (Handles -> IO r) -> Handles -> IO r
forall r.
(Handles -> IO ()) -> (Handles -> IO r) -> Handles -> IO r
fuseProcess Handles -> IO ()
x Handles -> IO r
y)