{-# LANGUAGE BangPatterns #-}
module Procex.Quick
( (<!|),
(<<<),
(<|),
(|!>),
(|>),
capture,
captureNoThrow,
captureLazy,
captureLazyNoThrow,
captureErr,
captureErrNoThrow,
captureErrLazy,
captureErrLazyNoThrow,
captureFd,
captureFdNoThrow,
captureFdLazy,
captureFdLazyNoThrow,
pipeArgStrIn,
mq,
QuickCmd (..),
QuickCmdArg (..),
ToByteString (..),
)
where
import Control.Concurrent.Async (Async)
import Control.DeepSeq (force)
import qualified Data.ByteString as BS
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy.UTF8 as B
import Data.Foldable (foldl')
import Procex.Core
import Procex.Process
import System.IO (hClose)
import System.IO.Unsafe (unsafeInterleaveIO)
import System.Posix.Process (ProcessStatus)
import System.Posix.Types (Fd)
class ToByteString a where
toByteString :: a -> B.ByteString
instance a ~ Char => ToByteString [a] where
toByteString :: [a] -> ByteString
toByteString = [a] -> ByteString
String -> ByteString
B.fromString
instance ToByteString B.ByteString where
toByteString :: ByteString -> ByteString
toByteString = ByteString -> ByteString
forall a. a -> a
id
instance ToByteString BS.ByteString where
toByteString :: ByteString -> ByteString
toByteString = ByteString -> ByteString
B.fromStrict
class QuickCmdArg a where
quickCmdArg :: a -> Cmd -> Cmd
class QuickCmd a where
quickCmd :: Cmd -> a
instance QuickCmdArg [Char] where
quickCmdArg :: String -> Cmd -> Cmd
quickCmdArg String
s = ByteString -> Cmd -> Cmd
passArg (ByteString -> Cmd -> Cmd) -> ByteString -> Cmd -> Cmd
forall a b. (a -> b) -> a -> b
$ String -> ByteString
B.fromString String
s
instance QuickCmdArg [String] where
quickCmdArg :: [String] -> Cmd -> Cmd
quickCmdArg = ((Cmd -> [String] -> Cmd) -> [String] -> Cmd -> Cmd
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Cmd -> [String] -> Cmd) -> [String] -> Cmd -> Cmd)
-> ((String -> Cmd -> Cmd) -> Cmd -> [String] -> Cmd)
-> (String -> Cmd -> Cmd)
-> [String]
-> Cmd
-> Cmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cmd -> String -> Cmd) -> Cmd -> [String] -> Cmd
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Cmd -> String -> Cmd) -> Cmd -> [String] -> Cmd)
-> ((String -> Cmd -> Cmd) -> Cmd -> String -> Cmd)
-> (String -> Cmd -> Cmd)
-> Cmd
-> [String]
-> Cmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Cmd -> Cmd) -> Cmd -> String -> Cmd
forall a b c. (a -> b -> c) -> b -> a -> c
flip) String -> Cmd -> Cmd
forall a. QuickCmdArg a => a -> Cmd -> Cmd
quickCmdArg
instance QuickCmdArg [ByteString] where
quickCmdArg :: [ByteString] -> Cmd -> Cmd
quickCmdArg = ((Cmd -> [ByteString] -> Cmd) -> [ByteString] -> Cmd -> Cmd
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Cmd -> [ByteString] -> Cmd) -> [ByteString] -> Cmd -> Cmd)
-> ((ByteString -> Cmd -> Cmd) -> Cmd -> [ByteString] -> Cmd)
-> (ByteString -> Cmd -> Cmd)
-> [ByteString]
-> Cmd
-> Cmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cmd -> ByteString -> Cmd) -> Cmd -> [ByteString] -> Cmd
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Cmd -> ByteString -> Cmd) -> Cmd -> [ByteString] -> Cmd)
-> ((ByteString -> Cmd -> Cmd) -> Cmd -> ByteString -> Cmd)
-> (ByteString -> Cmd -> Cmd)
-> Cmd
-> [ByteString]
-> Cmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Cmd -> Cmd) -> Cmd -> ByteString -> Cmd
forall a b c. (a -> b -> c) -> b -> a -> c
flip) ByteString -> Cmd -> Cmd
forall a. QuickCmdArg a => a -> Cmd -> Cmd
quickCmdArg
instance QuickCmdArg [(Cmd -> Cmd)] where
quickCmdArg :: [Cmd -> Cmd] -> Cmd -> Cmd
quickCmdArg = ((Cmd -> [Cmd -> Cmd] -> Cmd) -> [Cmd -> Cmd] -> Cmd -> Cmd
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Cmd -> [Cmd -> Cmd] -> Cmd) -> [Cmd -> Cmd] -> Cmd -> Cmd)
-> (((Cmd -> Cmd) -> Cmd -> Cmd) -> Cmd -> [Cmd -> Cmd] -> Cmd)
-> ((Cmd -> Cmd) -> Cmd -> Cmd)
-> [Cmd -> Cmd]
-> Cmd
-> Cmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cmd -> (Cmd -> Cmd) -> Cmd) -> Cmd -> [Cmd -> Cmd] -> Cmd
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Cmd -> (Cmd -> Cmd) -> Cmd) -> Cmd -> [Cmd -> Cmd] -> Cmd)
-> (((Cmd -> Cmd) -> Cmd -> Cmd) -> Cmd -> (Cmd -> Cmd) -> Cmd)
-> ((Cmd -> Cmd) -> Cmd -> Cmd)
-> Cmd
-> [Cmd -> Cmd]
-> Cmd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Cmd -> Cmd) -> Cmd -> Cmd) -> Cmd -> (Cmd -> Cmd) -> Cmd
forall a b c. (a -> b -> c) -> b -> a -> c
flip) (Cmd -> Cmd) -> Cmd -> Cmd
forall a. QuickCmdArg a => a -> Cmd -> Cmd
quickCmdArg
instance QuickCmdArg ByteString where
quickCmdArg :: ByteString -> Cmd -> Cmd
quickCmdArg = ByteString -> Cmd -> Cmd
passArg
instance QuickCmdArg (Cmd -> Cmd) where
quickCmdArg :: (Cmd -> Cmd) -> Cmd -> Cmd
quickCmdArg = (Cmd -> Cmd) -> Cmd -> Cmd
forall a. a -> a
id
instance {-# OVERLAPPABLE #-} (QuickCmdArg a, QuickCmd b) => QuickCmd (a -> b) where
quickCmd :: Cmd -> a -> b
quickCmd Cmd
cmd a
arg = Cmd -> b
forall a. QuickCmd a => Cmd -> a
quickCmd (Cmd -> b) -> Cmd -> b
forall a b. (a -> b) -> a -> b
$ a -> Cmd -> Cmd
forall a. QuickCmdArg a => a -> Cmd -> Cmd
quickCmdArg a
arg Cmd
cmd
instance (a ~ ()) => QuickCmd (IO a) where
quickCmd :: Cmd -> IO a
quickCmd = Cmd -> IO a
Cmd -> IO ()
run
instance QuickCmd Cmd where
quickCmd :: Cmd -> Cmd
quickCmd = Cmd -> Cmd
forall a. a -> a
id
mq ::
(QuickCmd a, ToByteString b) =>
b ->
a
mq :: b -> a
mq b
path = Cmd -> a
forall a. QuickCmd a => Cmd -> a
quickCmd (Cmd -> a) -> Cmd -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> Cmd
makeCmd (b -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString b
path)
infixl 1 <|
(<|) :: QuickCmd a => Cmd -> Cmd -> a
<| :: Cmd -> Cmd -> a
(<|) Cmd
x Cmd
y = Cmd -> a
forall a. QuickCmd a => Cmd -> a
quickCmd (Cmd -> a) -> Cmd -> a
forall a b. (a -> b) -> a -> b
$ Fd -> Fd -> Cmd -> Cmd -> Cmd
pipeIn Fd
1 Fd
0 Cmd
y Cmd
x
infixl 1 <!|
(<!|) :: QuickCmd a => Cmd -> Cmd -> a
<!| :: Cmd -> Cmd -> a
(<!|) Cmd
x Cmd
y = Cmd -> a
forall a. QuickCmd a => Cmd -> a
quickCmd (Cmd -> a) -> Cmd -> a
forall a b. (a -> b) -> a -> b
$ Fd -> Fd -> Cmd -> Cmd -> Cmd
pipeIn Fd
2 Fd
0 Cmd
y Cmd
x
infixl 1 |>
(|>) :: QuickCmd a => Cmd -> Cmd -> a
|> :: Cmd -> Cmd -> a
(|>) Cmd
x Cmd
y = Cmd -> a
forall a. QuickCmd a => Cmd -> a
quickCmd (Cmd -> a) -> Cmd -> a
forall a b. (a -> b) -> a -> b
$ Fd -> Fd -> Cmd -> Cmd -> Cmd
pipeOut Fd
0 Fd
1 Cmd
y Cmd
x
infixl 1 |!>
(|!>) :: QuickCmd a => Cmd -> Cmd -> a
|!> :: Cmd -> Cmd -> a
(|!>) Cmd
x Cmd
y = Cmd -> a
forall a. QuickCmd a => Cmd -> a
quickCmd (Cmd -> a) -> Cmd -> a
forall a b. (a -> b) -> a -> b
$ Fd -> Fd -> Cmd -> Cmd -> Cmd
pipeOut Fd
0 Fd
2 Cmd
y Cmd
x
infixl 1 <<<
(<<<) :: (QuickCmd a, ToByteString b) => Cmd -> b -> a
<<< :: Cmd -> b -> a
(<<<) Cmd
cmd b
str = Cmd -> a
forall a. QuickCmd a => Cmd -> a
quickCmd (Cmd -> a) -> Cmd -> a
forall a b. (a -> b) -> a -> b
$ Fd -> (Async ProcessStatus -> Handle -> IO ()) -> Cmd -> Cmd
pipeHIn Fd
0 (\Async ProcessStatus
_ Handle
h -> Handle -> ByteString -> IO ()
B.hPut Handle
h (b -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString b
str) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hClose Handle
h) Cmd
cmd
pipeArgStrIn :: ToByteString b => b -> Cmd -> Cmd
pipeArgStrIn :: b -> Cmd -> Cmd
pipeArgStrIn b
str = (Async ProcessStatus -> Handle -> IO ()) -> Cmd -> Cmd
pipeArgHIn (\Async ProcessStatus
_ Handle
h -> Handle -> ByteString -> IO ()
B.hPut Handle
h (b -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString b
str) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hClose Handle
h)
attachFinalizer :: IO () -> ByteString -> IO ByteString
attachFinalizer :: IO () -> ByteString -> IO ByteString
attachFinalizer IO ()
finalizer ByteString
str = [ByteString] -> ByteString
B.fromChunks ([ByteString] -> ByteString) -> IO [ByteString] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString] -> IO [ByteString]
go (ByteString -> [ByteString]
B.toChunks ByteString
str)
where
go' :: [BS.ByteString] -> IO [BS.ByteString]
go' :: [ByteString] -> IO [ByteString]
go' [] = IO ()
finalizer IO () -> IO [ByteString] -> IO [ByteString]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [ByteString] -> IO [ByteString]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
go' (ByteString
x : [ByteString]
xs) = (ByteString
x ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:) ([ByteString] -> [ByteString])
-> IO [ByteString] -> IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString] -> IO [ByteString]
go [ByteString]
xs
go :: [BS.ByteString] -> IO [BS.ByteString]
go :: [ByteString] -> IO [ByteString]
go = IO [ByteString] -> IO [ByteString]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [ByteString] -> IO [ByteString])
-> ([ByteString] -> IO [ByteString])
-> [ByteString]
-> IO [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> IO [ByteString]
go'
captureFdLazy :: Fd -> Cmd -> IO ByteString
captureFdLazy :: Fd -> Cmd -> IO ByteString
captureFdLazy Fd
fd Cmd
cmd = do
(Async ProcessStatus
status, [Item [Handle]
h]) <- [Fd] -> Cmd -> IO (Async ProcessStatus, [Handle])
captureFdsAsHandles [Item [Fd]
Fd
fd] Cmd
cmd
ByteString
out <- Handle -> IO ByteString
B.hGetContents Handle
Item [Handle]
h
IO () -> ByteString -> IO ByteString
attachFinalizer (Async ProcessStatus -> IO ()
waitCmd Async ProcessStatus
status) ByteString
out
captureFdLazyNoThrow :: Fd -> Cmd -> IO ByteString
captureFdLazyNoThrow :: Fd -> Cmd -> IO ByteString
captureFdLazyNoThrow Fd
fd Cmd
cmd = do
(Async ProcessStatus
_, [Item [Handle]
h]) <- [Fd] -> Cmd -> IO (Async ProcessStatus, [Handle])
captureFdsAsHandles [Item [Fd]
Fd
fd] Cmd
cmd
Handle -> IO ByteString
B.hGetContents Handle
Item [Handle]
h
captureLazy :: Cmd -> IO ByteString
captureLazy :: Cmd -> IO ByteString
captureLazy = Fd -> Cmd -> IO ByteString
captureFdLazy Fd
1
captureErrLazy :: Cmd -> IO ByteString
captureErrLazy :: Cmd -> IO ByteString
captureErrLazy = Fd -> Cmd -> IO ByteString
captureFdLazy Fd
2
captureLazyNoThrow :: Cmd -> IO ByteString
captureLazyNoThrow :: Cmd -> IO ByteString
captureLazyNoThrow = Fd -> Cmd -> IO ByteString
captureFdLazyNoThrow Fd
1
captureErrLazyNoThrow :: Cmd -> IO ByteString
captureErrLazyNoThrow :: Cmd -> IO ByteString
captureErrLazyNoThrow = Fd -> Cmd -> IO ByteString
captureFdLazyNoThrow Fd
2
captureFd' :: Fd -> Cmd -> IO (Async ProcessStatus, ByteString)
captureFd' :: Fd -> Cmd -> IO (Async ProcessStatus, ByteString)
captureFd' Fd
fd Cmd
cmd = do
(Async ProcessStatus
status, [Item [Handle]
h]) <- [Fd] -> Cmd -> IO (Async ProcessStatus, [Handle])
captureFdsAsHandles [Item [Fd]
Fd
fd] Cmd
cmd
!ByteString
out <- ByteString -> ByteString
forall a. NFData a => a -> a
force (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO ByteString
B.hGetContents Handle
Item [Handle]
h
(Async ProcessStatus, ByteString)
-> IO (Async ProcessStatus, ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Async ProcessStatus
status, ByteString
out)
captureFd :: Fd -> Cmd -> IO ByteString
captureFd :: Fd -> Cmd -> IO ByteString
captureFd Fd
fd Cmd
cmd = do
(Async ProcessStatus
status, ByteString
out) <- Fd -> Cmd -> IO (Async ProcessStatus, ByteString)
captureFd' Fd
fd Cmd
cmd
Async ProcessStatus -> IO ()
waitCmd Async ProcessStatus
status
ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
out
captureFdNoThrow :: Fd -> Cmd -> IO ByteString
captureFdNoThrow :: Fd -> Cmd -> IO ByteString
captureFdNoThrow Fd
fd Cmd
cmd = do
(Async ProcessStatus
_, ByteString
out) <- Fd -> Cmd -> IO (Async ProcessStatus, ByteString)
captureFd' Fd
fd Cmd
cmd
ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
out
capture :: Cmd -> IO ByteString
capture :: Cmd -> IO ByteString
capture = Fd -> Cmd -> IO ByteString
captureFd Fd
1
captureNoThrow :: Cmd -> IO ByteString
captureNoThrow :: Cmd -> IO ByteString
captureNoThrow = Fd -> Cmd -> IO ByteString
captureFdNoThrow Fd
1
captureErr :: Cmd -> IO ByteString
captureErr :: Cmd -> IO ByteString
captureErr = Fd -> Cmd -> IO ByteString
captureFd Fd
2
captureErrNoThrow :: Cmd -> IO ByteString
captureErrNoThrow :: Cmd -> IO ByteString
captureErrNoThrow = Fd -> Cmd -> IO ByteString
captureFdNoThrow Fd
2