module RawFilePath.Process.Common
( Process(..)
, ProcessConf(..)
, proc
, processStdin
, processStdout
, processStderr
, StreamType
, mbFd
, willCreateHandle
, CreatePipe(..)
, Inherit(..)
, NoStream(..)
, UseHandle(..)
, setStdin
, setStdout
, setStderr
, PHANDLE
, ProcessHandle__(..)
, modifyProcessHandle
, withProcessHandle
, fdStdin
, fdStdout
, fdStderr
, mbPipe
) where
import RawFilePath.Import
import GHC.IO.Handle.FD as Module (mkHandleFromFD)
import System.Posix.Internals (FD)
import qualified GHC.IO.FD as FD
data ProcessConf stdin stdout stderr = ProcessConf
{ forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> [ByteString]
cmdargs :: [ByteString]
, forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> Maybe ByteString
cwd :: Maybe RawFilePath
, forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> Maybe [(ByteString, ByteString)]
env :: Maybe [(ByteString, ByteString)]
, forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> stdin
cfgStdin :: stdin
, forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> stdout
cfgStdout :: stdout
, forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> stderr
cfgStderr :: stderr
, forall stdin stdout stderr. ProcessConf stdin stdout stderr -> Bool
closeFds :: Bool
, forall stdin stdout stderr. ProcessConf stdin stdout stderr -> Bool
createGroup :: Bool
, forall stdin stdout stderr. ProcessConf stdin stdout stderr -> Bool
delegateCtlc :: Bool
, forall stdin stdout stderr. ProcessConf stdin stdout stderr -> Bool
createNewConsole :: Bool
, forall stdin stdout stderr. ProcessConf stdin stdout stderr -> Bool
newSession :: Bool
, forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> Maybe GroupID
childGroup :: Maybe GroupID
, forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> Maybe UserID
childUser :: Maybe UserID
}
proc
:: RawFilePath
-> [ByteString]
-> ProcessConf Inherit Inherit Inherit
proc :: ByteString -> [ByteString] -> ProcessConf Inherit Inherit Inherit
proc ByteString
cmd [ByteString]
args = ProcessConf
{ cmdargs :: [ByteString]
cmdargs = ByteString
cmd forall a. a -> [a] -> [a]
: [ByteString]
args
, cwd :: Maybe ByteString
cwd = forall a. Maybe a
Nothing
, env :: Maybe [(ByteString, ByteString)]
env = forall a. Maybe a
Nothing
, cfgStdin :: Inherit
cfgStdin = Inherit
Inherit
, cfgStdout :: Inherit
cfgStdout = Inherit
Inherit
, cfgStderr :: Inherit
cfgStderr = Inherit
Inherit
, closeFds :: Bool
closeFds = Bool
False
, createGroup :: Bool
createGroup = Bool
False
, delegateCtlc :: Bool
delegateCtlc = Bool
False
, createNewConsole :: Bool
createNewConsole = Bool
False
, newSession :: Bool
newSession = Bool
False
, childGroup :: Maybe GroupID
childGroup = forall a. Maybe a
Nothing
, childUser :: Maybe UserID
childUser = forall a. Maybe a
Nothing
}
setStdin
:: (StreamType newStdin)
=> ProcessConf oldStdin stdout stderr
-> newStdin
-> ProcessConf newStdin stdout stderr
setStdin :: forall newStdin oldStdin stdout stderr.
StreamType newStdin =>
ProcessConf oldStdin stdout stderr
-> newStdin -> ProcessConf newStdin stdout stderr
setStdin ProcessConf oldStdin stdout stderr
p newStdin
newStdin = ProcessConf oldStdin stdout stderr
p { cfgStdin :: newStdin
cfgStdin = newStdin
newStdin }
infixl 4 `setStdin`
setStdout
:: (StreamType newStdout)
=> ProcessConf stdin oldStdout stderr
-> newStdout
-> ProcessConf stdin newStdout stderr
setStdout :: forall newStdout stdin oldStdout stderr.
StreamType newStdout =>
ProcessConf stdin oldStdout stderr
-> newStdout -> ProcessConf stdin newStdout stderr
setStdout ProcessConf stdin oldStdout stderr
p newStdout
newStdout = ProcessConf stdin oldStdout stderr
p { cfgStdout :: newStdout
cfgStdout = newStdout
newStdout }
infixl 4 `setStdout`
setStderr
:: (StreamType newStderr)
=> ProcessConf stdin stdout oldStderr
-> newStderr
-> ProcessConf stdin stdout newStderr
setStderr :: forall newStderr stdin stdout oldStderr.
StreamType newStderr =>
ProcessConf stdin stdout oldStderr
-> newStderr -> ProcessConf stdin stdout newStderr
setStderr ProcessConf stdin stdout oldStderr
p newStderr
newStderr = ProcessConf stdin stdout oldStderr
p { cfgStderr :: newStderr
cfgStderr = newStderr
newStderr }
infixl 4 `setStderr`
data Process stdin stdout stderr = Process
{ forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStdin :: Maybe Handle
, forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStdout :: Maybe Handle
, forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStderr :: Maybe Handle
, forall stdin stdout stderr.
Process stdin stdout stderr -> MVar ProcessHandle__
phandle :: !(MVar ProcessHandle__)
, forall stdin stdout stderr. Process stdin stdout stderr -> Bool
mbDelegateCtlc :: !Bool
, forall stdin stdout stderr. Process stdin stdout stderr -> MVar ()
waitpidLock :: !(MVar ())
}
processStdin :: Process CreatePipe stdout stderr -> Handle
processStdin :: forall stdout stderr. Process CreatePipe stdout stderr -> Handle
processStdin Process{Bool
Maybe Handle
MVar ()
MVar ProcessHandle__
waitpidLock :: MVar ()
mbDelegateCtlc :: Bool
phandle :: MVar ProcessHandle__
procStderr :: Maybe Handle
procStdout :: Maybe Handle
procStdin :: Maybe Handle
waitpidLock :: forall stdin stdout stderr. Process stdin stdout stderr -> MVar ()
mbDelegateCtlc :: forall stdin stdout stderr. Process stdin stdout stderr -> Bool
phandle :: forall stdin stdout stderr.
Process stdin stdout stderr -> MVar ProcessHandle__
procStderr :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStdout :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStdin :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
..} = forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err Maybe Handle
procStdin
where
err :: a
err = forall a. HasCallStack => [Char] -> a
error [Char]
"This can't happen: stdin is CreatePipe but missing"
processStdout :: Process stdin CreatePipe stderr -> Handle
processStdout :: forall stdin stderr. Process stdin CreatePipe stderr -> Handle
processStdout Process{Bool
Maybe Handle
MVar ()
MVar ProcessHandle__
waitpidLock :: MVar ()
mbDelegateCtlc :: Bool
phandle :: MVar ProcessHandle__
procStderr :: Maybe Handle
procStdout :: Maybe Handle
procStdin :: Maybe Handle
waitpidLock :: forall stdin stdout stderr. Process stdin stdout stderr -> MVar ()
mbDelegateCtlc :: forall stdin stdout stderr. Process stdin stdout stderr -> Bool
phandle :: forall stdin stdout stderr.
Process stdin stdout stderr -> MVar ProcessHandle__
procStderr :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStdout :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStdin :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
..} = forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err Maybe Handle
procStdout
where
err :: a
err = forall a. HasCallStack => [Char] -> a
error [Char]
"This can't happen: stdout is CreatePipe but missing"
processStderr :: Process stdin stdout CreatePipe -> Handle
processStderr :: forall stdin stdout. Process stdin stdout CreatePipe -> Handle
processStderr Process{Bool
Maybe Handle
MVar ()
MVar ProcessHandle__
waitpidLock :: MVar ()
mbDelegateCtlc :: Bool
phandle :: MVar ProcessHandle__
procStderr :: Maybe Handle
procStdout :: Maybe Handle
procStdin :: Maybe Handle
waitpidLock :: forall stdin stdout stderr. Process stdin stdout stderr -> MVar ()
mbDelegateCtlc :: forall stdin stdout stderr. Process stdin stdout stderr -> Bool
phandle :: forall stdin stdout stderr.
Process stdin stdout stderr -> MVar ProcessHandle__
procStderr :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStdout :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
procStdin :: forall stdin stdout stderr.
Process stdin stdout stderr -> Maybe Handle
..} = forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err Maybe Handle
procStderr
where
err :: a
err = forall a. HasCallStack => [Char] -> a
error [Char]
"This can't happen: stderr is CreatePipe but missing"
data CreatePipe = CreatePipe deriving Int -> CreatePipe -> ShowS
[CreatePipe] -> ShowS
CreatePipe -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CreatePipe] -> ShowS
$cshowList :: [CreatePipe] -> ShowS
show :: CreatePipe -> [Char]
$cshow :: CreatePipe -> [Char]
showsPrec :: Int -> CreatePipe -> ShowS
$cshowsPrec :: Int -> CreatePipe -> ShowS
Show
data Inherit = Inherit deriving Int -> Inherit -> ShowS
[Inherit] -> ShowS
Inherit -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Inherit] -> ShowS
$cshowList :: [Inherit] -> ShowS
show :: Inherit -> [Char]
$cshow :: Inherit -> [Char]
showsPrec :: Int -> Inherit -> ShowS
$cshowsPrec :: Int -> Inherit -> ShowS
Show
data NoStream = NoStream deriving Int -> NoStream -> ShowS
[NoStream] -> ShowS
NoStream -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [NoStream] -> ShowS
$cshowList :: [NoStream] -> ShowS
show :: NoStream -> [Char]
$cshow :: NoStream -> [Char]
showsPrec :: Int -> NoStream -> ShowS
$cshowsPrec :: Int -> NoStream -> ShowS
Show
data UseHandle = UseHandle Handle deriving Int -> UseHandle -> ShowS
[UseHandle] -> ShowS
UseHandle -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [UseHandle] -> ShowS
$cshowList :: [UseHandle] -> ShowS
show :: UseHandle -> [Char]
$cshow :: UseHandle -> [Char]
showsPrec :: Int -> UseHandle -> ShowS
$cshowsPrec :: Int -> UseHandle -> ShowS
Show
class StreamType c where
mbFd :: FD -> c -> IO FD
willCreateHandle :: c -> Bool
#if __GLASGOW_HASKELL__ >= 780
mbFd = forall a. HasCallStack => a
undefined
willCreateHandle = forall a. HasCallStack => a
undefined
{-# MINIMAL #-}
#endif
instance StreamType CreatePipe where
mbFd :: FD -> CreatePipe -> IO FD
mbFd FD
_ CreatePipe
_ = forall (m :: * -> *) a. Monad m => a -> m a
return (-FD
1)
willCreateHandle :: CreatePipe -> Bool
willCreateHandle CreatePipe
_ = Bool
True
instance StreamType Inherit where
mbFd :: FD -> Inherit -> IO FD
mbFd FD
std Inherit
_ = forall (m :: * -> *) a. Monad m => a -> m a
return FD
std
willCreateHandle :: Inherit -> Bool
willCreateHandle Inherit
_ = Bool
False
instance StreamType NoStream where
mbFd :: FD -> NoStream -> IO FD
mbFd FD
_ NoStream
_ = forall (m :: * -> *) a. Monad m => a -> m a
return (-FD
2)
willCreateHandle :: NoStream -> Bool
willCreateHandle NoStream
_ = Bool
False
instance StreamType UseHandle where
mbFd :: FD -> UseHandle -> IO FD
mbFd FD
_std (UseHandle Handle
hdl) =
forall a.
[Char] -> Handle -> (Handle__ -> IO (Handle__, a)) -> IO a
withHandle [Char]
"" Handle
hdl forall a b. (a -> b) -> a -> b
$ \Handle__{haDevice :: ()
haDevice=dev
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 :: ()
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
..} -> case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast dev
dev of
Just FD
fd -> do
FD
fd' <- FD -> Bool -> IO FD
FD.setNonBlockingMode FD
fd Bool
False
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__{haDevice :: FD
haDevice=FD
fd',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 :: BufferMode
haBuffers :: IORef (BufferList Char)
haByteBuffer :: IORef (Buffer Word8)
haCharBuffer :: IORef (Buffer Char)
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haInputNL :: Newline
haLastDecode :: IORef (dec_state, Buffer Word8)
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haType :: 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
..}, FD -> FD
FD.fdFD FD
fd')
Maybe FD
Nothing -> forall a. IOError -> IO a
ioError forall a b. (a -> b) -> a -> b
$ IOErrorType -> [Char] -> Maybe Handle -> Maybe [Char] -> IOError
mkIOError IOErrorType
illegalOperationErrorType
[Char]
"createProcess" (forall a. a -> Maybe a
Just Handle
hdl) forall a. Maybe a
Nothing
IOError -> [Char] -> IOError
`ioeSetErrorString` [Char]
"handle is not a file descriptor"
willCreateHandle :: UseHandle -> Bool
willCreateHandle UseHandle
_ = Bool
False
type PHANDLE = CPid
data ProcessHandle__ = OpenHandle PHANDLE
| OpenExtHandle PHANDLE PHANDLE PHANDLE
| ClosedHandle ExitCode
modifyProcessHandle
:: Process stdin stdout stderr
-> (ProcessHandle__ -> IO (ProcessHandle__, a))
-> IO a
modifyProcessHandle :: forall stdin stdout stderr a.
Process stdin stdout stderr
-> (ProcessHandle__ -> IO (ProcessHandle__, a)) -> IO a
modifyProcessHandle Process stdin stdout stderr
p = forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (forall stdin stdout stderr.
Process stdin stdout stderr -> MVar ProcessHandle__
phandle Process stdin stdout stderr
p)
withProcessHandle
:: Process stdin stdout stderr -> (ProcessHandle__ -> IO a) -> IO a
withProcessHandle :: forall stdin stdout stderr a.
Process stdin stdout stderr -> (ProcessHandle__ -> IO a) -> IO a
withProcessHandle Process stdin stdout stderr
p = forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (forall stdin stdout stderr.
Process stdin stdout stderr -> MVar ProcessHandle__
phandle Process stdin stdout stderr
p)
fdStdin, fdStdout, fdStderr :: FD
fdStdin :: FD
fdStdin = FD
0
fdStdout :: FD
fdStdout = FD
1
fdStderr :: FD
fdStderr = FD
2
mbPipe :: StreamType c => c -> Ptr FD -> IOMode -> IO (Maybe Handle)
mbPipe :: forall c.
StreamType c =>
c -> Ptr FD -> IOMode -> IO (Maybe Handle)
mbPipe c
streamConf Ptr FD
pfd IOMode
mode = if forall c. StreamType c => c -> Bool
willCreateHandle c
streamConf
then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (Ptr FD -> IOMode -> IO Handle
pfdToHandle Ptr FD
pfd IOMode
mode)
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
pfdToHandle :: Ptr FD -> IOMode -> IO Handle
pfdToHandle :: Ptr FD -> IOMode -> IO Handle
pfdToHandle Ptr FD
pfd IOMode
mode = do
FD
fd <- forall a. Storable a => Ptr a -> IO a
peek Ptr FD
pfd
let filepath :: [Char]
filepath = [Char]
"fd:" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show FD
fd
(FD
fD,IODeviceType
fd_type) <- FD
-> IOMode
-> Maybe (IODeviceType, CDev, CIno)
-> Bool
-> Bool
-> IO (FD, IODeviceType)
FD.mkFD (forall a b. (Integral a, Num b) => a -> b
fromIntegral FD
fd) IOMode
mode
(forall a. a -> Maybe a
Just (IODeviceType
Stream,CDev
0,CIno
0))
Bool
False
Bool
False
FD
fD' <- FD -> Bool -> IO FD
FD.setNonBlockingMode FD
fD Bool
True
#if __GLASGOW_HASKELL__ >= 704
TextEncoding
enc <- IO TextEncoding
getLocaleEncoding
#else
let enc = localeEncoding
#endif
FD
-> IODeviceType
-> [Char]
-> IOMode
-> Bool
-> Maybe TextEncoding
-> IO Handle
mkHandleFromFD FD
fD' IODeviceType
fd_type [Char]
filepath IOMode
mode Bool
False (forall a. a -> Maybe a
Just TextEncoding
enc)