{-# LANGUAGE RankNTypes #-}
module Turtle.Bytes (
stdin
, input
, inhandle
, stdout
, output
, outhandle
, append
, stderr
, strict
, compress
, decompress
, WindowBits(..)
, Zlib.defaultWindowBits
, fromUTF8
, toUTF8
, proc
, shell
, procs
, shells
, inproc
, inshell
, inprocWithErr
, inshellWithErr
, procStrict
, shellStrict
, procStrictWithErr
, shellStrictWithErr
, system
, stream
, streamWithErr
, systemStrict
, systemStrictWithErr
) where
import Control.Applicative
import Control.Concurrent.Async (Async, Concurrently(..))
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Managed (MonadManaged(..))
import Data.ByteString (ByteString)
import Data.Monoid
import Data.Streaming.Zlib (Inflate, Popper, PopperRes(..), WindowBits(..))
import Data.Text (Text)
import Data.Text.Encoding (Decoding(..))
import Filesystem.Path (FilePath)
import Prelude hiding (FilePath)
import System.Exit (ExitCode(..))
import System.IO (Handle)
import Turtle.Internal (ignoreSIGPIPE)
import Turtle.Prelude (ProcFailed(..), ShellFailed(..))
import Turtle.Shell (Shell(..), FoldShell(..), fold, sh)
import qualified Control.Concurrent.Async as Async
import qualified Control.Concurrent.STM as STM
import qualified Control.Concurrent.MVar as MVar
import qualified Control.Concurrent.STM.TQueue as TQueue
import qualified Control.Exception as Exception
import qualified Control.Foldl
import qualified Control.Monad
import qualified Control.Monad.Managed as Managed
import qualified Data.ByteString
import qualified Data.Streaming.Zlib as Zlib
import qualified Data.Text
import qualified Data.Text.Encoding as Encoding
import qualified Data.Text.Encoding.Error as Encoding.Error
import qualified Foreign
import qualified System.IO
import qualified System.Process as Process
import qualified Turtle.Prelude
stdin :: Shell ByteString
stdin :: Shell ByteString
stdin = Handle -> Shell ByteString
inhandle Handle
System.IO.stdin
input :: FilePath -> Shell ByteString
input :: FilePath -> Shell ByteString
input file :: FilePath
file = do
Handle
handle <- Managed Handle -> Shell Handle
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (FilePath -> Managed Handle
forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> managed Handle
Turtle.Prelude.readonly FilePath
file)
Handle -> Shell ByteString
inhandle Handle
handle
inhandle :: Handle -> Shell ByteString
inhandle :: Handle -> Shell ByteString
inhandle handle :: Handle
handle = (forall r. FoldShell ByteString r -> IO r) -> Shell ByteString
forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell (\(FoldShell step :: x -> ByteString -> IO x
step begin :: x
begin done :: x -> IO r
done) -> do
let loop :: x -> IO r
loop x :: x
x = do
Bool
eof <- Handle -> IO Bool
System.IO.hIsEOF Handle
handle
if Bool
eof
then x -> IO r
done x
x
else do
ByteString
bytes <- Handle -> Int -> IO ByteString
Data.ByteString.hGetSome Handle
handle Int
defaultChunkSize
x
x' <- x -> ByteString -> IO x
step x
x ByteString
bytes
x -> IO r
loop (x -> IO r) -> x -> IO r
forall a b. (a -> b) -> a -> b
$! x
x'
x -> IO r
loop (x -> IO r) -> x -> IO r
forall a b. (a -> b) -> a -> b
$! x
begin )
where
defaultChunkSize :: Int
defaultChunkSize :: Int
defaultChunkSize = 32 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a. Storable a => a -> Int
Foreign.sizeOf (Int
forall a. HasCallStack => a
undefined :: Int)
stdout :: MonadIO io => Shell ByteString -> io ()
stdout :: Shell ByteString -> io ()
stdout s :: Shell ByteString
s = Shell () -> io ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
ByteString
bytes <- Shell ByteString
s
IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> ByteString -> IO ()
Data.ByteString.hPut Handle
System.IO.stdout ByteString
bytes) )
output :: MonadIO io => FilePath -> Shell ByteString -> io ()
output :: FilePath -> Shell ByteString -> io ()
output file :: FilePath
file s :: Shell ByteString
s = Shell () -> io ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
Handle
handle <- Managed Handle -> Shell Handle
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (FilePath -> Managed Handle
forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> managed Handle
Turtle.Prelude.writeonly FilePath
file)
ByteString
bytes <- Shell ByteString
s
IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> ByteString -> IO ()
Data.ByteString.hPut Handle
handle ByteString
bytes) )
outhandle :: MonadIO io => Handle -> Shell ByteString -> io ()
outhandle :: Handle -> Shell ByteString -> io ()
outhandle handle :: Handle
handle s :: Shell ByteString
s = Shell () -> io ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
ByteString
bytes <- Shell ByteString
s
IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> ByteString -> IO ()
Data.ByteString.hPut Handle
handle ByteString
bytes) )
append :: MonadIO io => FilePath -> Shell ByteString -> io ()
append :: FilePath -> Shell ByteString -> io ()
append file :: FilePath
file s :: Shell ByteString
s = Shell () -> io ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
Handle
handle <- Managed Handle -> Shell Handle
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using (FilePath -> Managed Handle
forall (managed :: * -> *).
MonadManaged managed =>
FilePath -> managed Handle
Turtle.Prelude.appendonly FilePath
file)
ByteString
bytes <- Shell ByteString
s
IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> ByteString -> IO ()
Data.ByteString.hPut Handle
handle ByteString
bytes) )
stderr :: MonadIO io => Shell ByteString -> io ()
stderr :: Shell ByteString -> io ()
stderr s :: Shell ByteString
s = Shell () -> io ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
ByteString
bytes <- Shell ByteString
s
IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> ByteString -> IO ()
Data.ByteString.hPut Handle
System.IO.stderr ByteString
bytes) )
strict :: MonadIO io => Shell ByteString -> io ByteString
strict :: Shell ByteString -> io ByteString
strict s :: Shell ByteString
s = do
[ByteString]
listOfByteStrings <- Shell ByteString -> Fold ByteString [ByteString] -> io [ByteString]
forall (io :: * -> *) a b.
MonadIO io =>
Shell a -> Fold a b -> io b
fold Shell ByteString
s Fold ByteString [ByteString]
forall a. Fold a [a]
Control.Foldl.list
ByteString -> io ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> ByteString
Data.ByteString.concat [ByteString]
listOfByteStrings)
proc
:: MonadIO io
=> Text
-> [Text]
-> Shell ByteString
-> io ExitCode
proc :: Text -> [Text] -> Shell ByteString -> io ExitCode
proc cmd :: Text
cmd args :: [Text]
args =
CreateProcess -> Shell ByteString -> io ExitCode
forall (io :: * -> *).
MonadIO io =>
CreateProcess -> Shell ByteString -> io ExitCode
system
( (FilePath -> [FilePath] -> CreateProcess
Process.proc (Text -> FilePath
Data.Text.unpack Text
cmd) ((Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
Data.Text.unpack [Text]
args))
{ std_in :: StdStream
Process.std_in = StdStream
Process.CreatePipe
, std_out :: StdStream
Process.std_out = StdStream
Process.Inherit
, std_err :: StdStream
Process.std_err = StdStream
Process.Inherit
} )
shell
:: MonadIO io
=> Text
-> Shell ByteString
-> io ExitCode
shell :: Text -> Shell ByteString -> io ExitCode
shell cmdline :: Text
cmdline =
CreateProcess -> Shell ByteString -> io ExitCode
forall (io :: * -> *).
MonadIO io =>
CreateProcess -> Shell ByteString -> io ExitCode
system
( (FilePath -> CreateProcess
Process.shell (Text -> FilePath
Data.Text.unpack Text
cmdline))
{ std_in :: StdStream
Process.std_in = StdStream
Process.CreatePipe
, std_out :: StdStream
Process.std_out = StdStream
Process.Inherit
, std_err :: StdStream
Process.std_err = StdStream
Process.Inherit
} )
procs
:: MonadIO io
=> Text
-> [Text]
-> Shell ByteString
-> io ()
procs :: Text -> [Text] -> Shell ByteString -> io ()
procs cmd :: Text
cmd args :: [Text]
args s :: Shell ByteString
s = do
ExitCode
exitCode <- Text -> [Text] -> Shell ByteString -> io ExitCode
forall (io :: * -> *).
MonadIO io =>
Text -> [Text] -> Shell ByteString -> io ExitCode
proc Text
cmd [Text]
args Shell ByteString
s
case ExitCode
exitCode of
ExitSuccess -> () -> io ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ProcFailed -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO (Text -> [Text] -> ExitCode -> ProcFailed
ProcFailed Text
cmd [Text]
args ExitCode
exitCode))
shells
:: MonadIO io
=> Text
-> Shell ByteString
-> io ()
shells :: Text -> Shell ByteString -> io ()
shells cmdline :: Text
cmdline s :: Shell ByteString
s = do
ExitCode
exitCode <- Text -> Shell ByteString -> io ExitCode
forall (io :: * -> *).
MonadIO io =>
Text -> Shell ByteString -> io ExitCode
shell Text
cmdline Shell ByteString
s
case ExitCode
exitCode of
ExitSuccess -> () -> io ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ShellFailed -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO (Text -> ExitCode -> ShellFailed
ShellFailed Text
cmdline ExitCode
exitCode))
procStrict
:: MonadIO io
=> Text
-> [Text]
-> Shell ByteString
-> io (ExitCode, ByteString)
procStrict :: Text -> [Text] -> Shell ByteString -> io (ExitCode, ByteString)
procStrict cmd :: Text
cmd args :: [Text]
args =
CreateProcess -> Shell ByteString -> io (ExitCode, ByteString)
forall (io :: * -> *).
MonadIO io =>
CreateProcess -> Shell ByteString -> io (ExitCode, ByteString)
systemStrict (FilePath -> [FilePath] -> CreateProcess
Process.proc (Text -> FilePath
Data.Text.unpack Text
cmd) ((Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
Data.Text.unpack [Text]
args))
shellStrict
:: MonadIO io
=> Text
-> Shell ByteString
-> io (ExitCode, ByteString)
shellStrict :: Text -> Shell ByteString -> io (ExitCode, ByteString)
shellStrict cmdline :: Text
cmdline = CreateProcess -> Shell ByteString -> io (ExitCode, ByteString)
forall (io :: * -> *).
MonadIO io =>
CreateProcess -> Shell ByteString -> io (ExitCode, ByteString)
systemStrict (FilePath -> CreateProcess
Process.shell (Text -> FilePath
Data.Text.unpack Text
cmdline))
procStrictWithErr
:: MonadIO io
=> Text
-> [Text]
-> Shell ByteString
-> io (ExitCode, ByteString, ByteString)
procStrictWithErr :: Text
-> [Text]
-> Shell ByteString
-> io (ExitCode, ByteString, ByteString)
procStrictWithErr cmd :: Text
cmd args :: [Text]
args =
CreateProcess
-> Shell ByteString -> io (ExitCode, ByteString, ByteString)
forall (io :: * -> *).
MonadIO io =>
CreateProcess
-> Shell ByteString -> io (ExitCode, ByteString, ByteString)
systemStrictWithErr (FilePath -> [FilePath] -> CreateProcess
Process.proc (Text -> FilePath
Data.Text.unpack Text
cmd) ((Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
Data.Text.unpack [Text]
args))
shellStrictWithErr
:: MonadIO io
=> Text
-> Shell ByteString
-> io (ExitCode, ByteString, ByteString)
shellStrictWithErr :: Text -> Shell ByteString -> io (ExitCode, ByteString, ByteString)
shellStrictWithErr cmdline :: Text
cmdline =
CreateProcess
-> Shell ByteString -> io (ExitCode, ByteString, ByteString)
forall (io :: * -> *).
MonadIO io =>
CreateProcess
-> Shell ByteString -> io (ExitCode, ByteString, ByteString)
systemStrictWithErr (FilePath -> CreateProcess
Process.shell (Text -> FilePath
Data.Text.unpack Text
cmdline))
halt :: Async a -> IO ()
halt :: Async a -> IO ()
halt a :: Async a
a = do
Maybe (Either SomeException a)
m <- Async a -> IO (Maybe (Either SomeException a))
forall a. Async a -> IO (Maybe (Either SomeException a))
Async.poll Async a
a
case Maybe (Either SomeException a)
m of
Nothing -> Async a -> IO ()
forall a. Async a -> IO ()
Async.cancel Async a
a
Just (Left e :: SomeException
e) -> SomeException -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO SomeException
e
Just (Right _) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
system
:: MonadIO io
=> Process.CreateProcess
-> Shell ByteString
-> io ExitCode
system :: CreateProcess -> Shell ByteString -> io ExitCode
system p :: CreateProcess
p s :: Shell ByteString
s = IO ExitCode -> io ExitCode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
let open :: IO (Maybe Handle, ProcessHandle)
open = do
(m :: Maybe Handle
m, Nothing, Nothing, ph :: ProcessHandle
ph) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
Process.createProcess CreateProcess
p
case Maybe Handle
m of
Just hIn :: Handle
hIn -> Handle -> BufferMode -> IO ()
System.IO.hSetBuffering Handle
hIn (Maybe Int -> BufferMode
System.IO.BlockBuffering Maybe Int
forall a. Maybe a
Nothing)
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Maybe Handle, ProcessHandle) -> IO (Maybe Handle, ProcessHandle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Handle
m, ProcessHandle
ph)
MVar Bool
mvar <- Bool -> IO (MVar Bool)
forall a. a -> IO (MVar a)
MVar.newMVar Bool
False
let close :: Handle -> IO ()
close handle :: Handle
handle = do
MVar Bool -> (Bool -> IO Bool) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
MVar.modifyMVar_ MVar Bool
mvar (\finalized :: Bool
finalized -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Control.Monad.unless Bool
finalized
(IO () -> IO ()
ignoreSIGPIPE (Handle -> IO ()
System.IO.hClose Handle
handle))
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True )
let close' :: (Maybe Handle, ProcessHandle) -> IO ()
close' (Just hIn :: Handle
hIn, ph :: ProcessHandle
ph) = do
Handle -> IO ()
close Handle
hIn
ProcessHandle -> IO ()
Process.terminateProcess ProcessHandle
ph
close' (Nothing , ph :: ProcessHandle
ph) = do
ProcessHandle -> IO ()
Process.terminateProcess ProcessHandle
ph
let handle :: (Maybe Handle, ProcessHandle) -> IO ExitCode
handle (Just hIn :: Handle
hIn, ph :: ProcessHandle
ph) = do
let feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn restore :: forall a. IO a -> IO a
restore =
IO () -> IO ()
forall a. IO a -> IO a
restore (IO () -> IO ()
ignoreSIGPIPE (Handle -> Shell ByteString -> IO ()
forall (io :: * -> *).
MonadIO io =>
Handle -> Shell ByteString -> io ()
outhandle Handle
hIn Shell ByteString
s))
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`Exception.finally` Handle -> IO ()
close Handle
hIn
((forall a. IO a -> IO a) -> IO ExitCode) -> IO ExitCode
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
Exception.mask (\restore :: forall a. IO a -> IO a
restore ->
IO () -> (Async () -> IO ExitCode) -> IO ExitCode
forall a b. IO a -> (Async a -> IO b) -> IO b
Async.withAsync ((forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore) (\a :: Async ()
a ->
IO ExitCode -> IO ExitCode
forall a. IO a -> IO a
restore (ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
ph) IO ExitCode -> IO () -> IO ExitCode
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Async () -> IO ()
forall a. Async a -> IO ()
halt Async ()
a ) )
handle (Nothing , ph :: ProcessHandle
ph) = do
ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
ph
IO (Maybe Handle, ProcessHandle)
-> ((Maybe Handle, ProcessHandle) -> IO ())
-> ((Maybe Handle, ProcessHandle) -> IO ExitCode)
-> IO ExitCode
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracket IO (Maybe Handle, ProcessHandle)
open (Maybe Handle, ProcessHandle) -> IO ()
close' (Maybe Handle, ProcessHandle) -> IO ExitCode
handle )
systemStrict
:: MonadIO io
=> Process.CreateProcess
-> Shell ByteString
-> io (ExitCode, ByteString)
systemStrict :: CreateProcess -> Shell ByteString -> io (ExitCode, ByteString)
systemStrict p :: CreateProcess
p s :: Shell ByteString
s = IO (ExitCode, ByteString) -> io (ExitCode, ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
let p' :: CreateProcess
p' = CreateProcess
p
{ std_in :: StdStream
Process.std_in = StdStream
Process.CreatePipe
, std_out :: StdStream
Process.std_out = StdStream
Process.CreatePipe
, std_err :: StdStream
Process.std_err = StdStream
Process.Inherit
}
let open :: IO (Handle, Handle, ProcessHandle)
open = do
(Just hIn :: Handle
hIn, Just hOut :: Handle
hOut, Nothing, ph :: ProcessHandle
ph) <- IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
Process.createProcess CreateProcess
p')
Handle -> BufferMode -> IO ()
System.IO.hSetBuffering Handle
hIn (Maybe Int -> BufferMode
System.IO.BlockBuffering Maybe Int
forall a. Maybe a
Nothing)
(Handle, Handle, ProcessHandle)
-> IO (Handle, Handle, ProcessHandle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
hIn, Handle
hOut, ProcessHandle
ph)
MVar Bool
mvar <- Bool -> IO (MVar Bool)
forall a. a -> IO (MVar a)
MVar.newMVar Bool
False
let close :: Handle -> IO ()
close handle :: Handle
handle = do
MVar Bool -> (Bool -> IO Bool) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
MVar.modifyMVar_ MVar Bool
mvar (\finalized :: Bool
finalized -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Control.Monad.unless Bool
finalized
(IO () -> IO ()
ignoreSIGPIPE (Handle -> IO ()
System.IO.hClose Handle
handle))
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True )
IO (Handle, Handle, ProcessHandle)
-> ((Handle, Handle, ProcessHandle) -> IO ())
-> ((Handle, Handle, ProcessHandle) -> IO (ExitCode, ByteString))
-> IO (ExitCode, ByteString)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracket IO (Handle, Handle, ProcessHandle)
open (\(hIn :: Handle
hIn, _, ph :: ProcessHandle
ph) -> Handle -> IO ()
close Handle
hIn IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessHandle -> IO ()
Process.terminateProcess ProcessHandle
ph) (\(hIn :: Handle
hIn, hOut :: Handle
hOut, ph :: ProcessHandle
ph) -> do
let feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn restore :: forall a. IO a -> IO a
restore =
IO () -> IO ()
forall a. IO a -> IO a
restore (IO () -> IO ()
ignoreSIGPIPE (Handle -> Shell ByteString -> IO ()
forall (io :: * -> *).
MonadIO io =>
Handle -> Shell ByteString -> io ()
outhandle Handle
hIn Shell ByteString
s))
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`Exception.finally` Handle -> IO ()
close Handle
hIn
IO ExitCode -> IO ByteString -> IO (ExitCode, ByteString)
forall a b. IO a -> IO b -> IO (a, b)
Async.concurrently
(((forall a. IO a -> IO a) -> IO ExitCode) -> IO ExitCode
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
Exception.mask (\restore :: forall a. IO a -> IO a
restore ->
IO () -> (Async () -> IO ExitCode) -> IO ExitCode
forall a b. IO a -> (Async a -> IO b) -> IO b
Async.withAsync ((forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore) (\a :: Async ()
a ->
IO ExitCode -> IO ExitCode
forall a. IO a -> IO a
restore (ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
ph) IO ExitCode -> IO () -> IO ExitCode
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Async () -> IO ()
forall a. Async a -> IO ()
halt Async ()
a ) ))
(Handle -> IO ByteString
Data.ByteString.hGetContents Handle
hOut) ) )
systemStrictWithErr
:: MonadIO io
=> Process.CreateProcess
-> Shell ByteString
-> io (ExitCode, ByteString, ByteString)
systemStrictWithErr :: CreateProcess
-> Shell ByteString -> io (ExitCode, ByteString, ByteString)
systemStrictWithErr p :: CreateProcess
p s :: Shell ByteString
s = IO (ExitCode, ByteString, ByteString)
-> io (ExitCode, ByteString, ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
let p' :: CreateProcess
p' = CreateProcess
p
{ std_in :: StdStream
Process.std_in = StdStream
Process.CreatePipe
, std_out :: StdStream
Process.std_out = StdStream
Process.CreatePipe
, std_err :: StdStream
Process.std_err = StdStream
Process.CreatePipe
}
let open :: IO (Handle, Handle, Handle, ProcessHandle)
open = do
(Just hIn :: Handle
hIn, Just hOut :: Handle
hOut, Just hErr :: Handle
hErr, ph :: ProcessHandle
ph) <- IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
Process.createProcess CreateProcess
p')
Handle -> BufferMode -> IO ()
System.IO.hSetBuffering Handle
hIn (Maybe Int -> BufferMode
System.IO.BlockBuffering Maybe Int
forall a. Maybe a
Nothing)
(Handle, Handle, Handle, ProcessHandle)
-> IO (Handle, Handle, Handle, ProcessHandle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
hIn, Handle
hOut, Handle
hErr, ProcessHandle
ph)
MVar Bool
mvar <- Bool -> IO (MVar Bool)
forall a. a -> IO (MVar a)
MVar.newMVar Bool
False
let close :: Handle -> IO ()
close handle :: Handle
handle = do
MVar Bool -> (Bool -> IO Bool) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
MVar.modifyMVar_ MVar Bool
mvar (\finalized :: Bool
finalized -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Control.Monad.unless Bool
finalized
(IO () -> IO ()
ignoreSIGPIPE (Handle -> IO ()
System.IO.hClose Handle
handle))
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True )
IO (Handle, Handle, Handle, ProcessHandle)
-> ((Handle, Handle, Handle, ProcessHandle) -> IO ())
-> ((Handle, Handle, Handle, ProcessHandle)
-> IO (ExitCode, ByteString, ByteString))
-> IO (ExitCode, ByteString, ByteString)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracket IO (Handle, Handle, Handle, ProcessHandle)
open (\(hIn :: Handle
hIn, _, _, ph :: ProcessHandle
ph) -> Handle -> IO ()
close Handle
hIn IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessHandle -> IO ()
Process.terminateProcess ProcessHandle
ph) (\(hIn :: Handle
hIn, hOut :: Handle
hOut, hErr :: Handle
hErr, ph :: ProcessHandle
ph) -> do
let feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn restore :: forall a. IO a -> IO a
restore =
IO () -> IO ()
forall a. IO a -> IO a
restore (IO () -> IO ()
ignoreSIGPIPE (Handle -> Shell ByteString -> IO ()
forall (io :: * -> *).
MonadIO io =>
Handle -> Shell ByteString -> io ()
outhandle Handle
hIn Shell ByteString
s))
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`Exception.finally` Handle -> IO ()
close Handle
hIn
Concurrently (ExitCode, ByteString, ByteString)
-> IO (ExitCode, ByteString, ByteString)
forall a. Concurrently a -> IO a
runConcurrently (Concurrently (ExitCode, ByteString, ByteString)
-> IO (ExitCode, ByteString, ByteString))
-> Concurrently (ExitCode, ByteString, ByteString)
-> IO (ExitCode, ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ (,,)
(ExitCode
-> ByteString -> ByteString -> (ExitCode, ByteString, ByteString))
-> Concurrently ExitCode
-> Concurrently
(ByteString -> ByteString -> (ExitCode, ByteString, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ExitCode -> Concurrently ExitCode
forall a. IO a -> Concurrently a
Concurrently (((forall a. IO a -> IO a) -> IO ExitCode) -> IO ExitCode
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
Exception.mask (\restore :: forall a. IO a -> IO a
restore ->
IO () -> (Async () -> IO ExitCode) -> IO ExitCode
forall a b. IO a -> (Async a -> IO b) -> IO b
Async.withAsync ((forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore) (\a :: Async ()
a ->
IO ExitCode -> IO ExitCode
forall a. IO a -> IO a
restore (ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
ph) IO ExitCode -> IO () -> IO ExitCode
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Async () -> IO ()
forall a. Async a -> IO ()
halt Async ()
a ) ))
Concurrently
(ByteString -> ByteString -> (ExitCode, ByteString, ByteString))
-> Concurrently ByteString
-> Concurrently (ByteString -> (ExitCode, ByteString, ByteString))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO ByteString -> Concurrently ByteString
forall a. IO a -> Concurrently a
Concurrently (Handle -> IO ByteString
Data.ByteString.hGetContents Handle
hOut)
Concurrently (ByteString -> (ExitCode, ByteString, ByteString))
-> Concurrently ByteString
-> Concurrently (ExitCode, ByteString, ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO ByteString -> Concurrently ByteString
forall a. IO a -> Concurrently a
Concurrently (Handle -> IO ByteString
Data.ByteString.hGetContents Handle
hErr) ) )
inproc
:: Text
-> [Text]
-> Shell ByteString
-> Shell ByteString
inproc :: Text -> [Text] -> Shell ByteString -> Shell ByteString
inproc cmd :: Text
cmd args :: [Text]
args =
CreateProcess -> Shell ByteString -> Shell ByteString
stream (FilePath -> [FilePath] -> CreateProcess
Process.proc (Text -> FilePath
Data.Text.unpack Text
cmd) ((Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
Data.Text.unpack [Text]
args))
inshell
:: Text
-> Shell ByteString
-> Shell ByteString
inshell :: Text -> Shell ByteString -> Shell ByteString
inshell cmd :: Text
cmd = CreateProcess -> Shell ByteString -> Shell ByteString
stream (FilePath -> CreateProcess
Process.shell (Text -> FilePath
Data.Text.unpack Text
cmd))
waitForProcessThrows :: Process.ProcessHandle -> IO ()
waitForProcessThrows :: ProcessHandle -> IO ()
waitForProcessThrows ph :: ProcessHandle
ph = do
ExitCode
exitCode <- ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
ph
case ExitCode
exitCode of
ExitSuccess -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ExitFailure _ -> ExitCode -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO ExitCode
exitCode
stream
:: Process.CreateProcess
-> Shell ByteString
-> Shell ByteString
stream :: CreateProcess -> Shell ByteString -> Shell ByteString
stream p :: CreateProcess
p s :: Shell ByteString
s = do
let p' :: CreateProcess
p' = CreateProcess
p
{ std_in :: StdStream
Process.std_in = StdStream
Process.CreatePipe
, std_out :: StdStream
Process.std_out = StdStream
Process.CreatePipe
, std_err :: StdStream
Process.std_err = StdStream
Process.Inherit
}
let open :: IO (Handle, Handle, ProcessHandle)
open = do
(Just hIn :: Handle
hIn, Just hOut :: Handle
hOut, Nothing, ph :: ProcessHandle
ph) <- IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
Process.createProcess CreateProcess
p')
Handle -> BufferMode -> IO ()
System.IO.hSetBuffering Handle
hIn (Maybe Int -> BufferMode
System.IO.BlockBuffering Maybe Int
forall a. Maybe a
Nothing)
(Handle, Handle, ProcessHandle)
-> IO (Handle, Handle, ProcessHandle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
hIn, Handle
hOut, ProcessHandle
ph)
MVar Bool
mvar <- IO (MVar Bool) -> Shell (MVar Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Bool -> IO (MVar Bool)
forall a. a -> IO (MVar a)
MVar.newMVar Bool
False)
let close :: Handle -> IO ()
close handle :: Handle
handle = do
MVar Bool -> (Bool -> IO Bool) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
MVar.modifyMVar_ MVar Bool
mvar (\finalized :: Bool
finalized -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Control.Monad.unless Bool
finalized (IO () -> IO ()
ignoreSIGPIPE (Handle -> IO ()
System.IO.hClose Handle
handle))
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True )
(hIn :: Handle
hIn, hOut :: Handle
hOut, ph :: ProcessHandle
ph) <- Managed (Handle, Handle, ProcessHandle)
-> Shell (Handle, Handle, ProcessHandle)
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using ((forall r. ((Handle, Handle, ProcessHandle) -> IO r) -> IO r)
-> Managed (Handle, Handle, ProcessHandle)
forall a. (forall r. (a -> IO r) -> IO r) -> Managed a
Managed.managed (IO (Handle, Handle, ProcessHandle)
-> ((Handle, Handle, ProcessHandle) -> IO ())
-> ((Handle, Handle, ProcessHandle) -> IO r)
-> IO r
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracket IO (Handle, Handle, ProcessHandle)
open (\(hIn :: Handle
hIn, _, ph :: ProcessHandle
ph) -> Handle -> IO ()
close Handle
hIn IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessHandle -> IO ()
Process.terminateProcess ProcessHandle
ph)))
let feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn restore :: forall a. IO a -> IO a
restore =
IO () -> IO ()
forall a. IO a -> IO a
restore (IO () -> IO ()
ignoreSIGPIPE (Shell () -> IO ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
ByteString
bytes <- Shell ByteString
s
IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> ByteString -> IO ()
Data.ByteString.hPut Handle
hIn ByteString
bytes) ) ) )
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`Exception.finally` Handle -> IO ()
close Handle
hIn
Async ()
a <- Managed (Async ()) -> Shell (Async ())
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using
((forall r. (Async () -> IO r) -> IO r) -> Managed (Async ())
forall a. (forall r. (a -> IO r) -> IO r) -> Managed a
Managed.managed (\k :: Async () -> IO r
k ->
((forall a. IO a -> IO a) -> IO r) -> IO r
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
Exception.mask (\restore :: forall a. IO a -> IO a
restore ->
IO () -> (Async () -> IO r) -> IO r
forall a b. IO a -> (Async a -> IO b) -> IO b
Async.withAsync ((forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore) Async () -> IO r
k ) ))
Handle -> Shell ByteString
inhandle Handle
hOut Shell ByteString -> Shell ByteString -> Shell ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ProcessHandle -> IO ()
waitForProcessThrows ProcessHandle
ph IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Async () -> IO ()
forall a. Async a -> IO ()
halt Async ()
a) Shell () -> Shell ByteString -> Shell ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Shell ByteString
forall (f :: * -> *) a. Alternative f => f a
empty)
streamWithErr
:: Process.CreateProcess
-> Shell ByteString
-> Shell (Either ByteString ByteString)
streamWithErr :: CreateProcess
-> Shell ByteString -> Shell (Either ByteString ByteString)
streamWithErr p :: CreateProcess
p s :: Shell ByteString
s = do
let p' :: CreateProcess
p' = CreateProcess
p
{ std_in :: StdStream
Process.std_in = StdStream
Process.CreatePipe
, std_out :: StdStream
Process.std_out = StdStream
Process.CreatePipe
, std_err :: StdStream
Process.std_err = StdStream
Process.CreatePipe
}
let open :: IO (Handle, Handle, Handle, ProcessHandle)
open = do
(Just hIn :: Handle
hIn, Just hOut :: Handle
hOut, Just hErr :: Handle
hErr, ph :: ProcessHandle
ph) <- IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
Process.createProcess CreateProcess
p')
Handle -> BufferMode -> IO ()
System.IO.hSetBuffering Handle
hIn (Maybe Int -> BufferMode
System.IO.BlockBuffering Maybe Int
forall a. Maybe a
Nothing)
(Handle, Handle, Handle, ProcessHandle)
-> IO (Handle, Handle, Handle, ProcessHandle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
hIn, Handle
hOut, Handle
hErr, ProcessHandle
ph)
MVar Bool
mvar <- IO (MVar Bool) -> Shell (MVar Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Bool -> IO (MVar Bool)
forall a. a -> IO (MVar a)
MVar.newMVar Bool
False)
let close :: Handle -> IO ()
close handle :: Handle
handle = do
MVar Bool -> (Bool -> IO Bool) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
MVar.modifyMVar_ MVar Bool
mvar (\finalized :: Bool
finalized -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Control.Monad.unless Bool
finalized (IO () -> IO ()
ignoreSIGPIPE (Handle -> IO ()
System.IO.hClose Handle
handle))
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True )
(hIn :: Handle
hIn, hOut :: Handle
hOut, hErr :: Handle
hErr, ph :: ProcessHandle
ph) <- Managed (Handle, Handle, Handle, ProcessHandle)
-> Shell (Handle, Handle, Handle, ProcessHandle)
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using ((forall r.
((Handle, Handle, Handle, ProcessHandle) -> IO r) -> IO r)
-> Managed (Handle, Handle, Handle, ProcessHandle)
forall a. (forall r. (a -> IO r) -> IO r) -> Managed a
Managed.managed (IO (Handle, Handle, Handle, ProcessHandle)
-> ((Handle, Handle, Handle, ProcessHandle) -> IO ())
-> ((Handle, Handle, Handle, ProcessHandle) -> IO r)
-> IO r
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracket IO (Handle, Handle, Handle, ProcessHandle)
open (\(hIn :: Handle
hIn, _, _, ph :: ProcessHandle
ph) -> Handle -> IO ()
close Handle
hIn IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessHandle -> IO ()
Process.terminateProcess ProcessHandle
ph)))
let feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn :: (forall a. IO a -> IO a) -> IO ()
feedIn restore :: forall a. IO a -> IO a
restore =
IO () -> IO ()
forall a. IO a -> IO a
restore (IO () -> IO ()
ignoreSIGPIPE (Shell () -> IO ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
ByteString
bytes <- Shell ByteString
s
IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> ByteString -> IO ()
Data.ByteString.hPut Handle
hIn ByteString
bytes) ) ) )
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`Exception.finally` Handle -> IO ()
close Handle
hIn
TQueue (Maybe (Either ByteString ByteString))
queue <- IO (TQueue (Maybe (Either ByteString ByteString)))
-> Shell (TQueue (Maybe (Either ByteString ByteString)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (TQueue (Maybe (Either ByteString ByteString)))
forall a. IO (TQueue a)
TQueue.newTQueueIO
let forwardOut :: (forall a. IO a -> IO a) -> IO ()
forwardOut :: (forall a. IO a -> IO a) -> IO ()
forwardOut restore :: forall a. IO a -> IO a
restore =
IO () -> IO ()
forall a. IO a -> IO a
restore (Shell () -> IO ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
ByteString
bytes <- Handle -> Shell ByteString
inhandle Handle
hOut
IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (TQueue (Maybe (Either ByteString ByteString))
-> Maybe (Either ByteString ByteString) -> STM ()
forall a. TQueue a -> a -> STM ()
TQueue.writeTQueue TQueue (Maybe (Either ByteString ByteString))
queue (Either ByteString ByteString
-> Maybe (Either ByteString ByteString)
forall a. a -> Maybe a
Just (ByteString -> Either ByteString ByteString
forall a b. b -> Either a b
Right ByteString
bytes)))) ))
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`Exception.finally` STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (TQueue (Maybe (Either ByteString ByteString))
-> Maybe (Either ByteString ByteString) -> STM ()
forall a. TQueue a -> a -> STM ()
TQueue.writeTQueue TQueue (Maybe (Either ByteString ByteString))
queue Maybe (Either ByteString ByteString)
forall a. Maybe a
Nothing)
let forwardErr :: (forall a. IO a -> IO a) -> IO ()
forwardErr :: (forall a. IO a -> IO a) -> IO ()
forwardErr restore :: forall a. IO a -> IO a
restore =
IO () -> IO ()
forall a. IO a -> IO a
restore (Shell () -> IO ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
sh (do
ByteString
bytes <- Handle -> Shell ByteString
inhandle Handle
hErr
IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (TQueue (Maybe (Either ByteString ByteString))
-> Maybe (Either ByteString ByteString) -> STM ()
forall a. TQueue a -> a -> STM ()
TQueue.writeTQueue TQueue (Maybe (Either ByteString ByteString))
queue (Either ByteString ByteString
-> Maybe (Either ByteString ByteString)
forall a. a -> Maybe a
Just (ByteString -> Either ByteString ByteString
forall a b. a -> Either a b
Left ByteString
bytes)))) ))
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`Exception.finally` STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (TQueue (Maybe (Either ByteString ByteString))
-> Maybe (Either ByteString ByteString) -> STM ()
forall a. TQueue a -> a -> STM ()
TQueue.writeTQueue TQueue (Maybe (Either ByteString ByteString))
queue Maybe (Either ByteString ByteString)
forall a. Maybe a
Nothing)
let drain :: Shell (Either ByteString ByteString)
drain = (forall r. FoldShell (Either ByteString ByteString) r -> IO r)
-> Shell (Either ByteString ByteString)
forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell (\(FoldShell step :: x -> Either ByteString ByteString -> IO x
step begin :: x
begin done :: x -> IO r
done) -> do
let loop :: x -> a -> IO x
loop x :: x
x numNothing :: a
numNothing
| a
numNothing a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 2 = do
Maybe (Either ByteString ByteString)
m <- STM (Maybe (Either ByteString ByteString))
-> IO (Maybe (Either ByteString ByteString))
forall a. STM a -> IO a
STM.atomically (TQueue (Maybe (Either ByteString ByteString))
-> STM (Maybe (Either ByteString ByteString))
forall a. TQueue a -> STM a
TQueue.readTQueue TQueue (Maybe (Either ByteString ByteString))
queue)
case Maybe (Either ByteString ByteString)
m of
Nothing -> x -> a -> IO x
loop x
x (a -> IO x) -> a -> IO x
forall a b. (a -> b) -> a -> b
$! a
numNothing a -> a -> a
forall a. Num a => a -> a -> a
+ 1
Just e :: Either ByteString ByteString
e -> do
x
x' <- x -> Either ByteString ByteString -> IO x
step x
x Either ByteString ByteString
e
x -> a -> IO x
loop x
x' a
numNothing
| Bool
otherwise = x -> IO x
forall (m :: * -> *) a. Monad m => a -> m a
return x
x
x
x1 <- x -> Int -> IO x
forall a. (Ord a, Num a) => x -> a -> IO x
loop x
begin (0 :: Int)
x -> IO r
done x
x1 )
Async ()
a <- Managed (Async ()) -> Shell (Async ())
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using
((forall r. (Async () -> IO r) -> IO r) -> Managed (Async ())
forall a. (forall r. (a -> IO r) -> IO r) -> Managed a
Managed.managed (\k :: Async () -> IO r
k ->
((forall a. IO a -> IO a) -> IO r) -> IO r
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
Exception.mask (\restore :: forall a. IO a -> IO a
restore ->
IO () -> (Async () -> IO r) -> IO r
forall a b. IO a -> (Async a -> IO b) -> IO b
Async.withAsync ((forall a. IO a -> IO a) -> IO ()
feedIn forall a. IO a -> IO a
restore) Async () -> IO r
k ) ))
Async ()
b <- Managed (Async ()) -> Shell (Async ())
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using
((forall r. (Async () -> IO r) -> IO r) -> Managed (Async ())
forall a. (forall r. (a -> IO r) -> IO r) -> Managed a
Managed.managed (\k :: Async () -> IO r
k ->
((forall a. IO a -> IO a) -> IO r) -> IO r
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
Exception.mask (\restore :: forall a. IO a -> IO a
restore ->
IO () -> (Async () -> IO r) -> IO r
forall a b. IO a -> (Async a -> IO b) -> IO b
Async.withAsync ((forall a. IO a -> IO a) -> IO ()
forwardOut forall a. IO a -> IO a
restore) Async () -> IO r
k ) ))
Async ()
c <- Managed (Async ()) -> Shell (Async ())
forall (m :: * -> *) a. MonadManaged m => Managed a -> m a
using
((forall r. (Async () -> IO r) -> IO r) -> Managed (Async ())
forall a. (forall r. (a -> IO r) -> IO r) -> Managed a
Managed.managed (\k :: Async () -> IO r
k ->
((forall a. IO a -> IO a) -> IO r) -> IO r
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
Exception.mask (\restore :: forall a. IO a -> IO a
restore ->
IO () -> (Async () -> IO r) -> IO r
forall a b. IO a -> (Async a -> IO b) -> IO b
Async.withAsync ((forall a. IO a -> IO a) -> IO ()
forwardErr forall a. IO a -> IO a
restore) Async () -> IO r
k ) ))
let l :: STM a
l also :: STM a -> STM a -> STM ()
`also` r :: STM a
r = do
a
_ <- STM a
l STM a -> STM a -> STM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (STM a
r STM a -> STM a -> STM a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> STM a
forall a. STM a
STM.retry)
a
_ <- STM a
r
() -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
let waitAll :: IO ()
waitAll = STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (Async () -> STM ()
forall a. Async a -> STM a
Async.waitSTM Async ()
a STM () -> STM () -> STM ()
forall a a. STM a -> STM a -> STM ()
`also` (Async () -> STM ()
forall a. Async a -> STM a
Async.waitSTM Async ()
b STM () -> STM () -> STM ()
forall a a. STM a -> STM a -> STM ()
`also` Async () -> STM ()
forall a. Async a -> STM a
Async.waitSTM Async ()
c))
Shell (Either ByteString ByteString)
drain Shell (Either ByteString ByteString)
-> Shell (Either ByteString ByteString)
-> Shell (Either ByteString ByteString)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ProcessHandle -> IO ()
waitForProcessThrows ProcessHandle
ph IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO ()
waitAll) Shell ()
-> Shell (Either ByteString ByteString)
-> Shell (Either ByteString ByteString)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Shell (Either ByteString ByteString)
forall (f :: * -> *) a. Alternative f => f a
empty)
inprocWithErr
:: Text
-> [Text]
-> Shell ByteString
-> Shell (Either ByteString ByteString)
inprocWithErr :: Text
-> [Text]
-> Shell ByteString
-> Shell (Either ByteString ByteString)
inprocWithErr cmd :: Text
cmd args :: [Text]
args =
CreateProcess
-> Shell ByteString -> Shell (Either ByteString ByteString)
streamWithErr (FilePath -> [FilePath] -> CreateProcess
Process.proc (Text -> FilePath
Data.Text.unpack Text
cmd) ((Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
Data.Text.unpack [Text]
args))
inshellWithErr
:: Text
-> Shell ByteString
-> Shell (Either ByteString ByteString)
inshellWithErr :: Text -> Shell ByteString -> Shell (Either ByteString ByteString)
inshellWithErr cmd :: Text
cmd = CreateProcess
-> Shell ByteString -> Shell (Either ByteString ByteString)
streamWithErr (FilePath -> CreateProcess
Process.shell (Text -> FilePath
Data.Text.unpack Text
cmd))
fromPopper :: Popper -> Shell ByteString
fromPopper :: Popper -> Shell ByteString
fromPopper popper :: Popper
popper = Shell ByteString
loop
where
loop :: Shell ByteString
loop = do
PopperRes
result <- Popper -> Shell PopperRes
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO Popper
popper
case PopperRes
result of
PRDone ->
Shell ByteString
forall (f :: * -> *) a. Alternative f => f a
empty
PRNext compressedByteString :: ByteString
compressedByteString ->
ByteString -> Shell ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
compressedByteString Shell ByteString -> Shell ByteString -> Shell ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Shell ByteString
loop
PRError exception :: ZlibException
exception ->
IO ByteString -> Shell ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ZlibException -> IO ByteString
forall e a. Exception e => e -> IO a
Exception.throwIO ZlibException
exception)
compress
:: Int
-> WindowBits
-> Shell ByteString
-> Shell ByteString
compress :: Int -> WindowBits -> Shell ByteString -> Shell ByteString
compress compressionLevel :: Int
compressionLevel windowBits :: WindowBits
windowBits bytestrings :: Shell ByteString
bytestrings = do
Deflate
deflate <- IO Deflate -> Shell Deflate
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> WindowBits -> IO Deflate
Zlib.initDeflate Int
compressionLevel WindowBits
windowBits)
let loop :: Shell ByteString
loop = do
ByteString
bytestring <- Shell ByteString
bytestrings
Popper
popper <- IO Popper -> Shell Popper
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Deflate -> ByteString -> IO Popper
Zlib.feedDeflate Deflate
deflate ByteString
bytestring)
Popper -> Shell ByteString
fromPopper Popper
popper
let wrapUp :: Shell ByteString
wrapUp = do
let popper :: Popper
popper = Popper -> Popper
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Deflate -> Popper
Zlib.finishDeflate Deflate
deflate)
Popper -> Shell ByteString
fromPopper Popper
popper
Shell ByteString
loop Shell ByteString -> Shell ByteString -> Shell ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Shell ByteString
wrapUp
data DecompressionState = Uninitialized | Decompressing Inflate
decompress :: WindowBits -> Shell ByteString -> Shell ByteString
decompress :: WindowBits -> Shell ByteString -> Shell ByteString
decompress windowBits :: WindowBits
windowBits (Shell k :: forall r. FoldShell ByteString r -> IO r
k) = (forall r. FoldShell ByteString r -> IO r) -> Shell ByteString
forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell forall r. FoldShell ByteString r -> IO r
k'
where
k' :: FoldShell ByteString b -> IO b
k' (FoldShell step :: x -> ByteString -> IO x
step begin :: x
begin done :: x -> IO b
done) = FoldShell ByteString b -> IO b
forall r. FoldShell ByteString r -> IO r
k (((x, DecompressionState)
-> ByteString -> IO (x, DecompressionState))
-> (x, DecompressionState)
-> ((x, DecompressionState) -> IO b)
-> FoldShell ByteString b
forall a b x. (x -> a -> IO x) -> x -> (x -> IO b) -> FoldShell a b
FoldShell (x, DecompressionState) -> ByteString -> IO (x, DecompressionState)
step' (x, DecompressionState)
begin' (x, DecompressionState) -> IO b
done')
where
begin' :: (x, DecompressionState)
begin' = (x
begin, DecompressionState
Uninitialized)
step' :: (x, DecompressionState) -> ByteString -> IO (x, DecompressionState)
step' (x0 :: x
x0, Uninitialized) compressedByteString :: ByteString
compressedByteString = do
Inflate
inflate <- WindowBits -> IO Inflate
Zlib.initInflate WindowBits
windowBits
(x, DecompressionState) -> ByteString -> IO (x, DecompressionState)
step' (x
x0, Inflate -> DecompressionState
Decompressing Inflate
inflate) ByteString
compressedByteString
step' (x0 :: x
x0, Decompressing inflate :: Inflate
inflate) compressedByteString :: ByteString
compressedByteString = do
Popper
popper <- Inflate -> ByteString -> IO Popper
Zlib.feedInflate Inflate
inflate ByteString
compressedByteString
let loop :: x -> IO (x, DecompressionState)
loop x :: x
x = do
PopperRes
result <- Popper
popper
case PopperRes
result of
PRDone -> do
ByteString
compressedByteString' <- Inflate -> IO ByteString
Zlib.getUnusedInflate Inflate
inflate
if ByteString -> Bool
Data.ByteString.null ByteString
compressedByteString'
then (x, DecompressionState) -> IO (x, DecompressionState)
forall (m :: * -> *) a. Monad m => a -> m a
return (x
x, Inflate -> DecompressionState
Decompressing Inflate
inflate)
else do
ByteString
decompressedByteString <- Inflate -> IO ByteString
Zlib.finishInflate Inflate
inflate
x
x' <- x -> ByteString -> IO x
step x
x ByteString
decompressedByteString
(x, DecompressionState) -> ByteString -> IO (x, DecompressionState)
step' (x
x', DecompressionState
Uninitialized) ByteString
compressedByteString'
PRNext decompressedByteString :: ByteString
decompressedByteString -> do
x
x' <- x -> ByteString -> IO x
step x
x ByteString
decompressedByteString
x -> IO (x, DecompressionState)
loop x
x'
PRError exception :: ZlibException
exception -> do
ZlibException -> IO (x, DecompressionState)
forall e a. Exception e => e -> IO a
Exception.throwIO ZlibException
exception
x -> IO (x, DecompressionState)
loop x
x0
done' :: (x, DecompressionState) -> IO b
done' (x0 :: x
x0, Uninitialized) = do
x -> IO b
done x
x0
done' (x0 :: x
x0, Decompressing inflate :: Inflate
inflate) = do
ByteString
decompressedByteString <- Inflate -> IO ByteString
Zlib.finishInflate Inflate
inflate
x
x0' <- x -> ByteString -> IO x
step x
x0 ByteString
decompressedByteString
(x, DecompressionState) -> IO b
done' (x
x0', DecompressionState
Uninitialized)
toUTF8 :: Shell ByteString -> Shell Text
toUTF8 :: Shell ByteString -> Shell Text
toUTF8 (Shell k :: forall r. FoldShell ByteString r -> IO r
k) = (forall r. FoldShell Text r -> IO r) -> Shell Text
forall a. (forall r. FoldShell a r -> IO r) -> Shell a
Shell forall r. FoldShell Text r -> IO r
k'
where
k' :: FoldShell Text b -> IO b
k' (FoldShell step :: x -> Text -> IO x
step begin :: x
begin done :: x -> IO b
done) =
FoldShell ByteString b -> IO b
forall r. FoldShell ByteString r -> IO r
k (((ByteString, ByteString -> Decoding, x)
-> ByteString -> IO (ByteString, ByteString -> Decoding, x))
-> (ByteString, ByteString -> Decoding, x)
-> ((ByteString, ByteString -> Decoding, x) -> IO b)
-> FoldShell ByteString b
forall a b x. (x -> a -> IO x) -> x -> (x -> IO b) -> FoldShell a b
FoldShell (ByteString, ByteString -> Decoding, x)
-> ByteString -> IO (ByteString, ByteString -> Decoding, x)
forall a.
Semigroup a =>
(a, a -> Decoding, x)
-> a -> IO (ByteString, ByteString -> Decoding, x)
step' (ByteString, ByteString -> Decoding, x)
begin' (ByteString, ByteString -> Decoding, x) -> IO b
forall a b. (a, b, x) -> IO b
done')
where
begin' :: (ByteString, ByteString -> Decoding, x)
begin' =
(ByteString
forall a. Monoid a => a
mempty, OnDecodeError -> ByteString -> Decoding
Encoding.streamDecodeUtf8With OnDecodeError
Encoding.Error.strictDecode, x
begin)
step' :: (a, a -> Decoding, x)
-> a -> IO (ByteString, ByteString -> Decoding, x)
step' (prefix :: a
prefix, decoder :: a -> Decoding
decoder, x :: x
x) suffix :: a
suffix = do
let bytes :: a
bytes = a
prefix a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
suffix
let Some text :: Text
text prefix' :: ByteString
prefix' decoder' :: ByteString -> Decoding
decoder' = a -> Decoding
decoder a
bytes
x
x' <- x -> Text -> IO x
step x
x Text
text
(ByteString, ByteString -> Decoding, x)
-> IO (ByteString, ByteString -> Decoding, x)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
prefix', ByteString -> Decoding
decoder', x
x')
done' :: (a, b, x) -> IO b
done' (_, _, x :: x
x) = do
x -> IO b
done x
x
fromUTF8 :: Shell Text -> Shell ByteString
fromUTF8 :: Shell Text -> Shell ByteString
fromUTF8 = (Text -> ByteString) -> Shell Text -> Shell ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
Encoding.encodeUtf8