content: -- | Run a single process and provide a live view of its output and termination.
  module Cabal.Matrix.ProcessRunner
    ( startProcess
    , ProcessMessage(..)
    , OutputChannel(..)
    , ProcessHandle
    , signalProcess
    , ProcessSignal(..)
    ) where
  
  import Control.Concurrent
  import Control.Exception.Safe
  import Control.Monad
  import Data.Aeson (FromJSON, ToJSON)
  import Data.Aeson qualified as Aeson
  import Data.ByteString (ByteString)
  import Data.ByteString qualified as ByteString
  import Data.Foldable
  import Data.List.NonEmpty (NonEmpty(..))
  import Data.Text (Text)
  import Data.Text qualified as Text
  import GHC.Generics
  import System.Exit
  import System.IO
  import System.Process qualified as Process
  
  
  data OutputChannel = Stdout | Stderr
    deriving stock (Eq, Show, Generic)
  
  instance ToJSON OutputChannel where
    toJSON = \case
      Stdout -> "stdout"
      Stderr -> "stderr"
  
  instance FromJSON OutputChannel where
    parseJSON = Aeson.withText "OutputChannel" \case
      "stdout" -> pure Stdout
      "stderr" -> pure Stderr
      v -> fail $ "Unexpected value: " <> show v
  
  
  data ProcessMessage
    = OnProcessOutput OutputChannel ByteString
      -- ^ Note: Always sequenced before 'OnChannelClosed', but may be sequenced
      -- after 'OnProcessExit'.
    | OnChannelClosed OutputChannel
      -- ^ Note: may be sequenced after 'OnProcessExit'.
    | OnProcessExit ExitCode
  
  data ProcessSignal
    = SignalInterrupt
      -- ^ Attempt to interrupt the process with @SIGINT@.
    | SignalTerminate
      -- ^ Attempt to interrupt the process with @SIGTERM@.
  
  newtype ProcessHandle = ProcessHandle Process.ProcessHandle
  
  -- | Start a process with the given commandline arguments in the background.
  -- The provided callback will be called (from other threads) when things happen
  -- to the process.
  --
  -- Note: if the current program should be compiled with @-threaded@, see
  -- 'Process.waitForProcess'.
  --
  -- A process can be considered finished and its resources cleaned up after
  -- receiving all three of @'OnChannelClosed' 'Stdout'@,
  -- @'OnChannelClosed' 'Stderr'@, and 'OnProcessExit'.
  startProcess :: NonEmpty Text -> (ProcessMessage -> IO ()) -> IO ProcessHandle
  startProcess cmdline cb = mask_ do
    (_mIn, mOut, mErr, processHdl) <- Process.createProcess
      case Text.unpack <$> cmdline of
        cmd :| args -> (Process.proc cmd args)
          { Process.std_out = Process.CreatePipe
          , Process.std_err = Process.CreatePipe
          }
    _ <- forkIOWithUnmask \unmask -> do
      for_ mOut (\out -> unmask $ readLoop out Stdout)
        `finally` cb (OnChannelClosed Stdout)
    _ <- forkIOWithUnmask \unmask -> do
      for_ mErr (\err -> unmask $ readLoop err Stderr)
        `finally` cb (OnChannelClosed Stderr)
    _ <- forkIOWithUnmask \unmask -> do
      unmask (Process.waitForProcess processHdl >>= cb . OnProcessExit)
        `onException` Process.terminateProcess processHdl
    pure $ ProcessHandle processHdl
    where
      readLoop :: Handle -> OutputChannel -> IO ()
      readLoop hdl chan = do
        bs <- ByteString.hGetSome hdl 0x10000
        unless (ByteString.null bs) do
          cb $ OnProcessOutput chan bs
          readLoop hdl chan
  
  -- | Send a signal to the process.
  signalProcess :: ProcessHandle -> ProcessSignal -> IO ()
  signalProcess (ProcessHandle processHdl) = \case
    SignalInterrupt -> Process.interruptProcessGroupOf processHdl
    SignalTerminate -> Process.terminateProcess processHdl
  
  
  