{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE CPP #-}

-- | See documentation for "Shh".
module Shh.Internal where

import Prelude hiding (lines, unlines)

import Control.Concurrent.Async
import Control.Concurrent.MVar
import Control.DeepSeq (force,NFData)
import Control.Exception as C
import Control.Monad
import Control.Monad.IO.Class
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Unsafe as ByteString
import Data.ByteString.Lazy (ByteString, hGetContents, toStrict, fromStrict)
import qualified Data.ByteString.Lazy as BS
import Data.ByteString.Lazy.Builder.ASCII
import qualified Data.ByteString.Lazy.Char8 as BC8
import qualified Data.ByteString.Lazy.Search as Search
import Data.ByteString.Lazy.UTF8 (toString)
import Data.Char (isLower, isSpace, isAlphaNum, ord)
import Data.List (intercalate)
import qualified Data.List.Split as Split
import qualified Data.Map as Map
import Data.Maybe (isJust)
import Data.Typeable
import GHC.IO.BufferedIO
import GHC.IO.Device as IODevice hiding (read)
import GHC.IO.Encoding
import GHC.Foreign (peekCStringLen, newCStringLen)
import GHC.IO.Exception (IOErrorType(ResourceVanished))
import GHC.IO.Handle hiding (hGetContents)
import GHC.IO.Handle.Internals
import GHC.IO.Handle.Types
import GHC.IO.Handle.Types (Handle(..))
import GHC.Stack
import Language.Haskell.TH
import qualified System.Directory as Dir
import System.Environment (getEnv, setEnv)
import System.Exit (ExitCode(..))
import System.FilePath (takeFileName, (</>))
import System.IO (IOMode(..), withFile, withBinaryFile, stderr, stdout, stdin)
import System.IO.Unsafe (unsafePerformIO)
import System.IO.Error
import System.Posix.Signals
import System.Process
import Text.Printf

-- $setup
-- For doc-tests. Not sure I can use TH in doc tests.
-- >>> :seti -XOverloadedStrings
-- >>> import Data.Monoid
-- >>> import Data.ByteString.Lazy.Char8 (lines)
-- >>> let cat = exe "cat"
-- >>> let echo = exe "echo"
-- >>> let false = exe "false"
-- >>> let head = exe "head"
-- >>> let md5sum = exe "md5sum"
-- >>> let printf = exe "printf"
-- >>> let sleep = exe "sleep"
-- >>> let true = exe "true"
-- >>> let wc = exe "wc"
-- >>> let xargs = exe "xargs"
-- >>> let yes = exe "yes"
-- >>> let some_command = writeOutput "this is stdout" >> (writeOutput "this is stderr" &> StdErr)

-- | This function needs to be called in order to use the library successfully
-- from GHCi. If you use the @formatPrompt@ function from the @shh-extras@
-- package, this will be automatically called for you.
initInteractive :: IO ()
initInteractive :: IO ()
initInteractive = do
    Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin BufferMode
LineBuffering

-- | When a process exits with a non-zero exit code
-- we throw this @Failure@ exception.
--
-- The only exception to this is when a process is terminated
-- by @SIGPIPE@ in a pipeline, in which case we ignore it.
data Failure = Failure
    { Failure -> ByteString
failureProg   :: ByteString
    , Failure -> [ByteString]
failureArgs   :: [ByteString]
    , Failure -> CallStack
failureStack  :: CallStack
    , Failure -> Int
failureCode   :: Int
    -- | Failure can optionally contain the stderr of a process.
    , Failure -> Maybe ByteString
failureStdErr :: Maybe ByteString
    }

instance Show Failure where
    show :: Failure -> String
show f :: Failure
f = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
        [ "Command `"
        ]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " " (ByteString -> String
toString (Failure -> ByteString
failureProg Failure
f) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (ByteString -> String) -> [ByteString] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> String
forall a. Show a => a -> String
show (Failure -> [ByteString]
failureArgs Failure
f))]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
        [ "` failed [exit "
        , Int -> String
forall a. Show a => a -> String
show (Failure -> Int
failureCode Failure
f)
        , "] at "
        , CallStack -> String
prettyCallStack (Failure -> CallStack
failureStack Failure
f)
        ]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ((ByteString -> [String]) -> Maybe ByteString -> [String])
-> Maybe ByteString -> (ByteString -> [String]) -> [String]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([String]
-> (ByteString -> [String]) -> Maybe ByteString -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe []) (Failure -> Maybe ByteString
failureStdErr Failure
f) (\s :: ByteString
s ->
           ["\n-- stderr --\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
toString ByteString
s])

instance Exception Failure

-- | This class is used to allow most of the operators in Shh to be
-- polymorphic in their return value. This makes using them in an `IO` context
-- easier (we can avoid having to prepend everything with a `runProc`).
class Shell f where
    runProc :: HasCallStack => Proc a -> f a

-- | Helper function that creates and potentially executes a @`Proc`@
buildProc :: Shell f => (Handle -> Handle -> Handle -> IO a) -> f a
buildProc :: (Handle -> Handle -> Handle -> IO a) -> f a
buildProc = Proc a -> f a
forall (f :: * -> *) a. (Shell f, HasCallStack) => Proc a -> f a
runProc (Proc a -> f a)
-> ((Handle -> Handle -> Handle -> IO a) -> Proc a)
-> (Handle -> Handle -> Handle -> IO a)
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Handle -> Handle -> Handle -> IO a) -> Proc a
forall a. (Handle -> Handle -> Handle -> IO a) -> Proc a
Proc

-- | Like @`|>`@ except that it keeps both return results. Be aware
-- that the @fst@ element of this tuple may be hiding a @SIGPIPE@
-- exception that will explode on you once you look at it.
--
-- You probably want to use @`|>`@ unless you know you don't.
pipe :: Shell f => Proc a -> Proc b -> f (a, b)
pipe :: Proc a -> Proc b -> f (a, b)
pipe (Proc a :: Handle -> Handle -> Handle -> IO a
a) (Proc b :: Handle -> Handle -> Handle -> IO b
b) = (Handle -> Handle -> Handle -> IO (a, b)) -> f (a, b)
forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc ((Handle -> Handle -> Handle -> IO (a, b)) -> f (a, b))
-> (Handle -> Handle -> Handle -> IO (a, b)) -> f (a, b)
forall a b. (a -> b) -> a -> b
$ \i :: Handle
i o :: Handle
o e :: Handle
e ->
    (Handle -> Handle -> IO (a, b)) -> IO (a, b)
forall a. (Handle -> Handle -> IO a) -> IO a
withPipe ((Handle -> Handle -> IO (a, b)) -> IO (a, b))
-> (Handle -> Handle -> IO (a, b)) -> IO (a, b)
forall a b. (a -> b) -> a -> b
$ \r :: Handle
r w :: Handle
w -> do
        let
            a' :: IO a
a' = Handle -> Handle -> Handle -> IO a
a Handle
i Handle
w Handle
e IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`finally` (Handle -> IO ()
hClose Handle
w)
            b' :: IO b
b' = Handle -> Handle -> Handle -> IO b
b Handle
r Handle
o Handle
e IO b -> IO () -> IO b
forall a b. IO a -> IO b -> IO a
`finally` (Handle -> IO ()
hClose Handle
r)
        IO a -> IO b -> IO (a, b)
forall a b. IO a -> IO b -> IO (a, b)
concurrently IO a
a' IO b
b'

-- | Like @`pipe`@, but plumbs stderr. See the warning in @`pipe`@.
pipeErr :: Shell f => Proc a -> Proc b -> f (a, b)
pipeErr :: Proc a -> Proc b -> f (a, b)
pipeErr (Proc a :: Handle -> Handle -> Handle -> IO a
a) (Proc b :: Handle -> Handle -> Handle -> IO b
b) = (Handle -> Handle -> Handle -> IO (a, b)) -> f (a, b)
forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc ((Handle -> Handle -> Handle -> IO (a, b)) -> f (a, b))
-> (Handle -> Handle -> Handle -> IO (a, b)) -> f (a, b)
forall a b. (a -> b) -> a -> b
$ \i :: Handle
i o :: Handle
o e :: Handle
e -> do
    (Handle -> Handle -> IO (a, b)) -> IO (a, b)
forall a. (Handle -> Handle -> IO a) -> IO a
withPipe ((Handle -> Handle -> IO (a, b)) -> IO (a, b))
-> (Handle -> Handle -> IO (a, b)) -> IO (a, b)
forall a b. (a -> b) -> a -> b
$ \r :: Handle
r w :: Handle
w -> do
        let
            a' :: IO a
a' = Handle -> Handle -> Handle -> IO a
a Handle
i Handle
o Handle
w IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`finally` (Handle -> IO ()
hClose Handle
w)
            b' :: IO b
b' = Handle -> Handle -> Handle -> IO b
b Handle
r Handle
o Handle
e IO b -> IO () -> IO b
forall a b. IO a -> IO b -> IO a
`finally` (Handle -> IO ()
hClose Handle
r)
        IO a -> IO b -> IO (a, b)
forall a b. IO a -> IO b -> IO (a, b)
concurrently IO a
a' IO b
b'


-- | Use this to send the output of on process into the input of another.
-- This is just like a shell's `|` operator.
--
-- The result is polymorphic in its output, and can result in either
-- another `Proc a` or an `IO a` depending on the context in which it is
-- used.
--
-- If any intermediate process throws an exception, the whole pipeline
-- is canceled.
--
-- The result of the last process in the chain is the result returned
-- by the pipeline. 
--
-- >>> echo "Hello" |> wc
--       1       1       6
(|>) :: Shell f => Proc a -> Proc b -> f b
a :: Proc a
a |> :: Proc a -> Proc b -> f b
|> b :: Proc b
b = Proc b -> f b
forall (f :: * -> *) a. (Shell f, HasCallStack) => Proc a -> f a
runProc (Proc b -> f b) -> Proc b -> f b
forall a b. (a -> b) -> a -> b
$ do
    b
v <- ((a, b) -> b) -> Proc (a, b) -> Proc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> b
forall a b. (a, b) -> b
snd (Proc a
a Proc a -> Proc b -> Proc (a, b)
forall (f :: * -> *) a b. Shell f => Proc a -> Proc b -> f (a, b)
`pipe` Proc b
b)
    b -> Proc b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
v
infixl 1 |>


-- | Similar to `|!>` except that it connects stderr to stdin of the
-- next process in the chain.
--
-- NB: The next command to be `|>` on will recapture the stdout of
-- both preceding processes, because they are both going to the same
-- handle!
--                                            
-- See the `&>` and `&!>` operators for redirection.
--
-- >>> echo "Ignored" |!> wc "-c"
-- Ignored
-- 0
(|!>) :: Shell f => Proc a -> Proc b -> f b
a :: Proc a
a |!> :: Proc a -> Proc b -> f b
|!> b :: Proc b
b = Proc b -> f b
forall (f :: * -> *) a. (Shell f, HasCallStack) => Proc a -> f a
runProc (Proc b -> f b) -> Proc b -> f b
forall a b. (a -> b) -> a -> b
$ do
    b
v <- ((a, b) -> b) -> Proc (a, b) -> Proc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> b
forall a b. (a, b) -> b
snd (Proc a
a Proc a -> Proc b -> Proc (a, b)
forall (f :: * -> *) a b. Shell f => Proc a -> Proc b -> f (a, b)
`pipeErr` Proc b
b)
    b -> Proc b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
v
infixl 1 |!>

-- | Things that can be converted to a @`FilePath`@.
--
-- The results must use the file system encoding. Use this
-- if you want to pass a @ByteString@ to @`System.IO.openFile`@,
-- or if you want to turn a @FilePath@ into a @ByteString@.
--
-- If you never change the file system encoding, it should be safe to use
-- @`unsafePerformIO`@ on these functions.
class ToFilePath a where
    toFilePath :: a -> IO FilePath
    fromFilePath :: FilePath -> IO a

instance ToFilePath FilePath where
    toFilePath :: String -> IO String
toFilePath = String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    fromFilePath :: String -> IO String
fromFilePath = String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance ToFilePath ByteString.ByteString where
    toFilePath :: ByteString -> IO String
toFilePath bs :: ByteString
bs = do
        TextEncoding
enc <- IO TextEncoding
getFileSystemEncoding
        ByteString -> (CStringLen -> IO String) -> IO String
forall a. ByteString -> (CStringLen -> IO a) -> IO a
ByteString.useAsCStringLen ByteString
bs (TextEncoding -> CStringLen -> IO String
peekCStringLen TextEncoding
enc)
    fromFilePath :: String -> IO ByteString
fromFilePath fp :: String
fp = do
        TextEncoding
enc <- IO TextEncoding
getFileSystemEncoding
        TextEncoding -> String -> IO CStringLen
newCStringLen TextEncoding
enc String
fp IO CStringLen -> (CStringLen -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CStringLen -> IO ByteString
ByteString.unsafePackMallocCStringLen

instance ToFilePath ByteString where
    toFilePath :: ByteString -> IO String
toFilePath = ByteString -> IO String
forall a. ToFilePath a => a -> IO String
toFilePath (ByteString -> IO String)
-> (ByteString -> ByteString) -> ByteString -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict
    fromFilePath :: String -> IO ByteString
fromFilePath = (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
fromStrict (IO ByteString -> IO ByteString)
-> (String -> IO ByteString) -> String -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ByteString
forall a. ToFilePath a => String -> IO a
fromFilePath

--
-- | Redirect stdout of this process to another location
--
-- >>> echo "Ignore me" &> Append "/dev/null"
(&>) :: Shell f => Proc a -> Stream -> f a
p :: Proc a
p &> :: Proc a -> Stream -> f a
&> StdOut = Proc a -> f a
forall (f :: * -> *) a. (Shell f, HasCallStack) => Proc a -> f a
runProc Proc a
p
(Proc f :: Handle -> Handle -> Handle -> IO a
f) &> StdErr = (Handle -> Handle -> Handle -> IO a) -> f a
forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc ((Handle -> Handle -> Handle -> IO a) -> f a)
-> (Handle -> Handle -> Handle -> IO a) -> f a
forall a b. (a -> b) -> a -> b
$ \i :: Handle
i _ e :: Handle
e -> Handle -> Handle -> Handle -> IO a
f Handle
i Handle
e Handle
e
(Proc f :: Handle -> Handle -> Handle -> IO a
f) &> (Truncate path :: ByteString
path) = (Handle -> Handle -> Handle -> IO a) -> f a
forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc ((Handle -> Handle -> Handle -> IO a) -> f a)
-> (Handle -> Handle -> Handle -> IO a) -> f a
forall a b. (a -> b) -> a -> b
$ \i :: Handle
i _ e :: Handle
e -> do
    String
path' <- ByteString -> IO String
forall a. ToFilePath a => a -> IO String
toFilePath ByteString
path
    String -> IOMode -> (Handle -> IO a) -> IO a
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
path' IOMode
WriteMode ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \h :: Handle
h -> Handle -> Handle -> Handle -> IO a
f Handle
i Handle
h Handle
e
(Proc f :: Handle -> Handle -> Handle -> IO a
f) &> (Append path :: ByteString
path) = (Handle -> Handle -> Handle -> IO a) -> f a
forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc ((Handle -> Handle -> Handle -> IO a) -> f a)
-> (Handle -> Handle -> Handle -> IO a) -> f a
forall a b. (a -> b) -> a -> b
$ \i :: Handle
i _ e :: Handle
e -> do
    String
path' <- ByteString -> IO String
forall a. ToFilePath a => a -> IO String
toFilePath ByteString
path
    String -> IOMode -> (Handle -> IO a) -> IO a
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
path' IOMode
AppendMode ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \h :: Handle
h -> Handle -> Handle -> Handle -> IO a
f Handle
i Handle
h Handle
e
infixl 9 &>

-- | Redirect stderr of this process to another location
--
-- >>> echo "Shh" &!> StdOut
-- Shh
(&!>) :: Shell f => Proc a -> Stream -> f a
p :: Proc a
p &!> :: Proc a -> Stream -> f a
&!> StdErr = Proc a -> f a
forall (f :: * -> *) a. (Shell f, HasCallStack) => Proc a -> f a
runProc (Proc a -> f a) -> Proc a -> f a
forall a b. (a -> b) -> a -> b
$ Proc a
p
(Proc f :: Handle -> Handle -> Handle -> IO a
f) &!> StdOut = (Handle -> Handle -> Handle -> IO a) -> f a
forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc ((Handle -> Handle -> Handle -> IO a) -> f a)
-> (Handle -> Handle -> Handle -> IO a) -> f a
forall a b. (a -> b) -> a -> b
$ \i :: Handle
i o :: Handle
o _ -> Handle -> Handle -> Handle -> IO a
f Handle
i Handle
o Handle
o
(Proc f :: Handle -> Handle -> Handle -> IO a
f) &!> (Truncate path :: ByteString
path) = (Handle -> Handle -> Handle -> IO a) -> f a
forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc ((Handle -> Handle -> Handle -> IO a) -> f a)
-> (Handle -> Handle -> Handle -> IO a) -> f a
forall a b. (a -> b) -> a -> b
$ \i :: Handle
i o :: Handle
o _ -> do
    String
path' <- ByteString -> IO String
forall a. ToFilePath a => a -> IO String
toFilePath ByteString
path
    String -> IOMode -> (Handle -> IO a) -> IO a
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
path' IOMode
WriteMode ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \h :: Handle
h -> Handle -> Handle -> Handle -> IO a
f Handle
i Handle
o Handle
h
(Proc f :: Handle -> Handle -> Handle -> IO a
f) &!> (Append path :: ByteString
path) = (Handle -> Handle -> Handle -> IO a) -> f a
forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc ((Handle -> Handle -> Handle -> IO a) -> f a)
-> (Handle -> Handle -> Handle -> IO a) -> f a
forall a b. (a -> b) -> a -> b
$ \i :: Handle
i o :: Handle
o _ -> do
    String
path' <- ByteString -> IO String
forall a. ToFilePath a => a -> IO String
toFilePath ByteString
path
    String -> IOMode -> (Handle -> IO a) -> IO a
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
path' IOMode
AppendMode ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \h :: Handle
h -> Handle -> Handle -> Handle -> IO a
f Handle
i Handle
o Handle
h
infixl 9 &!>

-- | Lift a Haskell function into a @`Proc`@. The handles are the @stdin@
-- @stdout@ and @stderr@ of the resulting @`Proc`@
nativeProc :: (Shell f, NFData a) => (Handle -> Handle -> Handle -> IO a) -> f a
nativeProc :: (Handle -> Handle -> Handle -> IO a) -> f a
nativeProc f :: Handle -> Handle -> Handle -> IO a
f = Proc a -> f a
forall (f :: * -> *) a. (Shell f, HasCallStack) => Proc a -> f a
runProc (Proc a -> f a) -> Proc a -> f a
forall a b. (a -> b) -> a -> b
$ (Handle -> Handle -> Handle -> IO a) -> Proc a
forall a. (Handle -> Handle -> Handle -> IO a) -> Proc a
Proc ((Handle -> Handle -> Handle -> IO a) -> Proc a)
-> (Handle -> Handle -> Handle -> IO a) -> Proc a
forall a b. (a -> b) -> a -> b
$ \i :: Handle
i o :: Handle
o e :: Handle
e -> (IOError -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle IOError -> IO a
forall a. IOError -> IO a
handler (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
    -- We duplicate these so that you can't accidentally close the
    -- real ones.
    Handle
-> Handle -> Handle -> (Handle -> Handle -> Handle -> IO a) -> IO a
forall a.
Handle
-> Handle -> Handle -> (Handle -> Handle -> Handle -> IO a) -> IO a
withDuplicates Handle
i Handle
o Handle
e ((Handle -> Handle -> Handle -> IO a) -> IO a)
-> (Handle -> Handle -> Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \i' :: Handle
i' o' :: Handle
o' e' :: Handle
e' -> do
        (Handle -> Handle -> Handle -> IO a
f Handle
i' Handle
o' Handle
e' IO a -> (a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO a
forall a. a -> IO a
C.evaluate (a -> IO a) -> (a -> a) -> a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. NFData a => a -> a
force)
            IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`finally` (Handle -> IO ()
hClose Handle
i')
            IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`finally` (Handle -> IO ()
hClose Handle
o')
            IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`finally` (Handle -> IO ()
hClose Handle
e')

    where
        -- The resource vanished error only occurs when upstream pipe closes.
        -- This can only happen with the `|>` combinator, which will discard
        -- the result of this `Proc` anyway. If the return value is somehow
        -- inspected, or maybe if the exception is somehow legitimate, we
        -- simply package it up as an exploding return value. `runProc` will
        -- make sure to evaluate all `Proc`'s to WHNF in order to uncover it.
        -- This should never happen. *nervous*
        handler :: IOError -> IO a
        handler :: IOError -> IO a
handler e :: IOError
e
            | IOError -> IOErrorType
ioeGetErrorType IOError
e IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
== IOErrorType
ResourceVanished = a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IOError -> a
forall a e. Exception e => e -> a
throw IOError
e)
            | Bool
otherwise = IOError -> IO a
forall e a. Exception e => e -> IO a
throwIO IOError
e

-- | Flipped version of `|>` with lower precedence.
--
-- >>> captureTrim <| (echo "Hello" |> wc "-c")
-- "6"
(<|) :: Shell f => Proc a -> Proc b -> f a
<| :: Proc a -> Proc b -> f a
(<|) = (Proc b -> Proc a -> f a) -> Proc a -> Proc b -> f a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Proc b -> Proc a -> f a
forall (f :: * -> *) a b. Shell f => Proc a -> Proc b -> f b
(|>)
infixr 1 <|

-- | Create a pipe, and close both ends on exception. The first argument
-- is the read end, the second is the write end.
--
-- >>> withPipe $ \r w -> hPutStr w "test" >> hClose w >> hGetLine r
-- "test"
withPipe :: (Handle -> Handle -> IO a) -> IO a
withPipe :: (Handle -> Handle -> IO a) -> IO a
withPipe k :: Handle -> Handle -> IO a
k =
    IO (Handle, Handle)
-> ((Handle, Handle) -> IO ())
-> ((Handle, Handle) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
        IO (Handle, Handle)
createPipe
        (\(r :: Handle
r,w :: Handle
w) -> Handle -> IO ()
hClose Handle
r IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
hClose Handle
w)
        (\(r :: Handle
r,w :: Handle
w) -> Handle -> Handle -> IO a
k Handle
r Handle
w)

-- | Simple @`Proc`@ that writes its argument to its @stdout@. This behaves
-- very much like the standard @printf@ utility, except that there is no
-- restriction as to what can be in the argument.
--
-- NB: @String@ arguments are encoded as UTF8, while @ByteString@ is passed
-- through. Be aware if you are using @OverloadedStrings@ that you will get
-- wrong results if using unicode in your string literal and it inferes
-- anything other than @String@.
--
-- >>> writeOutput "Hello"
-- Hello
writeOutput :: (ExecArg a, Shell io) => a -> io ()
writeOutput :: a -> io ()
writeOutput s :: a
s = (Handle -> Handle -> Handle -> IO ()) -> io ()
forall (f :: * -> *) a.
(Shell f, NFData a) =>
(Handle -> Handle -> Handle -> IO a) -> f a
nativeProc ((Handle -> Handle -> Handle -> IO ()) -> io ())
-> (Handle -> Handle -> Handle -> IO ()) -> io ()
forall a b. (a -> b) -> a -> b
$ \_ o :: Handle
o _ -> do
    (ByteString -> IO ()) -> [ByteString] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> ByteString -> IO ()
BS.hPutStr Handle
o) (a -> [ByteString]
forall a. ExecArg a => a -> [ByteString]
asArg a
s)

-- | Simple @`Proc`@ that writes its argument to its @stderr@.
-- See also @`writeOutput`@.
--
-- >>> writeError "Hello" &> devNull
-- Hello
writeError :: (ExecArg a, Shell io) => a -> io ()
writeError :: a -> io ()
writeError s :: a
s = (Handle -> Handle -> Handle -> IO ()) -> io ()
forall (f :: * -> *) a.
(Shell f, NFData a) =>
(Handle -> Handle -> Handle -> IO a) -> f a
nativeProc ((Handle -> Handle -> Handle -> IO ()) -> io ())
-> (Handle -> Handle -> Handle -> IO ()) -> io ()
forall a b. (a -> b) -> a -> b
$ \_ _ e :: Handle
e -> do
   (ByteString -> IO ()) -> [ByteString] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> ByteString -> IO ()
BS.hPutStr Handle
e) (a -> [ByteString]
forall a. ExecArg a => a -> [ByteString]
asArg a
s)

-- | Simple @`Proc`@ that reads its input, and can react to it with an IO
-- action. Does not write anything to its output. See also @`capture`@.
--
-- @`readInput`@ uses lazy IO to read its stdin, and works with infinite
-- inputs.
--
-- >>> yes |> readInput (pure . unlines . take 3 . lines)
-- "y\ny\ny\n"
readInput :: (NFData a, Shell io) => (ByteString -> IO a) -> io a
readInput :: (ByteString -> IO a) -> io a
readInput f :: ByteString -> IO a
f = (Handle -> Handle -> Handle -> IO a) -> io a
forall (f :: * -> *) a.
(Shell f, NFData a) =>
(Handle -> Handle -> Handle -> IO a) -> f a
nativeProc ((Handle -> Handle -> Handle -> IO a) -> io a)
-> (Handle -> Handle -> Handle -> IO a) -> io a
forall a b. (a -> b) -> a -> b
$ \i :: Handle
i _ _ -> do
    Handle -> IO ByteString
hGetContents Handle
i IO ByteString -> (ByteString -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> IO a
f

-- | Join a list of @ByteString@s with newline characters, terminating it
-- with a newline.
unlines :: [ByteString] -> ByteString
unlines :: [ByteString] -> ByteString
unlines = Builder -> ByteString
toLazyByteString (Builder -> ByteString)
-> ([ByteString] -> Builder) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> ([ByteString] -> [Builder]) -> [ByteString] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Builder) -> [ByteString] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (\l :: ByteString
l -> ByteString -> Builder
lazyByteString ByteString
l Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 '\n')

-- | Like @`readInput`@, but @`endBy`@s the string.
--
-- >>> yes |> readInputEndBy "\n" (pure . take 3)
-- ["y","y","y"]
readInputEndBy :: (NFData a, Shell io) => ByteString -> ([ByteString] -> IO a) -> io a
readInputEndBy :: ByteString -> ([ByteString] -> IO a) -> io a
readInputEndBy s :: ByteString
s f :: [ByteString] -> IO a
f = (ByteString -> IO a) -> io a
forall a (io :: * -> *).
(NFData a, Shell io) =>
(ByteString -> IO a) -> io a
readInput ([ByteString] -> IO a
f ([ByteString] -> IO a)
-> (ByteString -> [ByteString]) -> ByteString -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> [ByteString]
endBy ByteString
s)

-- | Like @`readInput`@, but @`endBy`@s the string on the 0 byte.
--
-- >>> writeOutput "1\0\&2\0" |> readInputEndBy0 pure
-- ["1","2"]
readInputEndBy0 :: (NFData a, Shell io) => ([ByteString] -> IO a) -> io a
readInputEndBy0 :: ([ByteString] -> IO a) -> io a
readInputEndBy0 = ByteString -> ([ByteString] -> IO a) -> io a
forall a (io :: * -> *).
(NFData a, Shell io) =>
ByteString -> ([ByteString] -> IO a) -> io a
readInputEndBy "\0"

-- | Like @`readInput`@, but @`endBy`@s the string on new lines.
--
-- >>> writeOutput "a\nb\n" |> readInputLines pure
-- ["a","b"]
readInputLines :: (NFData a, Shell io) => ([ByteString] -> IO a) -> io a
readInputLines :: ([ByteString] -> IO a) -> io a
readInputLines = ByteString -> ([ByteString] -> IO a) -> io a
forall a (io :: * -> *).
(NFData a, Shell io) =>
ByteString -> ([ByteString] -> IO a) -> io a
readInputEndBy "\n"

-- | Creates a pure @`Proc`@ that simple transforms the @stdin@ and writes
-- it to @stdout@. The input can be infinite.
--
-- >>> yes |> pureProc (BS.take 4) |> capture
-- "y\ny\n"
pureProc :: Shell io => (ByteString -> ByteString) -> io ()
pureProc :: (ByteString -> ByteString) -> io ()
pureProc f :: ByteString -> ByteString
f = (Handle -> Handle -> Handle -> IO ()) -> io ()
forall (f :: * -> *) a.
(Shell f, NFData a) =>
(Handle -> Handle -> Handle -> IO a) -> f a
nativeProc ((Handle -> Handle -> Handle -> IO ()) -> io ())
-> (Handle -> Handle -> Handle -> IO ()) -> io ()
forall a b. (a -> b) -> a -> b
$ \i :: Handle
i o :: Handle
o _ -> do
    ByteString
s <- Handle -> IO ByteString
hGetContents Handle
i
    Handle -> ByteString -> IO ()
BS.hPutStr Handle
o (ByteString -> ByteString
f ByteString
s)

-- | Captures the stdout of a process and prefixes all the lines with
-- the given string.
--
-- >>> some_command |> prefixLines "stdout: " |!> prefixLines "stderr: " &> StdErr
-- stdout: this is stdout
-- stderr: this is stderr
prefixLines :: Shell io => ByteString -> io ()
prefixLines :: ByteString -> io ()
prefixLines s :: ByteString
s = (ByteString -> ByteString) -> io ()
forall (io :: * -> *).
Shell io =>
(ByteString -> ByteString) -> io ()
pureProc ((ByteString -> ByteString) -> io ())
-> (ByteString -> ByteString) -> io ()
forall a b. (a -> b) -> a -> b
$ \inp :: ByteString
inp -> Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
    [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ (ByteString -> Builder) -> [ByteString] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (\l :: ByteString
l -> ByteString -> Builder
lazyByteString ByteString
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
lazyByteString ByteString
l Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 '\n') (ByteString -> [ByteString]
BC8.lines ByteString
inp)

-- | Provide the stdin of a `Proc` from a `ByteString`
--
-- Same as @`writeOutput` s |> p@
writeProc :: Shell io => Proc a -> ByteString -> io a
writeProc :: Proc a -> ByteString -> io a
writeProc p :: Proc a
p s :: ByteString
s = ByteString -> Proc ()
forall a (io :: * -> *). (ExecArg a, Shell io) => a -> io ()
writeOutput ByteString
s Proc () -> Proc a -> io a
forall (f :: * -> *) a b. Shell f => Proc a -> Proc b -> f b
|> Proc a
p

-- | Run a process and capture its output lazily. Once the continuation
-- is completed, the handles are closed. However, the process is run
-- until it naturally terminates in order to capture the correct exit
-- code. Most utilities behave correctly with this (e.g. @cat@ will
-- terminate if you close the handle).
--
-- Same as @p |> readInput f@
withRead :: (Shell f, NFData b) => Proc a -> (ByteString -> IO b) -> f b
withRead :: Proc a -> (ByteString -> IO b) -> f b
withRead p :: Proc a
p f :: ByteString -> IO b
f = Proc a
p Proc a -> Proc b -> f b
forall (f :: * -> *) a b. Shell f => Proc a -> Proc b -> f b
|> (ByteString -> IO b) -> Proc b
forall a (io :: * -> *).
(NFData a, Shell io) =>
(ByteString -> IO a) -> io a
readInput ByteString -> IO b
f

-- | Type used to represent destinations for redirects. @`Truncate` file@
-- is like @> file@ in a shell, and @`Append` file@ is like @>> file@.
data Stream = StdOut | StdErr | Truncate ByteString | Append ByteString

-- | Shortcut for @`Truncate` "\/dev\/null"@
-- 
-- >>> echo "Hello" &> devNull
devNull :: Stream
devNull :: Stream
devNull = ByteString -> Stream
Truncate "/dev/null"

-- | Type representing a series or pipeline (or both) of shell commands.
--
-- @Proc@'s can communicate to each other via @stdin@, @stdout@ and @stderr@
-- and can communicate to Haskell via their parameterised return type, or by
-- throwing an exception.
newtype Proc a = Proc (Handle -> Handle -> Handle -> IO a)
    deriving a -> Proc b -> Proc a
(a -> b) -> Proc a -> Proc b
(forall a b. (a -> b) -> Proc a -> Proc b)
-> (forall a b. a -> Proc b -> Proc a) -> Functor Proc
forall a b. a -> Proc b -> Proc a
forall a b. (a -> b) -> Proc a -> Proc b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Proc b -> Proc a
$c<$ :: forall a b. a -> Proc b -> Proc a
fmap :: (a -> b) -> Proc a -> Proc b
$cfmap :: forall a b. (a -> b) -> Proc a -> Proc b
Functor

instance MonadIO Proc where
    liftIO :: IO a -> Proc a
liftIO a :: IO a
a = (Handle -> Handle -> Handle -> IO a) -> Proc a
forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc ((Handle -> Handle -> Handle -> IO a) -> Proc a)
-> (Handle -> Handle -> Handle -> IO a) -> Proc a
forall a b. (a -> b) -> a -> b
$ \_ _ _ -> IO a
a

-- | The `Semigroup` instance for `Proc` pipes the stdout of one process
-- into the stdin of the next. However, consider using `|>` instead which
-- behaves when used in an `IO` context. If you use `<>` in an IO monad
-- you will be using the `IO` instance of semigroup which is a sequential
-- execution. `|>` prevents that error.
instance Semigroup (Proc a) where
    <> :: Proc a -> Proc a -> Proc a
(<>) = Proc a -> Proc a -> Proc a
forall (f :: * -> *) a b. Shell f => Proc a -> Proc b -> f b
(|>)

instance (a ~ ()) => Monoid (Proc a) where
    mempty :: Proc a
mempty = (Handle -> Handle -> Handle -> IO ()) -> Proc a
forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc ((Handle -> Handle -> Handle -> IO ()) -> Proc a)
-> (Handle -> Handle -> Handle -> IO ()) -> Proc a
forall a b. (a -> b) -> a -> b
$ \_ _ _ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance Applicative Proc where
    pure :: a -> Proc a
pure a :: a
a = (Handle -> Handle -> Handle -> IO a) -> Proc a
forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc ((Handle -> Handle -> Handle -> IO a) -> Proc a)
-> (Handle -> Handle -> Handle -> IO a) -> Proc a
forall a b. (a -> b) -> a -> b
$ \_ _ _  -> do
        a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

    f :: Proc (a -> b)
f <*> :: Proc (a -> b) -> Proc a -> Proc b
<*> a :: Proc a
a = do
        a -> b
f' <- Proc (a -> b)
f
        a
a' <- Proc a
a
        b -> Proc b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> b
f' a
a')
        
instance Monad Proc where
    (Proc a :: Handle -> Handle -> Handle -> IO a
a) >>= :: Proc a -> (a -> Proc b) -> Proc b
>>= f :: a -> Proc b
f = (Handle -> Handle -> Handle -> IO b) -> Proc b
forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc ((Handle -> Handle -> Handle -> IO b) -> Proc b)
-> (Handle -> Handle -> Handle -> IO b) -> Proc b
forall a b. (a -> b) -> a -> b
$ \i :: Handle
i o :: Handle
o e :: Handle
e -> do
        a
ar <- Handle -> Handle -> Handle -> IO a
a Handle
i Handle
o Handle
e
        let
            Proc f' :: Handle -> Handle -> Handle -> IO b
f' = a -> Proc b
f a
ar
        Handle -> Handle -> Handle -> IO b
f' Handle
i Handle
o Handle
e

instance Shell IO where
    runProc :: Proc a -> IO a
runProc = Handle -> Handle -> Handle -> Proc a -> IO a
forall a. Handle -> Handle -> Handle -> Proc a -> IO a
runProc' Handle
stdin Handle
stdout Handle
stderr

instance Shell Proc where
    runProc :: Proc a -> Proc a
runProc = Proc a -> Proc a
forall a. a -> a
id

-- | Run's a `Proc` in `IO`. Like `runProc`, but you get to choose the handles.
-- This is UNSAFE to expose externally, because there are restrictions on what
-- the Handle can be. Within shh, we never call `runProc'` with invalid handles,
-- so we ignore that corner case (see `hDup`).
runProc' :: Handle -> Handle -> Handle -> Proc a -> IO a
runProc' :: Handle -> Handle -> Handle -> Proc a -> IO a
runProc' i :: Handle
i o :: Handle
o e :: Handle
e (Proc f :: Handle -> Handle -> Handle -> IO a
f) = do
    -- Flush stdout and stderr so that sequencing commands with
    -- Haskell IO functions looks right.
    Handle -> IO ()
hFlush Handle
stdout
    Handle -> IO ()
hFlush Handle
stderr
    a
r <- Handle -> Handle -> Handle -> IO a
f Handle
i Handle
o Handle
e
    -- Evaluate to WHNF to uncover any ResourceVanished exceptions
    -- that may be hiding in there from `nativeProc`. These should
    -- not happen under normal circumstances, but we would at least
    -- like to have the exception thrown ASAP if, for whatever reason,
    -- it does happen.
    a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$! a
r

-- | Create a `Proc` from a command and a list of arguments.
-- The boolean represents whether we should delegate control-c
-- or not. Most uses of @`mkProc'`@ in Shh do not delegate control-c.
mkProc' :: HasCallStack => Bool -> ByteString -> [ByteString] -> Proc ()
mkProc' :: Bool -> ByteString -> [ByteString] -> Proc ()
mkProc' delegate :: Bool
delegate cmd :: ByteString
cmd args :: [ByteString]
args = (Handle -> Handle -> Handle -> IO ()) -> Proc ()
forall a. (Handle -> Handle -> Handle -> IO a) -> Proc a
Proc ((Handle -> Handle -> Handle -> IO ()) -> Proc ())
-> (Handle -> Handle -> Handle -> IO ()) -> Proc ()
forall a b. (a -> b) -> a -> b
$ \i :: Handle
i o :: Handle
o e :: Handle
e -> do
    String
cmd' <- ByteString -> IO String
forall a. ToFilePath a => a -> IO String
toFilePath ByteString
cmd
    [String]
args' <- (ByteString -> IO String) -> [ByteString] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ByteString -> IO String
forall a. ToFilePath a => a -> IO String
toFilePath [ByteString]
args
    IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    -> IO ExitCode)
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    -> IO ())
-> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
        (String
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess_ String
cmd' (String -> [String] -> CreateProcess
proc String
cmd' [String]
args')
            { std_in :: StdStream
std_in = Handle -> StdStream
UseHandle Handle
i
            , std_out :: StdStream
std_out = Handle -> StdStream
UseHandle Handle
o
            , std_err :: StdStream
std_err = Handle -> StdStream
UseHandle Handle
e
            , close_fds :: Bool
close_fds = Bool
True
            , delegate_ctlc :: Bool
delegate_ctlc = Bool
delegate
            }
        )
        (\(_,_,_,ph :: ProcessHandle
ph) -> ProcessHandle -> IO ()
terminateProcess ProcessHandle
ph IO () -> IO ExitCode -> IO ExitCode
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph)
        (((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
  -> IO ())
 -> IO ())
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(_,_,_,ph :: ProcessHandle
ph) -> HasCallStack =>
ByteString -> [ByteString] -> ProcessHandle -> IO ()
ByteString -> [ByteString] -> ProcessHandle -> IO ()
waitProc ByteString
cmd [ByteString]
args ProcessHandle
ph IO () -> IO ExitCode -> IO ()
forall a b. IO a -> IO b -> IO a
`onException` (ProcessHandle -> IO ()
terminateProcess ProcessHandle
ph IO () -> IO ExitCode -> IO ExitCode
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph)

-- | Create a `Proc` from a command and a list of arguments. Does not delegate
-- control-c handling.
mkProc :: HasCallStack => ByteString -> [ByteString] -> Proc ()
mkProc :: ByteString -> [ByteString] -> Proc ()
mkProc = HasCallStack => Bool -> ByteString -> [ByteString] -> Proc ()
Bool -> ByteString -> [ByteString] -> Proc ()
mkProc' Bool
False

-- | A special `Proc` which captures its stdin and presents it as a `ByteString`
-- to Haskell.
--
-- >>> printf "Hello" |> md5sum |> capture
-- "8b1a9953c4611296a827abf8c47804d7  -\n"
--
-- This is just @`readInput` pure@. Note that it is not lazy, and will read
-- the entire @ByteString@ into memory.
capture :: Shell io => io ByteString
capture :: io ByteString
capture = (ByteString -> IO ByteString) -> io ByteString
forall a (io :: * -> *).
(NFData a, Shell io) =>
(ByteString -> IO a) -> io a
readInput ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Like @'capture'@, except that it @'trim'@s leading and trailing white
-- space.
--
-- >>> printf "Hello" |> md5sum |> captureTrim
-- "8b1a9953c4611296a827abf8c47804d7  -"
captureTrim :: Shell io => io ByteString
captureTrim :: io ByteString
captureTrim = (ByteString -> IO ByteString) -> io ByteString
forall a (io :: * -> *).
(NFData a, Shell io) =>
(ByteString -> IO a) -> io a
readInput (ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString)
-> (ByteString -> ByteString) -> ByteString -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
trim)

-- | Like @'capture'@, but splits the input using the provided separator.
--
-- NB: This is strict. If you want a streaming version, use `readInput`
captureEndBy :: Shell io => ByteString -> io [ByteString]
captureEndBy :: ByteString -> io [ByteString]
captureEndBy s :: ByteString
s = (ByteString -> IO [ByteString]) -> io [ByteString]
forall a (io :: * -> *).
(NFData a, Shell io) =>
(ByteString -> IO a) -> io a
readInput ([ByteString] -> IO [ByteString]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString] -> IO [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> IO [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> [ByteString]
endBy ByteString
s)

-- | Same as @'captureEndBy' "\\0"@.
captureEndBy0 :: Shell io => io [ByteString]
captureEndBy0 :: io [ByteString]
captureEndBy0 = ByteString -> io [ByteString]
forall (io :: * -> *). Shell io => ByteString -> io [ByteString]
captureEndBy "\0"

-- | Same as @'captureSplit' "\\n"@.
captureLines :: Shell io => io [ByteString]
captureLines :: io [ByteString]
captureLines = ByteString -> io [ByteString]
forall (io :: * -> *). Shell io => ByteString -> io [ByteString]
captureEndBy "\n"

-- | Capture stdout, splitting it into words.
captureWords :: Shell io => io [ByteString]
captureWords :: io [ByteString]
captureWords = (ByteString -> IO [ByteString]) -> io [ByteString]
forall a (io :: * -> *).
(NFData a, Shell io) =>
(ByteString -> IO a) -> io a
readInput ([ByteString] -> IO [ByteString]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ByteString] -> IO [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> IO [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BC8.words)

-- | Capture stdout, and attempt to @`read`@ it
captureRead :: (Shell io, Read a, NFData a) => io a
captureRead :: io a
captureRead = (ByteString -> IO a) -> io a
forall a (io :: * -> *).
(NFData a, Shell io) =>
(ByteString -> IO a) -> io a
readInput (a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> IO a) -> (ByteString -> a) -> ByteString -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
forall a. Read a => String -> a
read (String -> a) -> (ByteString -> String) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
toString)

-- | Apply a `Proc` to a `ByteString`. That is, feed the bytestring to
-- the @stdin@ of the process and read the @stdout@.
--
-- >> apply md5sum "Hello"
-- "8b1a9953c4611296a827abf8c47804d7  -\n"
apply :: (ExecArg a, Shell io) => Proc v -> a -> io ByteString
apply :: Proc v -> a -> io ByteString
apply p :: Proc v
p b :: a
b = a -> Proc ()
forall a (io :: * -> *). (ExecArg a, Shell io) => a -> io ()
writeOutput a
b Proc () -> Proc v -> Proc v
forall (f :: * -> *) a b. Shell f => Proc a -> Proc b -> f b
|> Proc v
p Proc v -> Proc ByteString -> io ByteString
forall (f :: * -> *) a b. Shell f => Proc a -> Proc b -> f b
|> Proc ByteString
forall (io :: * -> *). Shell io => io ByteString
capture

-- | Flipped, infix version of `writeProc`
(>>>) :: Shell io => ByteString -> Proc a -> io a
>>> :: ByteString -> Proc a -> io a
(>>>) = (Proc a -> ByteString -> io a) -> ByteString -> Proc a -> io a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Proc a -> ByteString -> io a
forall (io :: * -> *) a. Shell io => Proc a -> ByteString -> io a
writeProc


-- | Infix version of `writeProc`
(<<<) :: Shell io => Proc a -> ByteString -> io a
<<< :: Proc a -> ByteString -> io a
(<<<) = Proc a -> ByteString -> io a
forall (io :: * -> *) a. Shell io => Proc a -> ByteString -> io a
writeProc

-- | Wait on a given `ProcessHandle`, and throw an exception of
-- type `Failure` if its exit code is non-zero (ignoring SIGPIPE)
waitProc :: HasCallStack => ByteString -> [ByteString] -> ProcessHandle -> IO ()
waitProc :: ByteString -> [ByteString] -> ProcessHandle -> IO ()
waitProc cmd :: ByteString
cmd arg :: [ByteString]
arg ph :: ProcessHandle
ph = ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph IO ExitCode -> (ExitCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    ExitFailure c :: Int
c
        | Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt -> CInt
forall a. Num a => a -> a
negate CInt
sigPIPE -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        | Bool
otherwise -> Failure -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Failure -> IO ()) -> Failure -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString
-> [ByteString] -> CallStack -> Int -> Maybe ByteString -> Failure
Failure ByteString
cmd [ByteString]
arg CallStack
HasCallStack => CallStack
callStack Int
c Maybe ByteString
forall a. Maybe a
Nothing
    ExitSuccess -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


-- | Drop trailing characters from a @ByteString@ while the given predicate
-- matches.
--
-- >>> dropWhileEnd isSpace "a line \n"
-- "a line"
dropWhileEnd :: (Char -> Bool) -> ByteString -> ByteString
dropWhileEnd :: (Char -> Bool) -> ByteString -> ByteString
dropWhileEnd p :: Char -> Bool
p b :: ByteString
b = case ByteString -> Maybe (ByteString, Char)
BC8.unsnoc ByteString
b of
    Just (i :: ByteString
i, l :: Char
l) -> if Char -> Bool
p Char
l then (Char -> Bool) -> ByteString -> ByteString
dropWhileEnd Char -> Bool
p ByteString
i else ByteString
b
    Nothing     -> ByteString
b

-- | Trim leading and tailing whitespace.
--
-- >>> trim " a string \n"
-- "a string"
trim :: ByteString -> ByteString
trim :: ByteString -> ByteString
trim = (Char -> Bool) -> ByteString -> ByteString
dropWhileEnd Char -> Bool
isSpace (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
BC8.dropWhile Char -> Bool
isSpace

-- | Run a `Proc` action, catching any `Failure` exceptions
-- and returning them.
tryFailure :: Shell m => Proc a -> m (Either Failure a)
tryFailure :: Proc a -> m (Either Failure a)
tryFailure (Proc f :: Handle -> Handle -> Handle -> IO a
f) = (Handle -> Handle -> Handle -> IO (Either Failure a))
-> m (Either Failure a)
forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc ((Handle -> Handle -> Handle -> IO (Either Failure a))
 -> m (Either Failure a))
-> (Handle -> Handle -> Handle -> IO (Either Failure a))
-> m (Either Failure a)
forall a b. (a -> b) -> a -> b
$ \i :: Handle
i o :: Handle
o e :: Handle
e -> IO a -> IO (Either Failure a)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO a -> IO (Either Failure a)) -> IO a -> IO (Either Failure a)
forall a b. (a -> b) -> a -> b
$ Handle -> Handle -> Handle -> IO a
f Handle
i Handle
o Handle
e

-- | Like @`tryFailure`@ except that it takes an exception predicate which
-- selects which exceptions to catch. Any exception not matching the predicate
-- (returning @Nothing@) is re-thrown.
tryFailureJust :: Shell m => (Failure -> Maybe b) -> Proc a -> m (Either b a)
tryFailureJust :: (Failure -> Maybe b) -> Proc a -> m (Either b a)
tryFailureJust pr :: Failure -> Maybe b
pr (Proc f :: Handle -> Handle -> Handle -> IO a
f) = (Handle -> Handle -> Handle -> IO (Either b a)) -> m (Either b a)
forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc ((Handle -> Handle -> Handle -> IO (Either b a)) -> m (Either b a))
-> (Handle -> Handle -> Handle -> IO (Either b a))
-> m (Either b a)
forall a b. (a -> b) -> a -> b
$ \i :: Handle
i o :: Handle
o e :: Handle
e -> (Failure -> Maybe b) -> IO a -> IO (Either b a)
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust Failure -> Maybe b
pr (Handle -> Handle -> Handle -> IO a
f Handle
i Handle
o Handle
e)

-- | Run a `Proc` with an action to take if an exception is thrown.
catchFailure :: Shell m => Proc a -> (Failure -> Proc a) -> m a
catchFailure :: Proc a -> (Failure -> Proc a) -> m a
catchFailure (Proc f :: Handle -> Handle -> Handle -> IO a
f) pr :: Failure -> Proc a
pr = (Handle -> Handle -> Handle -> IO a) -> m a
forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc ((Handle -> Handle -> Handle -> IO a) -> m a)
-> (Handle -> Handle -> Handle -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \i :: Handle
i o :: Handle
o e :: Handle
e -> IO a -> (Failure -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Handle -> Handle -> Handle -> IO a
f Handle
i Handle
o Handle
e) (Proc a -> IO a
forall (f :: * -> *) a. (Shell f, HasCallStack) => Proc a -> f a
runProc (Proc a -> IO a) -> (Failure -> Proc a) -> Failure -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Failure -> Proc a
pr)

-- | Like @`catchFailureJust`@ except that it takes an exception predicate
-- which selects which exceptions to catch. Any exceptions not matching the
-- predicate (returning @Nothing@) are re-thrown.
catchFailureJust :: Shell m => (Failure -> Maybe b) -> Proc a -> (b -> Proc a) -> m a
catchFailureJust :: (Failure -> Maybe b) -> Proc a -> (b -> Proc a) -> m a
catchFailureJust pr :: Failure -> Maybe b
pr (Proc f :: Handle -> Handle -> Handle -> IO a
f) h :: b -> Proc a
h = (Handle -> Handle -> Handle -> IO a) -> m a
forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc ((Handle -> Handle -> Handle -> IO a) -> m a)
-> (Handle -> Handle -> Handle -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \i :: Handle
i o :: Handle
o e :: Handle
e -> (Failure -> Maybe b) -> IO a -> (b -> IO a) -> IO a
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
catchJust Failure -> Maybe b
pr (Handle -> Handle -> Handle -> IO a
f Handle
i Handle
o Handle
e) (Proc a -> IO a
forall (f :: * -> *) a. (Shell f, HasCallStack) => Proc a -> f a
runProc (Proc a -> IO a) -> (b -> Proc a) -> b -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Proc a
h)

-- | Apply a function that translates non-0 exit codes to results. Any code
-- that returns a @Nothing@ will be thrown as a @`Failure`@.
translateCode' :: Shell m => (Int -> Maybe b) -> Proc a -> m (Either b a)
translateCode' :: (Int -> Maybe b) -> Proc a -> m (Either b a)
translateCode' f :: Int -> Maybe b
f p :: Proc a
p = (Failure -> Maybe b) -> Proc a -> m (Either b a)
forall (m :: * -> *) b a.
Shell m =>
(Failure -> Maybe b) -> Proc a -> m (Either b a)
tryFailureJust (Int -> Maybe b
f (Int -> Maybe b) -> (Failure -> Int) -> Failure -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Failure -> Int
failureCode) Proc a
p

-- | Apply a function to non-0 exit codes to extract a result. If @Nothing@
-- is produced, the @`Failure`@ is thrown.
translateCode :: Shell m => (Int -> Maybe a) -> Proc a -> m a
translateCode :: (Int -> Maybe a) -> Proc a -> m a
translateCode f :: Int -> Maybe a
f p :: Proc a
p = (Failure -> Maybe a) -> Proc a -> (a -> Proc a) -> m a
forall (m :: * -> *) b a.
Shell m =>
(Failure -> Maybe b) -> Proc a -> (b -> Proc a) -> m a
catchFailureJust (Int -> Maybe a
f (Int -> Maybe a) -> (Failure -> Int) -> Failure -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Failure -> Int
failureCode) Proc a
p a -> Proc a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Capture the stderr of the proc, and attach it to any @`Failure`@
-- exceptions that are thrown. The stderr is also forwarded to downstream
-- processes, or the inherited stderr handle. Note that capturing stderr
-- inherently requires that the stderr is accumulated in memory, so be
-- careful about processes that dump a lot of information.
failWithStdErr :: Shell io => Proc a -> io a
failWithStdErr :: Proc a -> io a
failWithStdErr p :: Proc a
p = Proc a -> io a
forall (f :: * -> *) a. (Shell f, HasCallStack) => Proc a -> f a
runProc (Proc a -> io a) -> Proc a -> io a
forall a b. (a -> b) -> a -> b
$ do
    (Either Failure a, ByteString)
r <- Proc a -> Proc (Either Failure a)
forall (m :: * -> *) a. Shell m => Proc a -> m (Either Failure a)
tryFailure Proc a
p Proc (Either Failure a)
-> Proc ByteString -> Proc (Either Failure a, ByteString)
forall (f :: * -> *) a b. Shell f => Proc a -> Proc b -> f (a, b)
`pipeErr` (ByteString -> Proc ByteString) -> Proc ByteString
forall a (io :: * -> *).
(NFData a, Shell io) =>
(ByteString -> Proc a) -> io a
readInputP (\i :: ByteString
i -> do
        ByteString -> Proc ()
forall a (io :: * -> *). (ExecArg a, Shell io) => a -> io ()
writeError ByteString
i
        ByteString -> Proc ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
i
        )
    case (Either Failure a, ByteString)
r of
        (Right a :: a
a, _) -> a -> Proc a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
        (Left f :: Failure
f, err :: ByteString
err) -> IO a -> Proc a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Proc a) -> IO a -> Proc a
forall a b. (a -> b) -> a -> b
$ Failure -> IO a
forall e a. Exception e => e -> IO a
throwIO (Failure -> IO a) -> Failure -> IO a
forall a b. (a -> b) -> a -> b
$ Failure
f {failureStdErr :: Maybe ByteString
failureStdErr = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
err}

-- | Run a `Proc` action, ignoring any `Failure` exceptions.
-- This can be used to prevent a process from interrupting a whole pipeline.
--
-- >>> false |> (sleep "0.1" >> echo 1)
-- *** Exception: Command `false` failed [exit 1] at CallStack (from HasCallStack):
-- ...
--
-- >>> (ignoreFailure false) |> (sleep "0.1" >> echo 1)
-- 1
ignoreFailure :: (Functor m, Shell m) => Proc a -> m ()
ignoreFailure :: Proc a -> m ()
ignoreFailure = m (Either Failure a) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Either Failure a) -> m ())
-> (Proc a -> m (Either Failure a)) -> Proc a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proc a -> m (Either Failure a)
forall (m :: * -> *) a. Shell m => Proc a -> m (Either Failure a)
tryFailure

-- | Run a `Proc` action returning the exit code of the process instead of
-- throwing an exception.
--
-- >>> exitCode false
-- 1
exitCode :: (Functor m, Shell m) => Proc a -> m Int
exitCode :: Proc a -> m Int
exitCode = (Either Failure a -> Int) -> m (Either Failure a) -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either Failure a -> Int
forall b. Either Failure b -> Int
getCode (m (Either Failure a) -> m Int)
-> (Proc a -> m (Either Failure a)) -> Proc a -> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proc a -> m (Either Failure a)
forall (m :: * -> *) a. Shell m => Proc a -> m (Either Failure a)
tryFailure
    where
        getCode :: Either Failure b -> Int
getCode (Right _) = 0
        getCode (Left  f :: Failure
f) = Failure -> Int
failureCode Failure
f

-- | Run the @`Proc`@, but don't throw an exception if it exits with the
-- given code. Note, that from this point on, if the proc did fail with the
-- code, everything else now sees it as having exited with 0. If you need
-- to know the code, you have to use `exitCode`.
ignoreCode :: (Monad m, Shell m) => Int -> Proc a -> m ()
ignoreCode :: Int -> Proc a -> m ()
ignoreCode code :: Int
code p :: Proc a
p = (Failure -> Maybe ()) -> Proc () -> (() -> Proc ()) -> m ()
forall (m :: * -> *) b a.
Shell m =>
(Failure -> Maybe b) -> Proc a -> (b -> Proc a) -> m a
catchFailureJust Failure -> Maybe ()
pr (Proc a -> Proc ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Proc a
p) () -> Proc ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    where
        pr :: Failure -> Maybe ()
pr f :: Failure
f
            | Failure -> Int
failureCode Failure
f Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
code = () -> Maybe ()
forall a. a -> Maybe a
Just ()
            | Bool
otherwise             = Maybe ()
forall a. Maybe a
Nothing

-- | A class for things that can be converted to arguments on the command
-- line. The default implementation is to use `show` and then encode it using
-- the file system encoding.
class ExecArg a where
    asArg :: a -> [ByteString]
    default asArg :: Show a => a -> [ByteString]
    asArg a :: a
a = [IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
forall a. ToFilePath a => String -> IO a
fromFilePath (String -> IO ByteString) -> String -> IO ByteString
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
a]

    -- God, I hate that String is [Char]...
    asArgFromList :: [a] -> [ByteString]
    default asArgFromList :: Show a => [a] -> [ByteString]
    asArgFromList = (a -> [ByteString]) -> [a] -> [ByteString]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap a -> [ByteString]
forall a. ExecArg a => a -> [ByteString]
asArg

-- | The @Char@ and @String@ instances encode using the file system encoding.
instance ExecArg Char where
    asArg :: Char -> [ByteString]
asArg s :: Char
s = [IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
forall a. ToFilePath a => String -> IO a
fromFilePath [Char
s]]
    asArgFromList :: String -> [ByteString]
asArgFromList s :: String
s = [IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
forall a. ToFilePath a => String -> IO a
fromFilePath String
s]

-- | The @[Char]@/@String@ instance encodes using the file system encoding.
instance ExecArg a => ExecArg [a] where
    asArg :: [a] -> [ByteString]
asArg = [a] -> [ByteString]
forall a. ExecArg a => [a] -> [ByteString]
asArgFromList
    asArgFromList :: [[a]] -> [ByteString]
asArgFromList = ([a] -> [ByteString]) -> [[a]] -> [ByteString]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [a] -> [ByteString]
forall a. ExecArg a => a -> [ByteString]
asArg

instance ExecArg ByteString where
    asArg :: ByteString -> [ByteString]
asArg s :: ByteString
s = [ByteString
s]

instance ExecArg ByteString.ByteString where
    asArg :: ByteString -> [ByteString]
asArg s :: ByteString
s = [ByteString -> ByteString
BS.fromStrict ByteString
s]

instance ExecArg Int
instance ExecArg Integer
instance ExecArg Word

-- | A class for building up a command.
class Command a where
    toArgs :: HasCallStack => [ByteString] -> a

instance (a ~ ()) => Command (Proc a) where
    toArgs :: [ByteString] -> Proc a
toArgs (cmd :: ByteString
cmd:args :: [ByteString]
args) = HasCallStack => ByteString -> [ByteString] -> Proc ()
ByteString -> [ByteString] -> Proc ()
mkProc ByteString
cmd [ByteString]
args
    toArgs _ = String -> Proc a
forall a. HasCallStack => String -> a
error "The impossible happened. How did you construct this?"

instance (ExecArg b, Command a) => Command (b -> a) where
    toArgs :: [ByteString] -> b -> a
toArgs f :: [ByteString]
f i :: b
i = [ByteString] -> a
forall a. (Command a, HasCallStack) => [ByteString] -> a
toArgs ([ByteString] -> a) -> [ByteString] -> a
forall a b. (a -> b) -> a -> b
$ [ByteString]
f [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ b -> [ByteString]
forall a. ExecArg a => a -> [ByteString]
asArg b
i

-- | Commands can be executed directly in IO
instance (a ~ ()) => Command (IO a) where
    toArgs :: [ByteString] -> IO a
toArgs = Proc a -> IO a
forall (f :: * -> *) a. (Shell f, HasCallStack) => Proc a -> f a
runProc (Proc a -> IO a)
-> ([ByteString] -> Proc a) -> [ByteString] -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Proc a
forall a. (Command a, HasCallStack) => [ByteString] -> a
toArgs

instance Command [ByteString] where
    toArgs :: [ByteString] -> [ByteString]
toArgs = [ByteString] -> [ByteString]
forall a. a -> a
id

instance Command [ByteString.ByteString] where
    toArgs :: [ByteString] -> [ByteString]
toArgs = (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
toStrict

-- | This type represents a partially built command. Further arguments
-- can be supplied to it, or it can be turned into a `Proc` or directly
-- executed in a context which supports that (such as `IO`).
type Cmd = HasCallStack => forall a. (Command a) => a

-- | This function turns a `Cmd` into a list of @`ByteString`@s.
--
-- >>> displayCommand $ echo "Hello, world!"
-- ["echo","Hello, world!"]
displayCommand :: Cmd -> [ByteString]
displayCommand :: Cmd -> [ByteString]
displayCommand = \c :: Cmd
c -> [ByteString] -> [ByteString]
forall a. (Command a, HasCallStack) => [ByteString] -> a
toArgs [ByteString]
Cmd
c

-- | Get all executables on your `$PATH`.
pathBins :: IO [FilePath]
pathBins :: IO [String]
pathBins = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
takeFileName ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String]
pathBinsAbs

-- | Get all uniquely named executables on your `$PATH` as absolute
-- file names. The uniqueness is determined by the filename, and not
-- the whole path. First one found wins.
pathBinsAbs :: IO [FilePath]
pathBinsAbs :: IO [String]
pathBinsAbs = do
    [String]
pathsVar <- String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
Split.splitOn ":" (String -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
getEnv "PATH"
    [String]
paths <- (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
Dir.doesDirectoryExist [String]
pathsVar
    [String] -> IO [String]
findBinsIn [String]
paths

-- | Get all uniquely named executables from the list of directories. Returns
-- a list of absolute file names.
findBinsIn :: [FilePath] -> IO [FilePath]
findBinsIn :: [String] -> IO [String]
findBinsIn paths :: [String]
paths = do
    [String]
ps <- ShowS -> [String] -> [String]
forall b a. Ord b => (a -> b) -> [a] -> [a]
ordNubOn ShowS
takeFileName ([String] -> [String])
-> ([[String]] -> [String]) -> [[String]] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> IO [[String]] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO [String]) -> [String] -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\d :: String
d -> ShowS -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x :: String
x -> String
dString -> ShowS
forall a. [a] -> [a] -> [a]
++('/'Char -> ShowS
forall a. a -> [a] -> [a]
:String
x)) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
Dir.getDirectoryContents String
d) [String]
paths
    (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (IO Bool -> IO Bool
tryBool (IO Bool -> IO Bool) -> (String -> IO Bool) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Permissions -> Bool) -> IO Permissions -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Permissions -> Bool
Dir.executable (IO Permissions -> IO Bool)
-> (String -> IO Permissions) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Permissions
Dir.getPermissions) [String]
ps

    where
        -- TODO: Eventually replace this with nubOrdOn (containers 0.6.0.1 dep)
        ordNubOn :: Ord b => (a -> b) -> [a] -> [a]
        ordNubOn :: (a -> b) -> [a] -> [a]
ordNubOn f :: a -> b
f as :: [a]
as = ((b, a) -> a) -> [(b, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (b, a) -> a
forall a b. (a, b) -> b
snd ([(b, a)] -> [a]) -> ([(b, a)] -> [(b, a)]) -> [(b, a)] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map b a -> [(b, a)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map b a -> [(b, a)])
-> ([(b, a)] -> Map b a) -> [(b, a)] -> [(b, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a) -> [(b, a)] -> Map b a
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith a -> a -> a
forall a b. a -> b -> a
const ([(b, a)] -> [a]) -> [(b, a)] -> [a]
forall a b. (a -> b) -> a -> b
$ [b] -> [a] -> [(b, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
as) [a]
as

        tryBool :: IO Bool -> IO Bool
        tryBool :: IO Bool -> IO Bool
tryBool a :: IO Bool
a = IO Bool -> IO (Either SomeException Bool)
forall e a. Exception e => IO a -> IO (Either e a)
try IO Bool
a IO (Either SomeException Bool)
-> (Either SomeException Bool -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Left (SomeException _) -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
            Right r :: Bool
r -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
r

-- | Execute the given command. Further arguments can be passed in.
--
-- > exe "ls" "-l"
--
-- See also `loadExe` and `loadEnv`.
--
-- NB: It is recommended that you use the template haskell functions to load
-- executables from your path. If you do it manually, it is recommended to
-- use @withFrozenCallStack@ from @GHC.Stack@
--
-- > echo :: Cmd
-- > echo = withFrozenCallStack (exe "echo")
exe :: (Command a, ExecArg str, HasCallStack) => str -> a
exe :: str -> a
exe s :: str
s = (HasCallStack => a) -> a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => a) -> a) -> (HasCallStack => a) -> a
forall a b. (a -> b) -> a -> b
$ [ByteString] -> a
forall a. (Command a, HasCallStack) => [ByteString] -> a
toArgs (str -> [ByteString]
forall a. ExecArg a => a -> [ByteString]
asArg str
s)

-- | Create a function for the executable named
loadExe :: ExecReference -> String -> Q [Dec]
loadExe :: ExecReference -> String -> Q [Dec]
loadExe ref :: ExecReference
ref s :: String
s = ExecReference -> String -> String -> Q [Dec]
loadExeAs ExecReference
ref String
s String
s

-- | Specify how executables should be referenced.
data ExecReference
    = Absolute -- ^ Find executables on PATH, but store their absolute path
    | SearchPath -- ^ Always search on PATH

-- | Template Haskell function to create a function from a path that will be
-- called. This does not check for executability at compile time.
rawExe :: String -> String -> Q [Dec]
rawExe :: String -> String -> Q [Dec]
rawExe fnName :: String
fnName executable :: String
executable = do
    let
        name :: Name
name = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
fnName
        impl :: DecQ
impl = PatQ -> BodyQ -> [DecQ] -> DecQ
valD (Name -> PatQ
varP Name
name) (ExpQ -> BodyQ
normalB [|
            withFrozenCallStack $ exe executable
            |]) []
        typ :: Dec
typ = Name -> Type -> Dec
SigD Name
name (Name -> Type
ConT ''Cmd)
    Dec
i <- DecQ
impl
    [Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ [Dec
typ,Dec
i]

-- | @$(loadExeAs ref fnName executable)@ defines a function called @fnName@
-- which executes the path in @executable@. If @executable@ is an absolute path
-- it is used directly. If it is just an executable name, then it is searched
-- for in the PATH environment variable. If @ref@ is @SearchPath@, the short
-- name is retained, and your PATH will be searched at runtime. If @ref@
-- is @Absolute@, a executable name will be turned into an absolute path, which
-- will be used at runtime.
loadExeAs :: ExecReference -> String -> String -> Q [Dec]
loadExeAs :: ExecReference -> String -> String -> Q [Dec]
loadExeAs ref :: ExecReference
ref fnName :: String
fnName executable :: String
executable = do
    -- TODO: Can we place haddock markup in TH generated functions.
    -- TODO: Can we place the man page for each function in there xD
    -- https://ghc.haskell.org/trac/ghc/ticket/5467
    IO (Maybe String) -> Q (Maybe String)
forall a. IO a -> Q a
runIO (String -> IO (Maybe String)
Dir.findExecutable String
executable) Q (Maybe String) -> (Maybe String -> Q [Dec]) -> Q [Dec]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Nothing -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error (String -> Q [Dec]) -> String -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ "Attempted to load '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
executable String -> ShowS
forall a. [a] -> [a] -> [a]
++ "', but it is not executable"
        Just absExe :: String
absExe ->
            String -> String -> Q [Dec]
rawExe String
fnName (case ExecReference
ref of { Absolute -> String
absExe; SearchPath -> String
executable })


-- | Takes a string, and makes a Haskell identifier out of it. If the string
-- is a path, the filename portion is used. The exact transformation is that
-- alphanumeric characters are unchanged, @-@ becomes @_@, and @'@ is used to
-- escape all other characters. @_@ becomes @'_@, @.@ becomes @''@ and
-- anthing else is becomes a hex encoded number surrounded by @'@ characters.
--
-- Justification for changing @-@ to @_@ is that @-@ appears far more commonly
-- in executable names than @_@ does, and so we give it the more ergonomic
-- encoding.
--
-- >>> encodeIdentifier "nix-shell"
-- "nix_shell"
--
-- >>> encodeIdentifier "R"
-- "_R"
--
-- >>> encodeIdentifier "x86_64-unknown-linux-gnu-gcc"
-- "x86'_64_unknown_linux_gnu_gcc"
--
-- >>> encodeIdentifier "release.sh"
-- "release''sh"
encodeIdentifier :: String -> String
encodeIdentifier :: ShowS
encodeIdentifier ident :: String
ident =
    let
        fixBody :: String -> String
        fixBody :: ShowS
fixBody (c :: Char
c:cs :: String
cs)
            | Char -> Bool
isAlphaNum Char
c = Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
fixBody String
cs
            | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-'     = '_' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
fixBody String
cs
            | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_'     = '\'' Char -> ShowS
forall a. a -> [a] -> [a]
: '_' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
fixBody String
cs
            | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.'     = '\'' Char -> ShowS
forall a. a -> [a] -> [a]
: '\'' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
fixBody String
cs
            | Bool
otherwise    = String -> Int -> ShowS
forall r. PrintfType r => String -> r
printf "'%x'%s" (Char -> Int
ord Char
c) (ShowS
fixBody String
cs)
        fixBody [] = []

        fixStart :: String -> String
        fixStart :: ShowS
fixStart s :: String
s@(c :: Char
c : _)
            | Char -> Bool
isLower Char
c = String
s
            | Bool
otherwise = '_' Char -> ShowS
forall a. a -> [a] -> [a]
: String
s
        fixStart [] = []

        i :: String
i = ShowS
fixStart ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
fixBody ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
takeFileName String
ident
        -- Includes cd, which has to be a built-in
        reserved :: [String]
reserved = [ "import", "if", "else", "then", "do", "in", "let", "type"
            , "as", "case", "of", "class", "data", "default", "deriving"
            , "instance", "forall", "foreign", "hiding", "infix", "infixl"
            , "infixr", "mdo", "module", "newtype", "proc", "qualified"
            , "rec", "where", "cd"]
    in if String
i String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
reserved then String
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ "_" else String
i


-- | Scans your '$PATH' environment variable and creates a function for each
-- executable found. Binaries that would not create valid Haskell identifiers
-- are encoded using the @'encodeIdentifier'@ function.
loadEnv :: ExecReference -> Q [Dec]
loadEnv :: ExecReference -> Q [Dec]
loadEnv ref :: ExecReference
ref = ExecReference -> ShowS -> Q [Dec]
loadAnnotatedEnv ExecReference
ref ShowS
encodeIdentifier

-- | Test to see if an executable can be found either on the $PATH or absolute.
checkExecutable :: FilePath -> IO Bool
checkExecutable :: String -> IO Bool
checkExecutable = (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (IO (Maybe String) -> IO Bool)
-> (String -> IO (Maybe String)) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Maybe String)
Dir.findExecutable

-- | Load the given executables into the program, checking their executability
-- and creating a function @missingExecutables@ to do a runtime check for their
-- availability. Uses the @'encodeIdentifier'@ function to create function
-- names.
load :: ExecReference -> [FilePath] -> Q [Dec]
load :: ExecReference -> [String] -> Q [Dec]
load ref :: ExecReference
ref = ExecReference -> ShowS -> [String] -> Q [Dec]
loadAnnotated ExecReference
ref ShowS
encodeIdentifier

-- | Same as `load`, but allows you to modify the function names.
loadAnnotated :: ExecReference -> (String -> String) -> [FilePath] -> Q [Dec]
loadAnnotated :: ExecReference -> ShowS -> [String] -> Q [Dec]
loadAnnotated ref :: ExecReference
ref f :: ShowS
f bins :: [String]
bins = do
    let pairs :: [(String, String)]
pairs = [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
f [String]
bins) [String]
bins
    [Dec]
ds <- ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Dec]] -> [Dec]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Q [[Dec]] -> Q [Dec]) -> Q [[Dec]] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ ((String, String) -> Q [Dec]) -> [(String, String)] -> Q [[Dec]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((String -> String -> Q [Dec]) -> (String, String) -> Q [Dec]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (ExecReference -> String -> String -> Q [Dec]
loadExeAs ExecReference
ref)) [(String, String)]
pairs
    Dec
d <- PatQ -> BodyQ -> [DecQ] -> DecQ
valD (Name -> PatQ
varP (String -> Name
mkName "missingExecutables")) (ExpQ -> BodyQ
normalB [|
                filterM (fmap not . checkExecutable) bins
            |]) []

    [Dec] -> Q [Dec]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec
dDec -> [Dec] -> [Dec]
forall a. a -> [a] -> [a]
:[Dec]
ds)

-- | Like `loadEnv`, but allows you to modify the function name that would
-- be generated.
loadAnnotatedEnv :: ExecReference -> (String -> String) -> Q [Dec]
loadAnnotatedEnv :: ExecReference -> ShowS -> Q [Dec]
loadAnnotatedEnv ref :: ExecReference
ref f :: ShowS
f = do
    [String]
bins <- IO [String] -> Q [String]
forall a. IO a -> Q a
runIO (IO [String] -> Q [String]) -> IO [String] -> Q [String]
forall a b. (a -> b) -> a -> b
$ case ExecReference
ref of
        Absolute -> IO [String]
pathBinsAbs
        SearchPath -> IO [String]
pathBins
    [[Dec]]
i <- [String] -> (String -> Q [Dec]) -> Q [[Dec]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
bins ((String -> Q [Dec]) -> Q [[Dec]])
-> (String -> Q [Dec]) -> Q [[Dec]]
forall a b. (a -> b) -> a -> b
$ \bin :: String
bin -> do
        String -> String -> Q [Dec]
rawExe (ShowS
f ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
takeFileName String
bin) String
bin
    [Dec] -> Q [Dec]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[Dec]] -> [Dec]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Dec]]
i)


-- | Split a string separated by the provided separator. A trailing separator
-- is ignored, and does not produce an empty string. Compatible with the
-- output of most CLI programs, such as @find -print0@.
--
-- >>> endBy "\n" "a\nb\n"
-- ["a","b"]
--
-- >>> endBy "\n" "a\nb"
-- ["a","b"]
--
-- >>> endBy "\n" "a\nb\n\n"
-- ["a","b",""]
endBy :: ByteString -> ByteString -> [ByteString]
endBy :: ByteString -> ByteString -> [ByteString]
endBy s :: ByteString
s str :: ByteString
str =
    let splits :: [ByteString]
splits = ByteString -> ByteString -> [ByteString]
Search.split (ByteString -> ByteString
toStrict ByteString
s) ByteString
str
    in [ByteString] -> [ByteString]
dropLastNull [ByteString]
splits

    where
        dropLastNull :: [ByteString] -> [ByteString]
        dropLastNull :: [ByteString] -> [ByteString]
dropLastNull []   = []
        dropLastNull [""] = []
        dropLastNull (a :: ByteString
a : as :: [ByteString]
as) = ByteString
a ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString] -> [ByteString]
dropLastNull [ByteString]
as

-- | Load executables from the given directories
loadFromDirs :: [FilePath] -> Q [Dec]
loadFromDirs :: [String] -> Q [Dec]
loadFromDirs ps :: [String]
ps = [String] -> ShowS -> Q [Dec]
loadAnnotatedFromDirs [String]
ps ShowS
encodeIdentifier

-- | Load executables from the given directories appended with @"/bin"@.
--
-- Useful for use with Nix.
loadFromBins :: [FilePath] -> Q [Dec]
loadFromBins :: [String] -> Q [Dec]
loadFromBins = [String] -> Q [Dec]
loadFromDirs ([String] -> Q [Dec])
-> ([String] -> [String]) -> [String] -> Q [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> ShowS
</> "bin")

-- | Load executables from the given dirs, applying the given transformation
-- to the filenames.
loadAnnotatedFromDirs :: [FilePath] -> (String -> String) -> Q [Dec]
loadAnnotatedFromDirs :: [String] -> ShowS -> Q [Dec]
loadAnnotatedFromDirs ps :: [String]
ps f :: ShowS
f = do
    [String]
bins <- IO [String] -> Q [String]
forall a. IO a -> Q a
runIO (IO [String] -> Q [String]) -> IO [String] -> Q [String]
forall a b. (a -> b) -> a -> b
$ [String] -> IO [String]
findBinsIn [String]
ps
    [[Dec]]
i <- [String] -> (String -> Q [Dec]) -> Q [[Dec]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
bins ((String -> Q [Dec]) -> Q [[Dec]])
-> (String -> Q [Dec]) -> Q [[Dec]]
forall a b. (a -> b) -> a -> b
$ \bin :: String
bin -> do
        String -> String -> Q [Dec]
rawExe (ShowS
f ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
takeFileName String
bin) String
bin
    [Dec] -> Q [Dec]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[Dec]] -> [Dec]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Dec]]
i)

-- | Function that splits '\0' separated list of strings. Useful in conjunction
-- with @find . "-print0"@.
endBy0 :: ByteString -> [ByteString]
endBy0 :: ByteString -> [ByteString]
endBy0 = ByteString -> ByteString -> [ByteString]
endBy "\0"

-- | Mimics the shell builtin "cd".
cd' :: FilePath -> IO ()
cd' :: String -> IO ()
cd' p :: String
p = do
    String -> IO ()
Dir.setCurrentDirectory String
p
    String
a <- IO String
Dir.getCurrentDirectory
    String -> String -> IO ()
setEnv "PWD" String
a

-- | Helper class for variable number of arguments to @cd@ builtin.
class Cd a where
    -- | Mimics the shell builtin "cd". Be careful using this function
    -- in a program, as it doesn't play well with multiple threads. Best
    -- to just use it in an interactive shell or for very simple
    -- transliterations of shell scripts.
    cd :: a

instance (io ~ IO ()) => Cd io where
    cd :: io
cd = String -> IO String
getEnv "HOME" IO String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ()
cd'

instance {-# OVERLAPS #-} (io ~ IO (), path ~ FilePath) => Cd (path -> io) where
    cd :: path -> io
cd = path -> io
String -> IO ()
cd'

-- | @xargs1 n f@ runs @f@ for each item in the input separated by @n@. Similar
-- to the standard @xargs@ utility, but you get to choose the separator, and it
-- only does one argument per command. Compare the following two lines, which
-- do the same thing.
--
-- >>> printf "a\\0b" |> xargs "--null" "-L1" "echo" |> cat
-- a
-- b
-- >>> printf "a\\0b" |> xargs1 "\0" echo |> cat
-- a
-- b
--
-- One benefit of this method over the standard @xargs@ is that we can run
-- Haskell functions as well.
--
-- >>> yes |> head "-n" 5 |> xargs1 "\n" (const $ pure $ Sum 1)
-- Sum {getSum = 5}
xargs1 :: (NFData a, Monoid a) => ByteString -> (ByteString -> Proc a) -> Proc a
xargs1 :: ByteString -> (ByteString -> Proc a) -> Proc a
xargs1 n :: ByteString
n f :: ByteString -> Proc a
f = ByteString -> ([ByteString] -> Proc a) -> Proc a
forall a (io :: * -> *).
(NFData a, Shell io) =>
ByteString -> ([ByteString] -> Proc a) -> io a
readInputEndByP ByteString
n (([a] -> a) -> Proc [a] -> Proc a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> a
forall a. Monoid a => [a] -> a
mconcat (Proc [a] -> Proc a)
-> ([ByteString] -> Proc [a]) -> [ByteString] -> Proc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Proc a) -> [ByteString] -> Proc [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ByteString -> Proc a
f)

-- | Simple @`Proc`@ that reads its input and can react to the output by
-- calling other @`Proc`@'s which can write something to its stdout.
-- The internal @`Proc`@ is given @/dev/null@ as its input.
readInputP :: (NFData a, Shell io) => (ByteString -> Proc a) -> io a
readInputP :: (ByteString -> Proc a) -> io a
readInputP f :: ByteString -> Proc a
f = (Handle -> Handle -> Handle -> IO a) -> io a
forall (f :: * -> *) a.
(Shell f, NFData a) =>
(Handle -> Handle -> Handle -> IO a) -> f a
nativeProc ((Handle -> Handle -> Handle -> IO a) -> io a)
-> (Handle -> Handle -> Handle -> IO a) -> io a
forall a b. (a -> b) -> a -> b
$ \i :: Handle
i o :: Handle
o e :: Handle
e -> do
    ByteString
s <- Handle -> IO ByteString
hGetContents Handle
i
    (Handle -> IO a) -> IO a
forall a. (Handle -> IO a) -> IO a
withNullInput ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \i' :: Handle
i' ->
        IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ Handle -> Handle -> Handle -> Proc a -> IO a
forall a. Handle -> Handle -> Handle -> Proc a -> IO a
runProc' Handle
i' Handle
o Handle
e (ByteString -> Proc a
f ByteString
s)

-- | Like @`readInputP`@, but splits the input.
readInputEndByP :: (NFData a, Shell io) => ByteString -> ([ByteString] -> Proc a) -> io a
readInputEndByP :: ByteString -> ([ByteString] -> Proc a) -> io a
readInputEndByP s :: ByteString
s f :: [ByteString] -> Proc a
f = (ByteString -> Proc a) -> io a
forall a (io :: * -> *).
(NFData a, Shell io) =>
(ByteString -> Proc a) -> io a
readInputP ([ByteString] -> Proc a
f ([ByteString] -> Proc a)
-> (ByteString -> [ByteString]) -> ByteString -> Proc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> [ByteString]
endBy ByteString
s)

-- | Like @`readInputP`@, but splits the input on 0 bytes.
readInputEndBy0P :: (NFData a, Shell io) => ([ByteString] -> Proc a) -> io a
readInputEndBy0P :: ([ByteString] -> Proc a) -> io a
readInputEndBy0P = ByteString -> ([ByteString] -> Proc a) -> io a
forall a (io :: * -> *).
(NFData a, Shell io) =>
ByteString -> ([ByteString] -> Proc a) -> io a
readInputEndByP "\0"

-- | Like @`readInputP`@, but splits the input on new lines.
readInputLinesP :: (NFData a, Shell io) => ([ByteString] -> Proc a) -> io a
readInputLinesP :: ([ByteString] -> Proc a) -> io a
readInputLinesP = ByteString -> ([ByteString] -> Proc a) -> io a
forall a (io :: * -> *).
(NFData a, Shell io) =>
ByteString -> ([ByteString] -> Proc a) -> io a
readInputEndByP "\n"

-- | Create a null file handle.
withNullInput :: (Handle -> IO a) -> IO a
withNullInput :: (Handle -> IO a) -> IO a
withNullInput = String -> IOMode -> (Handle -> IO a) -> IO a
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile "/dev/null" IOMode
ReadMode

-- | Bracket a @`hDup`@
withDuplicate :: Handle -> (Handle -> IO a) -> IO a
withDuplicate :: Handle -> (Handle -> IO a) -> IO a
withDuplicate h :: Handle
h f :: Handle -> IO a
f = IO Handle -> (Handle -> IO ()) -> (Handle -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Handle -> IO Handle
hDup Handle
h) Handle -> IO ()
hClose Handle -> IO a
f

-- | Bracket three @`hDup`@s
withDuplicates :: Handle -> Handle -> Handle -> (Handle -> Handle -> Handle -> IO a) -> IO a
withDuplicates :: Handle
-> Handle -> Handle -> (Handle -> Handle -> Handle -> IO a) -> IO a
withDuplicates a :: Handle
a b :: Handle
b c :: Handle
c f :: Handle -> Handle -> Handle -> IO a
f =
    Handle -> (Handle -> IO a) -> IO a
forall a. Handle -> (Handle -> IO a) -> IO a
withDuplicate Handle
a ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \a' :: Handle
a' -> Handle -> (Handle -> IO a) -> IO a
forall a. Handle -> (Handle -> IO a) -> IO a
withDuplicate Handle
b ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \b' :: Handle
b' -> Handle -> (Handle -> IO a) -> IO a
forall a. Handle -> (Handle -> IO a) -> IO a
withDuplicate Handle
c ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \c' :: Handle
c' -> Handle -> Handle -> Handle -> IO a
f Handle
a' Handle
b' Handle
c'

-- | Bracket two @`hDup`@s and provide a null input handle.
withDuplicateNullInput :: Handle -> Handle -> (Handle -> Handle -> Handle -> IO a) -> IO a
withDuplicateNullInput :: Handle -> Handle -> (Handle -> Handle -> Handle -> IO a) -> IO a
withDuplicateNullInput a :: Handle
a b :: Handle
b f :: Handle -> Handle -> Handle -> IO a
f = do
    (Handle -> IO a) -> IO a
forall a. (Handle -> IO a) -> IO a
withNullInput ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \i :: Handle
i -> do
        Handle -> (Handle -> IO a) -> IO a
forall a. Handle -> (Handle -> IO a) -> IO a
withDuplicate Handle
a ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \a' :: Handle
a' -> Handle -> (Handle -> IO a) -> IO a
forall a. Handle -> (Handle -> IO a) -> IO a
withDuplicate Handle
b ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \b' :: Handle
b' -> Handle -> Handle -> Handle -> IO a
f Handle
i Handle
a' Handle
b'

-- | Duplicate a @`Handle`@ without trying to flush buffers. Only works on @`FileHandle`@s.
--
-- hDuplicate tries to "flush" read buffers by seeking backwards, which doesn't
-- work for streams/pipes. Since we are simulating a @fork + exec@ in @`nativeProc`@,
-- losing the buffers is actually the expected behaviour. (System.Process doesn't
-- attempt to flush the buffers).
--
-- NB: An alternate solution that we could implement (even for System.Process forks)
-- is to create a fresh pipe and spawn an async task to forward buffered content
-- from the original handle if there is something in the buffer. My concern would
-- be that it might be a performance hit that people aren't expecting.
--
-- Code basically copied from
-- http://hackage.haskell.org/package/base-4.12.0.0/docs/src/GHC.IO.Handle.html#hDuplicate
-- with minor modifications.
hDup :: Handle -> IO Handle
hDup :: Handle -> IO Handle
hDup h :: Handle
h@(FileHandle path :: String
path m :: MVar Handle__
m) = do
    String
-> Handle -> MVar Handle__ -> (Handle__ -> IO Handle) -> IO Handle
forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' "hDup" Handle
h MVar Handle__
m ((Handle__ -> IO Handle) -> IO Handle)
-> (Handle__ -> IO Handle) -> IO Handle
forall a b. (a -> b) -> a -> b
$ \h_ :: Handle__
h_ ->
        String
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandleShh String
path Handle
h Maybe (MVar Handle__)
forall a. Maybe a
Nothing Handle__
h_ (HandleFinalizer -> Maybe HandleFinalizer
forall a. a -> Maybe a
Just HandleFinalizer
handleFinalizer)
hDup h :: Handle
h@(DuplexHandle path :: String
path r :: MVar Handle__
r w :: MVar Handle__
w) = do
    (FileHandle _ write_m :: MVar Handle__
write_m) <-
        String
-> Handle -> MVar Handle__ -> (Handle__ -> IO Handle) -> IO Handle
forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' "hDup" Handle
h MVar Handle__
w ((Handle__ -> IO Handle) -> IO Handle)
-> (Handle__ -> IO Handle) -> IO Handle
forall a b. (a -> b) -> a -> b
$ \h_ :: Handle__
h_ ->
            String
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandleShh String
path Handle
h Maybe (MVar Handle__)
forall a. Maybe a
Nothing Handle__
h_ (HandleFinalizer -> Maybe HandleFinalizer
forall a. a -> Maybe a
Just HandleFinalizer
handleFinalizer)
    (FileHandle _ read_m :: MVar Handle__
read_m) <-
        String
-> Handle -> MVar Handle__ -> (Handle__ -> IO Handle) -> IO Handle
forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' "hDup" Handle
h MVar Handle__
r ((Handle__ -> IO Handle) -> IO Handle)
-> (Handle__ -> IO Handle) -> IO Handle
forall a b. (a -> b) -> a -> b
$ \h_ :: Handle__
h_ ->
            String
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandleShh String
path Handle
h (MVar Handle__ -> Maybe (MVar Handle__)
forall a. a -> Maybe a
Just MVar Handle__
write_m) Handle__
h_  Maybe HandleFinalizer
forall a. Maybe a
Nothing
    Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> MVar Handle__ -> MVar Handle__ -> Handle
DuplexHandle String
path MVar Handle__
read_m MVar Handle__
write_m)

-- | Helper function for duplicating a Handle
dupHandleShh
    :: FilePath
    -> Handle
    -> Maybe (MVar Handle__)
    -> Handle__
    -> Maybe HandleFinalizer
    -> IO Handle
dupHandleShh :: String
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandleShh filepath :: String
filepath h :: Handle
h other_side :: Maybe (MVar Handle__)
other_side h_ :: Handle__
h_@Handle__{..} mb_finalizer :: Maybe HandleFinalizer
mb_finalizer = do
    case Maybe (MVar Handle__)
other_side of
        Nothing -> do
            dev
new_dev <- dev -> IO dev
forall a. IODevice a => a -> IO a
IODevice.dup dev
haDevice
            dev
-> String
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
forall dev.
(IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> String
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandleShh_ dev
new_dev String
filepath Maybe (MVar Handle__)
other_side Handle__
h_ Maybe HandleFinalizer
mb_finalizer
        Just r :: MVar Handle__
r  ->
            String
-> Handle -> MVar Handle__ -> (Handle__ -> IO Handle) -> IO Handle
forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' "dupHandleShh" Handle
h MVar Handle__
r ((Handle__ -> IO Handle) -> IO Handle)
-> (Handle__ -> IO Handle) -> IO Handle
forall a b. (a -> b) -> a -> b
$ \Handle__{haDevice :: ()
haDevice=dev
dev} -> do
                dev
-> String
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
forall dev.
(IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> String
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandleShh_ dev
dev String
filepath Maybe (MVar Handle__)
other_side Handle__
h_ Maybe HandleFinalizer
mb_finalizer

-- | Helper function for duplicating a Handle
dupHandleShh_
#if __GLASGOW_HASKELL__ < 900
    :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
#else
    :: (RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) => dev
#endif
    -> FilePath
    -> Maybe (MVar Handle__)
    -> Handle__
    -> Maybe HandleFinalizer
    -> IO Handle
dupHandleShh_ :: dev
-> String
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandleShh_ new_dev :: dev
new_dev filepath :: String
filepath other_side :: Maybe (MVar Handle__)
other_side Handle__{..} mb_finalizer :: Maybe HandleFinalizer
mb_finalizer = do
    -- XXX wrong!
    Maybe TextEncoding
mb_codec <- if Maybe (TextEncoder enc_state) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (TextEncoder enc_state)
haEncoder then (TextEncoding -> Maybe TextEncoding)
-> IO TextEncoding -> IO (Maybe TextEncoding)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextEncoding -> Maybe TextEncoding
forall a. a -> Maybe a
Just IO TextEncoding
getLocaleEncoding else Maybe TextEncoding -> IO (Maybe TextEncoding)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TextEncoding
forall a. Maybe a
Nothing
    dev
-> String
-> HandleType
-> Bool
-> Maybe TextEncoding
-> NewlineMode
-> Maybe HandleFinalizer
-> Maybe (MVar Handle__)
-> IO Handle
forall dev.
(IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> String
-> HandleType
-> Bool
-> Maybe TextEncoding
-> NewlineMode
-> Maybe HandleFinalizer
-> Maybe (MVar Handle__)
-> IO Handle
mkHandle dev
new_dev String
filepath HandleType
haType Bool
True{-buffered-} Maybe TextEncoding
mb_codec
        NewlineMode :: Newline -> Newline -> NewlineMode
NewlineMode { inputNL :: Newline
inputNL = Newline
haInputNL, outputNL :: Newline
outputNL = Newline
haOutputNL }
        Maybe HandleFinalizer
mb_finalizer Maybe (MVar Handle__)
other_side