{-# 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 #-}
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
initInteractive :: IO ()
initInteractive :: IO ()
initInteractive = do
Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin BufferMode
LineBuffering
data Failure = Failure
{ Failure -> ByteString
failureProg :: ByteString
, Failure -> [ByteString]
failureArgs :: [ByteString]
, Failure -> CallStack
failureStack :: CallStack
, Failure -> Int
failureCode :: Int
, 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
class Shell f where
runProc :: HasCallStack => Proc a -> f a
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
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'
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'
(|>) :: 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 |>
(|!>) :: 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 |!>
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
(&>) :: 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 &>
(&!>) :: 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 &!>
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
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
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
(<|) :: 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 <|
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)
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)
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)
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
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')
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)
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"
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"
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)
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)
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
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
data Stream = StdOut | StdErr | Truncate ByteString | Append ByteString
devNull :: Stream
devNull :: Stream
devNull = ByteString -> Stream
Truncate "/dev/null"
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
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
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
Handle -> IO ()
hFlush Handle
stdout
Handle -> IO ()
hFlush Handle
stderr
a
r <- Handle -> Handle -> Handle -> IO a
f Handle
i Handle
o Handle
e
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
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)
mkProc :: HasCallStack => ByteString -> [ByteString] -> Proc ()
mkProc :: ByteString -> [ByteString] -> Proc ()
mkProc = HasCallStack => Bool -> ByteString -> [ByteString] -> Proc ()
Bool -> ByteString -> [ByteString] -> Proc ()
mkProc' Bool
False
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
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)
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)
captureEndBy0 :: Shell io => io [ByteString]
captureEndBy0 :: io [ByteString]
captureEndBy0 = ByteString -> io [ByteString]
forall (io :: * -> *). Shell io => ByteString -> io [ByteString]
captureEndBy "\0"
captureLines :: Shell io => io [ByteString]
captureLines :: io [ByteString]
captureLines = ByteString -> io [ByteString]
forall (io :: * -> *). Shell io => ByteString -> io [ByteString]
captureEndBy "\n"
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)
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 :: (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
(>>>) :: 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
(<<<) :: 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
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 ()
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 :: 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
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
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)
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)
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)
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
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
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}
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
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
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
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]
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
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]
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
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
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
type Cmd = HasCallStack => forall a. (Command a) => a
displayCommand :: Cmd -> [ByteString]
displayCommand :: Cmd -> [ByteString]
displayCommand = \c :: Cmd
c -> [ByteString] -> [ByteString]
forall a. (Command a, HasCallStack) => [ByteString] -> a
toArgs [ByteString]
Cmd
c
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
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
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
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
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)
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
data ExecReference
= Absolute
| SearchPath
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 :: ExecReference -> String -> String -> Q [Dec]
loadExeAs :: ExecReference -> String -> String -> Q [Dec]
loadExeAs ref :: ExecReference
ref fnName :: String
fnName executable :: String
executable = do
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 })
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
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
loadEnv :: ExecReference -> Q [Dec]
loadEnv :: ExecReference -> Q [Dec]
loadEnv ref :: ExecReference
ref = ExecReference -> ShowS -> Q [Dec]
loadAnnotatedEnv ExecReference
ref ShowS
encodeIdentifier
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 :: ExecReference -> [FilePath] -> Q [Dec]
load :: ExecReference -> [String] -> Q [Dec]
load ref :: ExecReference
ref = ExecReference -> ShowS -> [String] -> Q [Dec]
loadAnnotated ExecReference
ref ShowS
encodeIdentifier
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)
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)
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
loadFromDirs :: [FilePath] -> Q [Dec]
loadFromDirs :: [String] -> Q [Dec]
loadFromDirs ps :: [String]
ps = [String] -> ShowS -> Q [Dec]
loadAnnotatedFromDirs [String]
ps ShowS
encodeIdentifier
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")
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)
endBy0 :: ByteString -> [ByteString]
endBy0 :: ByteString -> [ByteString]
endBy0 = ByteString -> ByteString -> [ByteString]
endBy "\0"
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
class Cd a where
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 :: (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)
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)
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)
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"
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"
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
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
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'
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'
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)
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
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
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 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