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
{ ProcessConf stdin stdout stderr -> [ByteString]
cmdargs :: [ByteString]
, ProcessConf stdin stdout stderr -> Maybe ByteString
cwd :: Maybe RawFilePath
, ProcessConf stdin stdout stderr -> Maybe [(ByteString, ByteString)]
env :: Maybe [(ByteString, ByteString)]
, ProcessConf stdin stdout stderr -> stdin
cfgStdin :: stdin
, ProcessConf stdin stdout stderr -> stdout
cfgStdout :: stdout
, ProcessConf stdin stdout stderr -> stderr
cfgStderr :: stderr
, ProcessConf stdin stdout stderr -> Bool
closeFds :: Bool
, ProcessConf stdin stdout stderr -> Bool
createGroup :: Bool
, ProcessConf stdin stdout stderr -> Bool
delegateCtlc :: Bool
, ProcessConf stdin stdout stderr -> Bool
createNewConsole :: Bool
, ProcessConf stdin stdout stderr -> Bool
newSession :: Bool
, ProcessConf stdin stdout stderr -> Maybe GroupID
childGroup :: Maybe GroupID
, 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 :: forall stdin stdout stderr.
[ByteString]
-> Maybe ByteString
-> Maybe [(ByteString, ByteString)]
-> stdin
-> stdout
-> stderr
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe GroupID
-> Maybe UserID
-> ProcessConf stdin stdout stderr
ProcessConf
{ cmdargs :: [ByteString]
cmdargs = ByteString
cmd ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
args
, cwd :: Maybe ByteString
cwd = Maybe ByteString
forall a. Maybe a
Nothing
, env :: Maybe [(ByteString, ByteString)]
env = Maybe [(ByteString, ByteString)]
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 = Maybe GroupID
forall a. Maybe a
Nothing
, childUser :: Maybe UserID
childUser = Maybe UserID
forall a. Maybe a
Nothing
}
setStdin
:: (StreamType newStdin)
=> ProcessConf oldStdin stdout stderr
-> newStdin
-> ProcessConf newStdin stdout stderr
setStdin :: 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 :: 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 :: 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
{ Process stdin stdout stderr -> Maybe Handle
procStdin :: Maybe Handle
, Process stdin stdout stderr -> Maybe Handle
procStdout :: Maybe Handle
, Process stdin stdout stderr -> Maybe Handle
procStderr :: Maybe Handle
, Process stdin stdout stderr -> MVar ProcessHandle__
phandle :: !(MVar ProcessHandle__)
, Process stdin stdout stderr -> Bool
mbDelegateCtlc :: !Bool
, Process stdin stdout stderr -> MVar ()
waitpidLock :: !(MVar ())
}
processStdin :: Process CreatePipe stdout stderr -> Handle
processStdin :: 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
..} = Handle -> Maybe Handle -> Handle
forall a. a -> Maybe a -> a
fromMaybe Handle
forall a. a
err Maybe Handle
procStdin
where
err :: a
err = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"This can't happen: stdin is CreatePipe but missing"
processStdout :: Process stdin CreatePipe stderr -> Handle
processStdout :: 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
..} = Handle -> Maybe Handle -> Handle
forall a. a -> Maybe a -> a
fromMaybe Handle
forall a. a
err Maybe Handle
procStdout
where
err :: a
err = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"This can't happen: stdout is CreatePipe but missing"
processStderr :: Process stdin stdout CreatePipe -> Handle
processStderr :: 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
..} = Handle -> Maybe Handle -> Handle
forall a. a -> Maybe a -> a
fromMaybe Handle
forall a. a
err Maybe Handle
procStderr
where
err :: a
err = [Char] -> a
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]
(Int -> CreatePipe -> ShowS)
-> (CreatePipe -> [Char])
-> ([CreatePipe] -> ShowS)
-> Show CreatePipe
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]
(Int -> Inherit -> ShowS)
-> (Inherit -> [Char]) -> ([Inherit] -> ShowS) -> Show Inherit
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]
(Int -> NoStream -> ShowS)
-> (NoStream -> [Char]) -> ([NoStream] -> ShowS) -> Show NoStream
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]
(Int -> UseHandle -> ShowS)
-> (UseHandle -> [Char])
-> ([UseHandle] -> ShowS)
-> Show UseHandle
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 = FD -> c -> IO FD
forall a. HasCallStack => a
undefined
willCreateHandle = c -> Bool
forall a. HasCallStack => a
undefined
{-# MINIMAL #-}
#endif
instance StreamType CreatePipe where
mbFd :: FD -> CreatePipe -> IO FD
mbFd FD
_ CreatePipe
_ = FD -> IO FD
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
_ = FD -> IO FD
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
_ = FD -> IO FD
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) =
[Char] -> Handle -> (Handle__ -> IO (Handle__, FD)) -> IO FD
forall a.
[Char] -> Handle -> (Handle__ -> IO (Handle__, a)) -> IO a
withHandle [Char]
"" Handle
hdl ((Handle__ -> IO (Handle__, FD)) -> IO FD)
-> (Handle__ -> IO (Handle__, FD)) -> IO FD
forall a b. (a -> b) -> a -> b
$ \Handle__{haDevice :: ()
haDevice=dev
dev,Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe TextEncoding
Maybe (MVar Handle__)
HandleType
BufferMode
Newline
IORef (dec_state, Buffer Word8)
IORef (BufferList Char)
IORef (Buffer Char)
IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haLastDecode :: ()
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haBuffers :: Handle__ -> IORef (BufferList Char)
haEncoder :: ()
haDecoder :: ()
haCodec :: Handle__ -> Maybe TextEncoding
haInputNL :: Handle__ -> Newline
haOutputNL :: Handle__ -> Newline
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
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 dev -> Maybe FD
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
(Handle__, FD) -> IO (Handle__, FD)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__ :: forall dev enc_state dec_state.
(IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> HandleType
-> IORef (Buffer Word8)
-> BufferMode
-> IORef (dec_state, Buffer Word8)
-> IORef (Buffer Char)
-> IORef (BufferList Char)
-> Maybe (TextEncoder enc_state)
-> Maybe (TextDecoder dec_state)
-> Maybe TextEncoding
-> Newline
-> Newline
-> Maybe (MVar Handle__)
-> Handle__
Handle__{haDevice :: FD
haDevice=FD
fd',Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe TextEncoding
Maybe (MVar Handle__)
HandleType
BufferMode
Newline
IORef (dec_state, Buffer Word8)
IORef (BufferList Char)
IORef (Buffer Char)
IORef (Buffer Word8)
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer Char)
haBuffers :: IORef (BufferList Char)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
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 -> IOError -> IO (Handle__, FD)
forall a. IOError -> IO a
ioError (IOError -> IO (Handle__, FD)) -> IOError -> IO (Handle__, FD)
forall a b. (a -> b) -> a -> b
$ IOErrorType -> [Char] -> Maybe Handle -> Maybe [Char] -> IOError
mkIOError IOErrorType
illegalOperationErrorType
[Char]
"createProcess" (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
hdl) Maybe [Char]
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 :: Process stdin stdout stderr
-> (ProcessHandle__ -> IO (ProcessHandle__, a)) -> IO a
modifyProcessHandle Process stdin stdout stderr
p = MVar ProcessHandle__
-> (ProcessHandle__ -> IO (ProcessHandle__, a)) -> IO a
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (Process stdin stdout stderr -> MVar ProcessHandle__
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 :: Process stdin stdout stderr -> (ProcessHandle__ -> IO a) -> IO a
withProcessHandle Process stdin stdout stderr
p = MVar ProcessHandle__ -> (ProcessHandle__ -> IO a) -> IO a
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (Process stdin stdout stderr -> MVar ProcessHandle__
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 :: c -> Ptr FD -> IOMode -> IO (Maybe Handle)
mbPipe c
streamConf Ptr FD
pfd IOMode
mode = if c -> Bool
forall c. StreamType c => c -> Bool
willCreateHandle c
streamConf
then (Handle -> Maybe Handle) -> IO Handle -> IO (Maybe Handle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Handle -> Maybe Handle
forall a. a -> Maybe a
Just (Ptr FD -> IOMode -> IO Handle
pfdToHandle Ptr FD
pfd IOMode
mode)
else Maybe Handle -> IO (Maybe Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Handle
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 <- Ptr FD -> IO FD
forall a. Storable a => Ptr a -> IO a
peek Ptr FD
pfd
let filepath :: [Char]
filepath = [Char]
"fd:" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FD -> [Char]
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 (FD -> FD
forall a b. (Integral a, Num b) => a -> b
fromIntegral FD
fd) IOMode
mode
((IODeviceType, CDev, CIno) -> Maybe (IODeviceType, CDev, CIno)
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 (TextEncoding -> Maybe TextEncoding
forall a. a -> Maybe a
Just TextEncoding
enc)