2 files changed, 73 insertions, 0 deletions
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