From 6edeb752c80bb4a9cd7e27672f773fe3d66b2039 Mon Sep 17 00:00:00 2001 From: tv Date: Mon, 9 Feb 2026 03:48:15 +0100 Subject: initial commit --- Process.hs | 52 ++++++++++++++++++++++++++++++++++++++++++++++++ process-supervisor.cabal | 21 +++++++++++++++++++ 2 files changed, 73 insertions(+) create mode 100644 Process.hs create mode 100644 process-supervisor.cabal diff --git a/Process.hs b/Process.hs new file mode 100644 index 0000000..e4f55d1 --- /dev/null +++ b/Process.hs @@ -0,0 +1,52 @@ +module Process (mkProcess) where + +import Control.Concurrent.Async (async, cancel) +import Control.Concurrent.Chan.Unagi (newChan, readChan, writeChan) +import Control.Exception (IOException) +import Control.Monad (forever, unless) +import Data.Bifunctor (bimap) +import Data.ByteString (ByteString) +import Data.ByteString.Char8 qualified as BS8 +import System.IO (hClose, hIsEOF) +import System.Process qualified as P + +mkProcess :: FilePath -> [String] -> IO (IO (Either IOException ByteString), IO ()) +mkProcess prog args = do + (Just hin, Just hout, Just herr, ph) <- + P.createProcess (P.proc prog args) + { P.std_in = P.CreatePipe + , P.std_out = P.CreatePipe + , P.std_err = P.CreatePipe + } + + (putOutput, takeOutput) <- bimap writeChan readChan <$> newChan + + let reader h = forever do + eof <- hIsEOF h + unless eof do + BS8.hGetLine h >>= putOutput -- TODO mark as stdout/stderr + + outReader <- async (reader hout) + errReader <- async (reader herr) + + let + -- normal termination path: wait for process, then kill readers + waitProcessAndReaders = do + _ <- P.waitForProcess ph + shutdown + --cancel outReader + --cancel errReader + + -- explicit shutdown: kill everything + shutdown = do + P.terminateProcess ph + cancel outReader + cancel errReader + hClose hin + hClose hout + hClose herr + + -- optionally run waitProcessAndReaders in background: + _ <- async waitProcessAndReaders + + pure (Right <$> takeOutput, shutdown) diff --git a/process-supervisor.cabal b/process-supervisor.cabal new file mode 100644 index 0000000..dd53ba6 --- /dev/null +++ b/process-supervisor.cabal @@ -0,0 +1,21 @@ +cabal-version: 3.0 +name: process-supervisor +version: 1.0.0.0 +license: MIT +author: tv +maintainer: tv@krebsco.de +build-type: Simple + +library + build-depends: + base + , async + , bytestring + , process + , unagi-chan + default-extensions: + BlockArguments + default-language: GHC2024 + exposed-modules: + Process + ghc-options: -Wall -Wextra -- cgit v1.2.3