{-# 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.Builder
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 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.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 Failure
f = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
[ String
"Command `"
]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [[String] -> String
unwords (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]
++
[ String
"` failed [exit "
, Int -> String
forall a. Show a => a -> String
show (Failure -> Int
failureCode Failure
f)
, String
"] 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) (\ByteString
s ->
[String
"\n-- stderr --\n" String -> String -> String
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 :: forall (f :: * -> *) a.
Shell f =>
(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 :: forall (f :: * -> *) a b. Shell f => Proc a -> Proc b -> f (a, b)
pipe (Proc Handle -> Handle -> Handle -> IO a
a) (Proc 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
$ \Handle
i Handle
o 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
$ \Handle
r 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 :: forall (f :: * -> *) a b. Shell f => Proc a -> Proc b -> f (a, b)
pipeErr (Proc Handle -> Handle -> Handle -> IO a
a) (Proc 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
$ \Handle
i Handle
o 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
$ \Handle
r 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
Proc a
a |> :: forall (f :: * -> *) a b. Shell f => Proc a -> Proc b -> f 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
$ ((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)
infixl 1 |>
(|!>) :: Shell f => Proc a -> Proc b -> f b
Proc a
a |!> :: forall (f :: * -> *) a b. Shell f => Proc a -> Proc b -> f 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
$ ((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)
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 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 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
Proc a
p &> :: forall (f :: * -> *) a. Shell f => Proc a -> Stream -> f a
&> Stream
StdOut = Proc a -> f a
forall (f :: * -> *) a. (Shell f, HasCallStack) => Proc a -> f a
runProc Proc a
p
(Proc Handle -> Handle -> Handle -> IO a
f) &> Stream
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
$ \Handle
i Handle
_ Handle
e -> Handle -> Handle -> Handle -> IO a
f Handle
i Handle
e Handle
e
(Proc Handle -> Handle -> Handle -> IO a
f) &> (Truncate 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
$ \Handle
i Handle
_ 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
$ \Handle
h -> Handle -> Handle -> Handle -> IO a
f Handle
i Handle
h Handle
e
(Proc Handle -> Handle -> Handle -> IO a
f) &> (Append 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
$ \Handle
i Handle
_ 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
$ \Handle
h -> Handle -> Handle -> Handle -> IO a
f Handle
i Handle
h Handle
e
infixl 9 &>
(&!>) :: Shell f => Proc a -> Stream -> f a
Proc a
p &!> :: forall (f :: * -> *) a. Shell f => Proc a -> Stream -> f a
&!> Stream
StdErr = Proc a -> f a
forall (f :: * -> *) a. (Shell f, HasCallStack) => Proc a -> f a
runProc Proc a
p
(Proc Handle -> Handle -> Handle -> IO a
f) &!> Stream
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
$ \Handle
i Handle
o Handle
_ -> Handle -> Handle -> Handle -> IO a
f Handle
i Handle
o Handle
o
(Proc Handle -> Handle -> Handle -> IO a
f) &!> (Truncate 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
$ \Handle
i Handle
o Handle
_ -> 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
$ \Handle
h -> Handle -> Handle -> Handle -> IO a
f Handle
i Handle
o Handle
h
(Proc Handle -> Handle -> Handle -> IO a
f) &!> (Append 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
$ \Handle
i Handle
o Handle
_ -> 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
$ \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 :: forall (f :: * -> *) a.
(Shell f, NFData a) =>
(Handle -> Handle -> Handle -> IO a) -> f a
nativeProc 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
$ \Handle
i Handle
o 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
$ \Handle
i' Handle
o' 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 :: forall a. IOError -> IO a
handler 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
<| :: forall (f :: * -> *) a b. Shell f => 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 :: forall a. (Handle -> Handle -> IO a) -> IO a
withPipe 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
(\(Handle
r,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)
(\(Handle
r,Handle
w) -> Handle -> Handle -> IO a
k Handle
r Handle
w)
writeOutput :: (ExecArg a, Shell io) => a -> io ()
writeOutput :: forall a (io :: * -> *). (ExecArg a, Shell io) => a -> io ()
writeOutput 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
$ \Handle
_ Handle
o Handle
_ -> 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 :: forall a (io :: * -> *). (ExecArg a, Shell io) => a -> io ()
writeError 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
$ \Handle
_ Handle
_ 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 :: forall a (io :: * -> *).
(NFData a, Shell io) =>
(ByteString -> IO a) -> io a
readInput 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
$ \Handle
i Handle
_ Handle
_ -> 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 (\ByteString
l -> ByteString -> Builder
lazyByteString ByteString
l Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'\n')
readInputEndBy :: (NFData a, Shell io) => ByteString -> ([ByteString] -> IO a) -> io a
readInputEndBy :: forall a (io :: * -> *).
(NFData a, Shell io) =>
ByteString -> ([ByteString] -> IO a) -> io a
readInputEndBy ByteString
s [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 :: forall a (io :: * -> *).
(NFData a, Shell io) =>
([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 ByteString
"\0"
readInputLines :: (NFData a, Shell io) => ([ByteString] -> IO a) -> io a
readInputLines :: forall a (io :: * -> *).
(NFData a, Shell io) =>
([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 ByteString
"\n"
pureProc :: Shell io => (ByteString -> ByteString) -> io ()
pureProc :: forall (io :: * -> *).
Shell io =>
(ByteString -> ByteString) -> io ()
pureProc 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
$ \Handle
i Handle
o Handle
_ -> 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 :: forall (io :: * -> *). Shell io => ByteString -> io ()
prefixLines 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
$ \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 (\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 Char
'\n') (ByteString -> [ByteString]
BC8.lines ByteString
inp)
writeProc :: Shell io => Proc a -> ByteString -> io a
writeProc :: forall (io :: * -> *) a. Shell io => Proc a -> ByteString -> io a
writeProc Proc a
p 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 :: forall (f :: * -> *) b a.
(Shell f, NFData b) =>
Proc a -> (ByteString -> IO b) -> f b
withRead Proc a
p 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 ByteString
"/dev/null"
newtype Proc a = Proc (Handle -> Handle -> Handle -> IO a)
deriving (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
<$ :: forall a b. a -> Proc b -> Proc a
$c<$ :: forall a b. a -> Proc b -> Proc a
fmap :: forall a b. (a -> b) -> Proc a -> Proc b
$cfmap :: forall a b. (a -> b) -> Proc a -> Proc b
Functor
instance MonadIO Proc where
liftIO :: forall a. IO a -> Proc a
liftIO 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
$ \Handle
_ Handle
_ Handle
_ -> 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 ()
forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc ((Handle -> Handle -> Handle -> IO ()) -> Proc ())
-> (Handle -> Handle -> Handle -> IO ()) -> Proc ()
forall a b. (a -> b) -> a -> b
$ \Handle
_ Handle
_ Handle
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
instance Applicative Proc where
pure :: forall a. a -> Proc a
pure 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
$ \Handle
_ Handle
_ Handle
_ -> do
a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
Proc (a -> b)
f <*> :: forall a b. Proc (a -> b) -> Proc a -> Proc b
<*> Proc a
a = do
a -> b
f' <- Proc (a -> b)
f
a -> b
f' (a -> b) -> Proc a -> Proc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proc a
a
instance Monad Proc where
(Proc Handle -> Handle -> Handle -> IO a
a) >>= :: forall a b. Proc a -> (a -> Proc b) -> Proc b
>>= 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
$ \Handle
i Handle
o Handle
e -> do
a
ar <- Handle -> Handle -> Handle -> IO a
a Handle
i Handle
o Handle
e
let
Proc 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 :: forall a. HasCallStack => 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 :: forall a. HasCallStack => Proc a -> Proc a
runProc = Proc a -> Proc a
forall a. a -> a
id
runProc' :: Handle -> Handle -> Handle -> Proc a -> IO a
runProc' :: forall a. Handle -> Handle -> Handle -> Proc a -> IO a
runProc' Handle
i Handle
o Handle
e (Proc 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
{-# DEPRECATED mkProc' "Use mkProcWith instead" #-}
mkProc' :: HasCallStack => Bool -> ByteString -> [ByteString] -> Proc ()
mkProc' :: HasCallStack => Bool -> ByteString -> [ByteString] -> Proc ()
mkProc' Bool
delegate = HasCallStack =>
ProcOptions -> ByteString -> [ByteString] -> Proc ()
ProcOptions -> ByteString -> [ByteString] -> Proc ()
mkProcWith ProcOptions
defaultProcOptions { delegateCtlc :: Bool
delegateCtlc = Bool
delegate }
data ProcOptions = ProcOptions
{ ProcOptions -> Bool
delegateCtlc :: Bool
, ProcOptions -> Bool
closeFds :: Bool
}
defaultProcOptions :: ProcOptions
defaultProcOptions :: ProcOptions
defaultProcOptions = ProcOptions :: Bool -> Bool -> ProcOptions
ProcOptions
{ delegateCtlc :: Bool
delegateCtlc = Bool
True
, closeFds :: Bool
closeFds = Bool
True
}
mkProcWith :: HasCallStack => ProcOptions -> ByteString -> [ByteString] -> Proc ()
mkProcWith :: HasCallStack =>
ProcOptions -> ByteString -> [ByteString] -> Proc ()
mkProcWith ProcOptions
options ByteString
cmd [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
$ \Handle
i Handle
o 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 = ProcOptions -> Bool
closeFds ProcOptions
options
, delegate_ctlc :: Bool
delegate_ctlc = ProcOptions -> Bool
delegateCtlc ProcOptions
options
}
)
(\(Maybe Handle
_,Maybe Handle
_,Maybe Handle
_,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
$ \(Maybe Handle
_,Maybe Handle
_,Maybe Handle
_,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 :: HasCallStack => ByteString -> [ByteString] -> Proc ()
mkProc = HasCallStack =>
ProcOptions -> ByteString -> [ByteString] -> Proc ()
ProcOptions -> ByteString -> [ByteString] -> Proc ()
mkProcWith ProcOptions
defaultProcOptions
capture :: Shell io => io ByteString
capture :: forall (io :: * -> *). Shell io => 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 :: forall (io :: * -> *). Shell io => 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 :: forall (io :: * -> *). Shell io => ByteString -> io [ByteString]
captureEndBy 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 :: forall (io :: * -> *). Shell io => io [ByteString]
captureEndBy0 = ByteString -> io [ByteString]
forall (io :: * -> *). Shell io => ByteString -> io [ByteString]
captureEndBy ByteString
"\0"
captureLines :: Shell io => io [ByteString]
captureLines :: forall (io :: * -> *). Shell io => io [ByteString]
captureLines = ByteString -> io [ByteString]
forall (io :: * -> *). Shell io => ByteString -> io [ByteString]
captureEndBy ByteString
"\n"
captureWords :: Shell io => io [ByteString]
captureWords :: forall (io :: * -> *). Shell io => 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 :: forall (io :: * -> *) a. (Shell io, Read a, NFData a) => 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 :: forall a (io :: * -> *) v.
(ExecArg a, Shell io) =>
Proc v -> a -> io ByteString
apply Proc v
p 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
>>> :: forall (io :: * -> *) a. Shell io => 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
<<< :: forall (io :: * -> *) a. Shell io => 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 :: HasCallStack =>
ByteString -> [ByteString] -> ProcessHandle -> IO ()
waitProc ByteString
cmd [ByteString]
arg 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 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
ExitCode
ExitSuccess -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
dropWhileEnd :: (Char -> Bool) -> ByteString -> ByteString
dropWhileEnd :: (Char -> Bool) -> ByteString -> ByteString
dropWhileEnd Char -> Bool
p ByteString
b = case ByteString -> Maybe (ByteString, Char)
BC8.unsnoc ByteString
b of
Just (ByteString
i, Char
l) -> if Char -> Bool
p Char
l then (Char -> Bool) -> ByteString -> ByteString
dropWhileEnd Char -> Bool
p ByteString
i else ByteString
b
Maybe (ByteString, Char)
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 :: forall (m :: * -> *) a. Shell m => Proc a -> m (Either Failure a)
tryFailure (Proc 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
$ \Handle
i Handle
o 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 :: forall (m :: * -> *) b a.
Shell m =>
(Failure -> Maybe b) -> Proc a -> m (Either b a)
tryFailureJust Failure -> Maybe b
pr (Proc 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
$ \Handle
i Handle
o 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 :: forall (m :: * -> *) a.
Shell m =>
Proc a -> (Failure -> Proc a) -> m a
catchFailure (Proc Handle -> Handle -> Handle -> IO a
f) 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
$ \Handle
i Handle
o 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 :: forall (m :: * -> *) b a.
Shell m =>
(Failure -> Maybe b) -> Proc a -> (b -> Proc a) -> m a
catchFailureJust Failure -> Maybe b
pr (Proc Handle -> Handle -> Handle -> IO a
f) 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
$ \Handle
i Handle
o 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' :: forall (m :: * -> *) b a.
Shell m =>
(Int -> Maybe b) -> Proc a -> m (Either b a)
translateCode' Int -> Maybe b
f = (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)
translateCode :: Shell m => (Int -> Maybe a) -> Proc a -> m a
translateCode :: forall (m :: * -> *) a.
Shell m =>
(Int -> Maybe a) -> Proc a -> m a
translateCode Int -> Maybe a
f 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 :: forall (io :: * -> *) a. Shell io => Proc a -> io a
failWithStdErr 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 (\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, ByteString
_) -> a -> Proc a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
(Left Failure
f, 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 :: forall (m :: * -> *) a. (Functor m, Shell m) => 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 :: forall (m :: * -> *) a. (Functor m, Shell m) => 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 b
_) = Int
0
getCode (Left Failure
f) = Failure -> Int
failureCode Failure
f
ignoreCode :: (Monad m, Shell m) => Int -> Proc a -> m ()
ignoreCode :: forall (m :: * -> *) a. (Monad m, Shell m) => Int -> Proc a -> m ()
ignoreCode Int
code 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 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 = [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 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 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 ByteString
s = [ByteString
s]
instance ExecArg ByteString.ByteString where
asArg :: ByteString -> [ByteString]
asArg 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 :: HasCallStack => [ByteString] -> Proc a
toArgs (ByteString
cmd:[ByteString]
args) = HasCallStack => ByteString -> [ByteString] -> Proc ()
ByteString -> [ByteString] -> Proc ()
mkProc ByteString
cmd [ByteString]
args
toArgs [ByteString]
_ = String -> Proc a
forall a. HasCallStack => String -> a
error String
"The impossible happened. How did you construct this?"
instance (ExecArg b, Command a) => Command (b -> a) where
toArgs :: HasCallStack => [ByteString] -> b -> a
toArgs [ByteString]
f 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 :: HasCallStack => [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 :: HasCallStack => [ByteString] -> [ByteString]
toArgs = [ByteString] -> [ByteString]
forall a. a -> a
id
instance Command [ByteString.ByteString] where
toArgs :: HasCallStack => [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 = \Cmd
c -> [ByteString] -> [ByteString]
forall a. (Command a, HasCallStack) => [ByteString] -> a
toArgs [ByteString]
Cmd
c
pathBins :: IO [FilePath]
pathBins :: IO [String]
pathBins = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
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 -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
getEnv String
"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 [String]
paths = do
[String]
ps <- (String -> String) -> [String] -> [String]
forall b a. Ord b => (a -> b) -> [a] -> [a]
ordNubOn String -> String
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 (\String
d -> (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
x -> String
dString -> String -> String
forall a. [a] -> [a] -> [a]
++(Char
'/'Char -> String -> String
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 :: forall b a. Ord b => (a -> b) -> [a] -> [a]
ordNubOn a -> b
f [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 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 e
_) -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Right 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 :: forall a str. (Command a, ExecArg str, HasCallStack) => str -> a
exe 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 ExecReference
ref 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 String
fnName String
executable = do
let
name :: Name
name = String -> Name
mkName String
fnName
impl :: Q Dec
impl = Q Pat -> Q Body -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Dec
valD (Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
name) (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB [|
withFrozenCallStack $ exe executable
|]) []
typ :: Dec
typ = Name -> Type -> Dec
SigD Name
name (Name -> Type
ConT ''Cmd)
Dec
i <- Q Dec
impl
[Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return [Dec
typ,Dec
i]
loadExeAs :: ExecReference -> String -> String -> Q [Dec]
loadExeAs :: ExecReference -> String -> String -> Q [Dec]
loadExeAs ExecReference
ref String
fnName 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
Maybe String
Nothing -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error (String -> Q [Dec]) -> String -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ String
"Attempted to load '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
executable String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"', but it is not executable"
Just String
absExe ->
String -> String -> Q [Dec]
rawExe String
fnName (case ExecReference
ref of { ExecReference
Absolute -> String
absExe; ExecReference
SearchPath -> String
executable })
encodeIdentifier :: String -> String
encodeIdentifier :: String -> String
encodeIdentifier String
ident =
let
fixBody :: String -> String
fixBody :: String -> String
fixBody (Char
c:String
cs)
| Char -> Bool
isAlphaNum Char
c = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
fixBody String
cs
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' = Char
'_' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
fixBody String
cs
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' = Char
'\'' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'_' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
fixBody String
cs
| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' = Char
'\'' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'\'' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
fixBody String
cs
| Bool
otherwise = String -> Int -> String -> String
forall r. PrintfType r => String -> r
printf String
"'%x'%s" (Char -> Int
ord Char
c) (String -> String
fixBody String
cs)
fixBody [] = []
fixStart :: String -> String
fixStart :: String -> String
fixStart s :: String
s@(Char
c : String
_)
| Char -> Bool
isLower Char
c = String
s
| Bool
otherwise = Char
'_' Char -> String -> String
forall a. a -> [a] -> [a]
: String
s
fixStart [] = []
i :: String
i = String -> String
fixStart (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
fixBody (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
takeFileName String
ident
reserved :: [String]
reserved = [ String
"import", String
"if", String
"else", String
"then", String
"do", String
"in", String
"let", String
"type"
, String
"as", String
"case", String
"of", String
"class", String
"data", String
"default", String
"deriving"
, String
"instance", String
"forall", String
"foreign", String
"hiding", String
"infix", String
"infixl"
, String
"infixr", String
"mdo", String
"module", String
"newtype", String
"proc", String
"qualified"
, String
"rec", String
"where", String
"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 -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" else String
i
loadEnv :: ExecReference -> Q [Dec]
loadEnv :: ExecReference -> Q [Dec]
loadEnv ExecReference
ref = ExecReference -> (String -> String) -> Q [Dec]
loadAnnotatedEnv ExecReference
ref String -> String
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 ExecReference
ref = ExecReference -> (String -> String) -> [String] -> Q [Dec]
loadAnnotated ExecReference
ref String -> String
encodeIdentifier
loadAnnotated :: ExecReference -> (String -> String) -> [FilePath] -> Q [Dec]
loadAnnotated :: ExecReference -> (String -> String) -> [String] -> Q [Dec]
loadAnnotated ExecReference
ref String -> String
f [String]
bins = do
let pairs :: [(String, String)]
pairs = [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
f [String]
bins) [String]
bins
[Dec]
ds <- [[Dec]] -> [Dec]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 <- Q Pat -> Q Body -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Dec
valD (Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP (String -> Name
mkName String
"missingExecutables")) (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
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 -> (String -> String) -> Q [Dec]
loadAnnotatedEnv ExecReference
ref String -> String
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
ExecReference
Absolute -> IO [String]
pathBinsAbs
ExecReference
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
$ \String
bin -> do
String -> String -> Q [Dec]
rawExe (String -> String
f (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
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 ByteString
s 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 [ByteString
""] = []
dropLastNull (ByteString
a : [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 [String]
ps = [String] -> (String -> String) -> Q [Dec]
loadAnnotatedFromDirs [String]
ps String -> String
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
. (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
</> String
"bin")
loadAnnotatedFromDirs :: [FilePath] -> (String -> String) -> Q [Dec]
loadAnnotatedFromDirs :: [String] -> (String -> String) -> Q [Dec]
loadAnnotatedFromDirs [String]
ps String -> String
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
$ \String
bin -> do
String -> String -> Q [Dec]
rawExe (String -> String
f (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
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 ByteString
"\0"
cd' :: FilePath -> IO ()
cd' :: String -> IO ()
cd' String
p = do
String -> IO ()
Dir.setCurrentDirectory String
p
String
a <- IO String
Dir.getCurrentDirectory
String -> String -> IO ()
setEnv String
"PWD" String
a
class Cd a where
cd :: a
instance (io ~ IO ()) => Cd io where
cd :: io
cd = String -> IO String
getEnv String
"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 :: forall a.
(NFData a, Monoid a) =>
ByteString -> (ByteString -> Proc a) -> Proc a
xargs1 ByteString
n 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 :: forall a (io :: * -> *).
(NFData a, Shell io) =>
(ByteString -> Proc a) -> io a
readInputP 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
$ \Handle
i Handle
o 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
$ \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 :: forall a (io :: * -> *).
(NFData a, Shell io) =>
ByteString -> ([ByteString] -> Proc a) -> io a
readInputEndByP ByteString
s [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 :: forall a (io :: * -> *).
(NFData a, Shell io) =>
([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 ByteString
"\0"
readInputLinesP :: (NFData a, Shell io) => ([ByteString] -> Proc a) -> io a
readInputLinesP :: forall a (io :: * -> *).
(NFData a, Shell io) =>
([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 ByteString
"\n"
withNullInput :: (Handle -> IO a) -> IO a
withNullInput :: forall a. (Handle -> IO a) -> IO a
withNullInput = String -> IOMode -> (Handle -> IO a) -> IO a
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
"/dev/null" IOMode
ReadMode
withDuplicate :: Handle -> (Handle -> IO a) -> IO a
withDuplicate :: forall a. Handle -> (Handle -> IO a) -> IO a
withDuplicate Handle
h = 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
withDuplicates :: Handle -> Handle -> Handle -> (Handle -> Handle -> Handle -> IO a) -> IO a
withDuplicates :: forall a.
Handle
-> Handle -> Handle -> (Handle -> Handle -> Handle -> IO a) -> IO a
withDuplicates Handle
a Handle
b Handle
c 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
$ \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
$ \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
$ \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 :: forall a.
Handle -> Handle -> (Handle -> Handle -> Handle -> IO a) -> IO a
withDuplicateNullInput Handle
a Handle
b 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
$ \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
$ \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
$ \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 String
path 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_' String
"hDup" Handle
h MVar Handle__
m ((Handle__ -> IO Handle) -> IO Handle)
-> (Handle__ -> IO Handle) -> IO Handle
forall a b. (a -> b) -> a -> b
$ \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 String
path MVar Handle__
r MVar Handle__
w) = do
(FileHandle String
_ 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_' String
"hDup" Handle
h MVar Handle__
w ((Handle__ -> IO Handle) -> IO Handle)
-> (Handle__ -> IO Handle) -> IO Handle
forall a b. (a -> b) -> a -> b
$ \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 String
_ 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_' String
"hDup" Handle
h MVar Handle__
r ((Handle__ -> IO Handle) -> IO Handle)
-> (Handle__ -> IO Handle) -> IO Handle
forall a b. (a -> b) -> a -> b
$ \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 String
filepath Handle
h Maybe (MVar Handle__)
other_side h_ :: Handle__
h_@Handle__{dev
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe (MVar Handle__)
Newline
HandleType
BufferMode
IORef (dec_state, Buffer Word8)
IORef (BufferList Char)
IORef (Buffer Char)
IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haBuffers :: Handle__ -> IORef (BufferList Char)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haDevice :: ()
haEncoder :: ()
haInputNL :: Handle__ -> Newline
haLastDecode :: ()
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haType :: Handle__ -> HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList Char)
haCharBuffer :: IORef (Buffer Char)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
..} Maybe HandleFinalizer
mb_finalizer = do
case Maybe (MVar Handle__)
other_side of
Maybe (MVar Handle__)
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.
(RawIO 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 MVar Handle__
r ->
String
-> Handle -> MVar Handle__ -> (Handle__ -> IO Handle) -> IO Handle
forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' String
"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.
(RawIO 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_ :: forall dev.
(RawIO 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__{dev
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe (MVar Handle__)
Newline
HandleType
BufferMode
IORef (dec_state, Buffer Word8)
IORef (BufferList Char)
IORef (Buffer Char)
IORef (Buffer Word8)
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList Char)
haCharBuffer :: IORef (Buffer Char)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haBufferMode :: Handle__ -> BufferMode
haBuffers :: Handle__ -> IORef (BufferList Char)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haDevice :: ()
haEncoder :: ()
haInputNL :: Handle__ -> Newline
haLastDecode :: ()
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haType :: Handle__ -> HandleType
..} 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.
(RawIO 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