diff options
Diffstat (limited to 'src/Process.hs')
-rw-r--r-- | src/Process.hs | 29 |
1 files changed, 28 insertions, 1 deletions
diff --git a/src/Process.hs b/src/Process.hs index 958910d..bb33953 100644 --- a/src/Process.hs +++ b/src/Process.hs @@ -3,19 +3,25 @@ module Process ( ProcName(..), textProcName, unpackProcName, send, + outProc, + closeProcess, ) where import Control.Concurrent.STM -import Control.Monad.IO.Class +import Control.Monad.Except +import Data.Function import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T +import System.Exit import System.IO import System.Posix.Signals import System.Process +import Output + data Process = Process { procName :: ProcName , procHandle :: ProcessHandle @@ -24,6 +30,9 @@ data Process = Process , procKillWith :: Maybe Signal } +instance Eq Process where + (==) = (==) `on` procStdin + data ProcName = ProcName Text | ProcNameTcpdump | ProcNameGDB @@ -41,3 +50,21 @@ send :: MonadIO m => Process -> Text -> m () send p line = liftIO $ do T.hPutStrLn (procStdin p) line hFlush (procStdin p) + +outProc :: MonadOutput m => OutputType -> Process -> Text -> m () +outProc otype p line = outLine otype (textProcName $ procName p) line + +closeProcess :: (MonadIO m, MonadOutput m, MonadError () m) => Process -> m () +closeProcess p = do + liftIO $ hClose $ procStdin p + case procKillWith p of + Nothing -> return () + Just sig -> liftIO $ getPid (procHandle p) >>= \case + Nothing -> return () + Just pid -> signalProcess sig pid + + liftIO (waitForProcess (procHandle p)) >>= \case + ExitSuccess -> return () + ExitFailure code -> do + outProc OutputChildFail p $ T.pack $ "exit code: " ++ show code + throwError () |