{-# 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 TypeOperators #-}
{-# 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 = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$
[ String
"Command `"
]
forall a. [a] -> [a] -> [a]
++ [[String] -> String
unwords (ByteString -> String
toString (Failure -> ByteString
failureProg Failure
f) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show (Failure -> [ByteString]
failureArgs Failure
f))]
forall a. [a] -> [a] -> [a]
++
[ String
"` failed [exit "
, forall a. Show a => a -> String
show (Failure -> Int
failureCode Failure
f)
, String
"] at "
, CallStack -> String
prettyCallStack (Failure -> CallStack
failureStack Failure
f)
]
forall a. [a] -> [a] -> [a]
++ forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall b a. b -> (a -> b) -> Maybe a -> b
maybe []) (Failure -> Maybe ByteString
failureStdErr Failure
f) (\ByteString
s ->
[String
"\n-- stderr --\n" 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 = forall (f :: * -> *) a. (Shell f, HasCallStack) => Proc a -> f a
runProc forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc forall a b. (a -> b) -> a -> b
$ \Handle
i Handle
o Handle
e ->
forall a. (Handle -> Handle -> IO a) -> IO a
withPipe 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 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 forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
hClose Handle
r
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) = forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc forall a b. (a -> b) -> a -> b
$ \Handle
i Handle
o Handle
e -> do
forall a. (Handle -> Handle -> IO a) -> IO a
withPipe 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 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 forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
hClose Handle
r
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 = forall (f :: * -> *) a. (Shell f, HasCallStack) => Proc a -> f a
runProc forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd (Proc a
a 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 = forall (f :: * -> *) a. (Shell f, HasCallStack) => Proc a -> f a
runProc forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd (Proc a
a 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure
fromFilePath :: String -> IO String
fromFilePath = 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
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 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 = forall a. ToFilePath a => a -> IO String
toFilePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict
fromFilePath :: String -> IO ByteString
fromFilePath = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (f :: * -> *) a. (Shell f, HasCallStack) => Proc a -> f a
runProc Proc a
p
(Proc Handle -> Handle -> Handle -> IO a
f) &> Stream
StdErr = forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc 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) = forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc forall a b. (a -> b) -> a -> b
$ \Handle
i Handle
_ Handle
e -> do
String
path' <- forall a. ToFilePath a => a -> IO String
toFilePath ByteString
path
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
path' IOMode
WriteMode 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) = forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc forall a b. (a -> b) -> a -> b
$ \Handle
i Handle
_ Handle
e -> do
String
path' <- forall a. ToFilePath a => a -> IO String
toFilePath ByteString
path
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
path' IOMode
AppendMode 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 = forall (f :: * -> *) a. (Shell f, HasCallStack) => Proc a -> f a
runProc Proc a
p
(Proc Handle -> Handle -> Handle -> IO a
f) &!> Stream
StdOut = forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc 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) = forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc forall a b. (a -> b) -> a -> b
$ \Handle
i Handle
o Handle
_ -> do
String
path' <- forall a. ToFilePath a => a -> IO String
toFilePath ByteString
path
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
path' IOMode
WriteMode 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) = forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc forall a b. (a -> b) -> a -> b
$ \Handle
i Handle
o Handle
_ -> do
String
path' <- forall a. ToFilePath a => a -> IO String
toFilePath ByteString
path
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
path' IOMode
AppendMode 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 = forall (f :: * -> *) a. (Shell f, HasCallStack) => Proc a -> f a
runProc forall a b. (a -> b) -> a -> b
$ forall a. (Handle -> Handle -> Handle -> IO a) -> Proc a
Proc forall a b. (a -> b) -> a -> b
$ \Handle
i Handle
o Handle
e -> forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle forall a. IOError -> IO a
handler forall a b. (a -> b) -> a -> b
$ do
forall a.
Handle
-> Handle -> Handle -> (Handle -> Handle -> Handle -> IO a) -> IO a
withDuplicates Handle
i Handle
o Handle
e 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' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> IO a
C.evaluate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NFData a => a -> a
force)
forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
hClose Handle
i'
forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
hClose Handle
o'
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 forall a. Eq a => a -> a -> Bool
== IOErrorType
ResourceVanished = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a e. Exception e => e -> a
throw IOError
e)
| Bool
otherwise = 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
(<|) = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 =
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 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 = forall (f :: * -> *) a.
(Shell f, NFData a) =>
(Handle -> Handle -> Handle -> IO a) -> f a
nativeProc forall a b. (a -> b) -> a -> b
$ \Handle
_ Handle
o Handle
_ -> do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> ByteString -> IO ()
BS.hPutStr Handle
o) (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 = forall (f :: * -> *) a.
(Shell f, NFData a) =>
(Handle -> Handle -> Handle -> IO a) -> f a
nativeProc forall a b. (a -> b) -> a -> b
$ \Handle
_ Handle
_ Handle
e -> do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> ByteString -> IO ()
BS.hPutStr Handle
e) (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 = forall (f :: * -> *) a.
(Shell f, NFData a) =>
(Handle -> Handle -> Handle -> IO a) -> f a
nativeProc forall a b. (a -> b) -> a -> b
$ \Handle
i Handle
_ Handle
_ -> do
Handle -> IO ByteString
hGetContents Handle
i 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\ByteString
l -> ByteString -> Builder
lazyByteString ByteString
l 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 = forall a (io :: * -> *).
(NFData a, Shell io) =>
(ByteString -> IO a) -> io a
readInput ([ByteString] -> IO a
f 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 = 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 = 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 = forall (f :: * -> *) a.
(Shell f, NFData a) =>
(Handle -> Handle -> Handle -> IO a) -> f a
nativeProc 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 = forall (io :: * -> *).
Shell io =>
(ByteString -> ByteString) -> io ()
pureProc forall a b. (a -> b) -> a -> b
$ \ByteString
inp -> Builder -> ByteString
toLazyByteString forall a b. (a -> b) -> a -> b
$
forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\ByteString
l -> ByteString -> Builder
lazyByteString ByteString
s forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
lazyByteString ByteString
l 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 = forall a (io :: * -> *). (ExecArg a, Shell io) => a -> io ()
writeOutput ByteString
s 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 forall (f :: * -> *) a b. Shell f => Proc a -> Proc b -> f 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 -> 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 = forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc forall a b. (a -> b) -> a -> b
$ \Handle
_ Handle
_ Handle
_ -> IO a
a
instance Semigroup (Proc a) where
<> :: 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 = forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc forall a b. (a -> b) -> a -> b
$ \Handle
_ Handle
_ Handle
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
instance Applicative Proc where
pure :: forall a. a -> Proc a
pure a
a = forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc forall a b. (a -> b) -> a -> b
$ \Handle
_ Handle
_ Handle
_ -> do
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' 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 = forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc 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 = 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 = 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
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 ()
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
{ 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 = forall a. (Handle -> Handle -> Handle -> IO a) -> Proc a
Proc forall a b. (a -> b) -> a -> b
$ \Handle
i Handle
o Handle
e -> do
String
cmd' <- forall a. ToFilePath a => a -> IO String
toFilePath ByteString
cmd
[String]
args' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. ToFilePath a => a -> IO String
toFilePath [ByteString]
args
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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph)
forall a b. (a -> b) -> a -> b
$ \(Maybe Handle
_,Maybe Handle
_,Maybe Handle
_,ProcessHandle
ph) -> HasCallStack =>
ByteString -> [ByteString] -> ProcessHandle -> IO ()
waitProc ByteString
cmd [ByteString]
args ProcessHandle
ph forall a b. IO a -> IO b -> IO a
`onException` (ProcessHandle -> IO ()
terminateProcess ProcessHandle
ph 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 ()
mkProcWith ProcOptions
defaultProcOptions
capture :: Shell io => io ByteString
capture :: forall (io :: * -> *). Shell io => io ByteString
capture = forall a (io :: * -> *).
(NFData a, Shell io) =>
(ByteString -> IO a) -> io a
readInput forall (f :: * -> *) a. Applicative f => a -> f a
pure
captureTrim :: Shell io => io ByteString
captureTrim :: forall (io :: * -> *). Shell io => io ByteString
captureTrim = forall a (io :: * -> *).
(NFData a, Shell io) =>
(ByteString -> IO a) -> io a
readInput (forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall a (io :: * -> *).
(NFData a, Shell io) =>
(ByteString -> IO a) -> io a
readInput (forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (io :: * -> *). Shell io => ByteString -> io [ByteString]
captureEndBy ByteString
"\0"
captureLines :: Shell io => io [ByteString]
captureLines :: forall (io :: * -> *). Shell io => io [ByteString]
captureLines = forall (io :: * -> *). Shell io => ByteString -> io [ByteString]
captureEndBy ByteString
"\n"
captureWords :: Shell io => io [ByteString]
captureWords :: forall (io :: * -> *). Shell io => io [ByteString]
captureWords = forall a (io :: * -> *).
(NFData a, Shell io) =>
(ByteString -> IO a) -> io a
readInput (forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall a (io :: * -> *).
(NFData a, Shell io) =>
(ByteString -> IO a) -> io a
readInput (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read 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 = forall a (io :: * -> *). (ExecArg a, Shell io) => a -> io ()
writeOutput a
b forall (f :: * -> *) a b. Shell f => Proc a -> Proc b -> f b
|> Proc v
p forall (f :: * -> *) a b. Shell f => Proc a -> Proc b -> f b
|> forall (io :: * -> *). Shell io => io ByteString
capture
(>>>) :: Shell io => ByteString -> Proc a -> io a
>>> :: forall (io :: * -> *) a. Shell io => ByteString -> Proc a -> io a
(>>>) = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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
(<<<) = 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ExitFailure Int
c
| forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c forall a. Eq a => a -> a -> Bool
== forall a. Num a => a -> a
negate CInt
sigPIPE -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ ByteString
-> [ByteString] -> CallStack -> Int -> Maybe ByteString -> Failure
Failure ByteString
cmd [ByteString]
arg HasCallStack => CallStack
callStack Int
c forall a. Maybe a
Nothing
ExitCode
ExitSuccess -> 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 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) = forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc forall a b. (a -> b) -> a -> b
$ \Handle
i Handle
o Handle
e -> forall e a. Exception e => IO a -> IO (Either e a)
try 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) = forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc forall a b. (a -> b) -> a -> b
$ \Handle
i Handle
o Handle
e -> 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 = forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc forall a b. (a -> b) -> a -> b
$ \Handle
i Handle
o Handle
e -> 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) (forall (f :: * -> *) a. (Shell f, HasCallStack) => Proc a -> f a
runProc 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 = forall (f :: * -> *) a.
Shell f =>
(Handle -> Handle -> Handle -> IO a) -> f a
buildProc forall a b. (a -> b) -> a -> b
$ \Handle
i Handle
o Handle
e -> 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) (forall (f :: * -> *) a. (Shell f, HasCallStack) => Proc a -> f a
runProc 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 = forall (m :: * -> *) b a.
Shell m =>
(Failure -> Maybe b) -> Proc a -> m (Either b a)
tryFailureJust (Int -> Maybe b
f 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 = forall (m :: * -> *) b a.
Shell m =>
(Failure -> Maybe b) -> Proc a -> (b -> Proc a) -> m a
catchFailureJust (Int -> Maybe a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Failure -> Int
failureCode) Proc a
p 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 = forall (f :: * -> *) a. (Shell f, HasCallStack) => Proc a -> f a
runProc forall a b. (a -> b) -> a -> b
$ do
(Either Failure a, ByteString)
r <- forall (m :: * -> *) a. Shell m => Proc a -> m (Either Failure a)
tryFailure Proc a
p forall (f :: * -> *) a b. Shell f => Proc a -> Proc b -> f (a, b)
`pipeErr` forall a (io :: * -> *).
(NFData a, Shell io) =>
(ByteString -> Proc a) -> io a
readInputP (\ByteString
i -> do
forall a (io :: * -> *). (ExecArg a, Shell io) => a -> io ()
writeError ByteString
i
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
i
)
case (Either Failure a, ByteString)
r of
(Right a
a, ByteString
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
(Left Failure
f, ByteString
err) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Failure
f {failureStdErr :: Maybe ByteString
failureStdErr = 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 = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {b}. Either Failure b -> Int
getCode forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) b a.
Shell m =>
(Failure -> Maybe b) -> Proc a -> (b -> Proc a) -> m a
catchFailureJust Failure -> Maybe ()
pr (forall (f :: * -> *) a. Functor f => f a -> f ()
void Proc a
p) forall (f :: * -> *) a. Applicative f => a -> f a
pure
where
pr :: Failure -> Maybe ()
pr Failure
f
| Failure -> Int
failureCode Failure
f forall a. Eq a => a -> a -> Bool
== Int
code = forall a. a -> Maybe a
Just ()
| Bool
otherwise = forall a. Maybe a
Nothing
class ExecArg a where
asArg :: a -> [ByteString]
default asArg :: Show a => a -> [ByteString]
asArg a
a = [forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. ToFilePath a => String -> IO a
fromFilePath forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
a]
asArgFromList :: [a] -> [ByteString]
default asArgFromList :: Show a => [a] -> [ByteString]
asArgFromList = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. ExecArg a => a -> [ByteString]
asArg
instance ExecArg Char where
asArg :: Char -> [ByteString]
asArg Char
s = [forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. ToFilePath a => String -> IO a
fromFilePath [Char
s]]
asArgFromList :: String -> [ByteString]
asArgFromList String
s = [forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. ToFilePath a => String -> IO a
fromFilePath String
s]
instance ExecArg a => ExecArg [a] where
asArg :: [a] -> [ByteString]
asArg = forall a. ExecArg a => [a] -> [ByteString]
asArgFromList
asArgFromList :: [[a]] -> [ByteString]
asArgFromList = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap 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 ()
mkProc ByteString
cmd [ByteString]
args
toArgs [ByteString]
_ = 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 = forall a. (Command a, HasCallStack) => [ByteString] -> a
toArgs forall a b. (a -> b) -> a -> b
$ [ByteString]
f forall a. [a] -> [a] -> [a]
++ forall a. ExecArg a => a -> [ByteString]
asArg b
i
instance (a ~ ()) => Command (IO a) where
toArgs :: HasCallStack => [ByteString] -> IO a
toArgs = forall (f :: * -> *) a. (Shell f, HasCallStack) => Proc a -> f a
runProc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Command a, HasCallStack) => [ByteString] -> a
toArgs
instance Command [ByteString] where
toArgs :: HasCallStack => [ByteString] -> [ByteString]
toArgs = forall a. a -> a
id
instance Command [ByteString.ByteString] where
toArgs :: HasCallStack => [ByteString] -> [ByteString]
toArgs = 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 -> forall a. (Command a, HasCallStack) => [ByteString] -> a
toArgs Cmd
c
pathBins :: IO [FilePath]
pathBins :: IO [String]
pathBins = forall a b. (a -> b) -> [a] -> [b]
map String -> String
takeFileName 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 <- forall a. Eq a => [a] -> [a] -> [[a]]
Split.splitOn String
":" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
getEnv String
"PATH"
[String]
paths <- 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 <- forall b a. Ord b => (a -> b) -> [a] -> [a]
ordNubOn String -> String
takeFileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\String
d -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
x -> String
dforall a. [a] -> [a] -> [a]
++(Char
'/'forall a. a -> [a] -> [a]
:String
x)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
Dir.getDirectoryContents String
d) [String]
paths
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (IO Bool -> IO Bool
tryBool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Permissions -> Bool
Dir.executable 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 = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (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 = forall e a. Exception e => IO a -> IO (Either e a)
try IO Bool
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left (SomeException e
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Right Bool
r -> 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 = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall a. (Command a, HasCallStack) => [ByteString] -> a
toArgs (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 = forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Dec
valD (forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
name) (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
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
forall a. IO a -> Q a
runIO (String -> IO (Maybe String)
Dir.findExecutable String
executable) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe String
Nothing -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Attempted to load '" forall a. [a] -> [a] -> [a]
++ String
executable 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 forall a. a -> [a] -> [a]
: String -> String
fixBody String
cs
| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' = Char
'_' forall a. a -> [a] -> [a]
: String -> String
fixBody String
cs
| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_' = Char
'\'' forall a. a -> [a] -> [a]
: Char
'_' forall a. a -> [a] -> [a]
: String -> String
fixBody String
cs
| Char
c forall a. Eq a => a -> a -> Bool
== Char
'.' = Char
'\'' forall a. a -> [a] -> [a]
: Char
'\'' forall a. a -> [a] -> [a]
: String -> String
fixBody String
cs
| Bool
otherwise = 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
'_' forall a. a -> [a] -> [a]
: String
s
fixStart [] = []
i :: String
i = String -> String
fixStart forall a b. (a -> b) -> a -> b
$ String -> String
fixBody 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
reserved then String
i 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> Bool
isJust 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 = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map String -> String
f [String]
bins) [String]
bins
[Dec]
ds <- forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (ExecReference -> String -> String -> Q [Dec]
loadExeAs ExecReference
ref)) [(String, String)]
pairs
Dec
d <- forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Dec
valD (forall (m :: * -> *). Quote m => Name -> m Pat
varP (String -> Name
mkName String
"missingExecutables")) (forall (m :: * -> *). Quote m => m Exp -> m Body
normalB [|
filterM (fmap not . checkExecutable) bins
|]) []
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dec
dforall 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 <- forall a. IO a -> Q a
runIO forall a b. (a -> b) -> a -> b
$ case ExecReference
ref of
ExecReference
Absolute -> IO [String]
pathBinsAbs
ExecReference
SearchPath -> IO [String]
pathBins
[[Dec]]
i <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
bins forall a b. (a -> b) -> a -> b
$ \String
bin -> do
String -> String -> Q [Dec]
rawExe (String -> String
f forall a b. (a -> b) -> a -> b
$ String -> String
takeFileName String
bin) String
bin
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 <- forall a. IO a -> Q a
runIO forall a b. (a -> b) -> a -> b
$ [String] -> IO [String]
findBinsIn [String]
ps
[[Dec]]
i <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
bins forall a b. (a -> b) -> a -> b
$ \String
bin -> do
String -> String -> Q [Dec]
rawExe (String -> String
f forall a b. (a -> b) -> a -> b
$ String -> String
takeFileName String
bin) String
bin
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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" 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 = 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 = forall a (io :: * -> *).
(NFData a, Shell io) =>
ByteString -> ([ByteString] -> Proc a) -> io a
readInputEndByP ByteString
n (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (f :: * -> *) a.
(Shell f, NFData a) =>
(Handle -> Handle -> Handle -> IO a) -> f a
nativeProc forall a b. (a -> b) -> a -> b
$ \Handle
i Handle
o Handle
e -> do
ByteString
s <- Handle -> IO ByteString
hGetContents Handle
i
forall a. (Handle -> IO a) -> IO a
withNullInput forall a b. (a -> b) -> a -> b
$ \Handle
i' ->
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 = forall a (io :: * -> *).
(NFData a, Shell io) =>
(ByteString -> Proc a) -> io a
readInputP ([ByteString] -> Proc a
f 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 = 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 = 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 = 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 = 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 =
forall a. Handle -> (Handle -> IO a) -> IO a
withDuplicate Handle
a forall a b. (a -> b) -> a -> b
$ \Handle
a' -> forall a. Handle -> (Handle -> IO a) -> IO a
withDuplicate Handle
b forall a b. (a -> b) -> a -> b
$ \Handle
b' -> forall a. Handle -> (Handle -> IO a) -> IO a
withDuplicate Handle
c 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
forall a. (Handle -> IO a) -> IO a
withNullInput forall a b. (a -> b) -> a -> b
$ \Handle
i -> do
forall a. Handle -> (Handle -> IO a) -> IO a
withDuplicate Handle
a forall a b. (a -> b) -> a -> b
$ \Handle
a' -> forall a. Handle -> (Handle -> IO a) -> IO a
withDuplicate Handle
b 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
forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' String
"hDup" Handle
h MVar Handle__
m forall a b. (a -> b) -> a -> b
$ \Handle__
h_ ->
String
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandleShh String
path Handle
h forall a. Maybe a
Nothing Handle__
h_ (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) <-
forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' String
"hDup" Handle
h MVar Handle__
w forall a b. (a -> b) -> a -> b
$ \Handle__
h_ ->
String
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandleShh String
path Handle
h forall a. Maybe a
Nothing Handle__
h_ (forall a. a -> Maybe a
Just HandleFinalizer
handleFinalizer)
(FileHandle String
_ MVar Handle__
read_m) <-
forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' String
"hDup" Handle
h MVar Handle__
r forall a b. (a -> b) -> a -> b
$ \Handle__
h_ ->
String
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandleShh String
path Handle
h (forall a. a -> Maybe a
Just MVar Handle__
write_m) Handle__
h_ forall a. Maybe a
Nothing
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 <- forall a. IODevice a => a -> IO a
IODevice.dup dev
haDevice
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 ->
forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' String
"dupHandleShh" Handle
h MVar Handle__
r forall a b. (a -> b) -> a -> b
$ \Handle__{haDevice :: ()
haDevice=dev
dev} -> do
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 forall a. Maybe a -> Bool
isJust Maybe (TextEncoder enc_state)
haEncoder then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just IO TextEncoding
getLocaleEncoding else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
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 { inputNL :: Newline
inputNL = Newline
haInputNL, outputNL :: Newline
outputNL = Newline
haOutputNL }
Maybe HandleFinalizer
mb_finalizer Maybe (MVar Handle__)
other_side