-- SPDX-FileCopyrightText: 2026 Alexandra de Wit
--
-- SPDX-License-Identifier: MIT

{- | The typed process perimeter behind 'Ecluse.Startup.runWith': how one service run ends, the
status it exits with, and what it reports on the way out. "Ecluse" keeps only the entry point in its
public contract, so this is the only module exporting the perimeter, for the composition root and
for the specs that classify an ending directly. Importing it opts out of that contract's stability
promise, as @text@ does.
-}
module Ecluse.Internal (
    ProcessOutcome (..),
    superviseProcess,
    exitCodeFor,
    exitReasonFor,
) where

import Control.Exception (AsyncException (ThreadKilled, UserInterrupt), SomeAsyncException)
import Control.Exception qualified as Exception
import System.Exit (ExitCode (ExitFailure, ExitSuccess))

import Ecluse.Boot (BootAborted (BootAborted))
import Ecluse.Core.Text (displayExceptionT)

{- | How one whole service run ended. Each constructor owns one exit code ('exitCodeFor'), so
an orchestrator reads the ending from the status alone.
-}
data ProcessOutcome
    = -- | The services drained and returned (a graceful shutdown): exit 0.
      ShutdownRequested
    | -- | A service failed up with the carried rendered fault: exit 1.
      ServiceExited Text
    | -- | The boot aborted ('BootAborted') with the carried rendered refusal: exit 2.
      BootFault Text
    | -- | The run was cancelled from outside (a kill, an interrupt): exit 3.
      RunCancelled
    deriving stock (ProcessOutcome -> ProcessOutcome -> Bool
(ProcessOutcome -> ProcessOutcome -> Bool)
-> (ProcessOutcome -> ProcessOutcome -> Bool) -> Eq ProcessOutcome
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProcessOutcome -> ProcessOutcome -> Bool
== :: ProcessOutcome -> ProcessOutcome -> Bool
$c/= :: ProcessOutcome -> ProcessOutcome -> Bool
/= :: ProcessOutcome -> ProcessOutcome -> Bool
Eq, Int -> ProcessOutcome -> ShowS
[ProcessOutcome] -> ShowS
ProcessOutcome -> String
(Int -> ProcessOutcome -> ShowS)
-> (ProcessOutcome -> String)
-> ([ProcessOutcome] -> ShowS)
-> Show ProcessOutcome
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProcessOutcome -> ShowS
showsPrec :: Int -> ProcessOutcome -> ShowS
$cshow :: ProcessOutcome -> String
show :: ProcessOutcome -> String
$cshowList :: [ProcessOutcome] -> ShowS
showList :: [ProcessOutcome] -> ShowS
Show)

{- | Run the service under the typed process perimeter and classify its ending. The base
'Exception.try' and 'Exception.throwIO' are deliberate: what leaves here async must leave async.
-}
superviseProcess :: IO ProcessOutcome -> IO ProcessOutcome
superviseProcess :: IO ProcessOutcome -> IO ProcessOutcome
superviseProcess IO ProcessOutcome
service =
    IO ProcessOutcome -> IO (Either SomeException ProcessOutcome)
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try IO ProcessOutcome
service IO (Either SomeException ProcessOutcome)
-> (Either SomeException ProcessOutcome -> IO ProcessOutcome)
-> IO ProcessOutcome
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right ProcessOutcome
outcome -> ProcessOutcome -> IO ProcessOutcome
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProcessOutcome
outcome
        Left SomeException
err
            | Just (BootAborted Text
rendered) <- SomeException -> Maybe BootAborted
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err -> ProcessOutcome -> IO ProcessOutcome
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ProcessOutcome
BootFault Text
rendered)
            | Just (ExitCode
code :: ExitCode) <- SomeException -> Maybe ExitCode
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err -> ExitCode -> IO ProcessOutcome
forall e a. (HasCallStack, Exception e) => e -> IO a
Exception.throwIO ExitCode
code
            | Just (AsyncException
killed :: AsyncException) <- SomeException -> Maybe AsyncException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err ->
                ProcessOutcome -> IO ProcessOutcome
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProcessOutcome -> IO ProcessOutcome)
-> ProcessOutcome -> IO ProcessOutcome
forall a b. (a -> b) -> a -> b
$ case AsyncException
killed of
                    AsyncException
ThreadKilled -> ProcessOutcome
RunCancelled
                    AsyncException
UserInterrupt -> ProcessOutcome
RunCancelled
                    -- StackOverflow / HeapOverflow: resource exhaustion is a
                    -- fault of the run, not a cancellation.
                    AsyncException
other -> Text -> ProcessOutcome
ServiceExited (AsyncException -> Text
forall e. Exception e => e -> Text
displayExceptionT AsyncException
other)
            | Just (SomeAsyncException
_ :: SomeAsyncException) <- SomeException -> Maybe SomeAsyncException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err -> SomeException -> IO ProcessOutcome
forall e a. (HasCallStack, Exception e) => e -> IO a
Exception.throwIO SomeException
err
            | Bool
otherwise -> ProcessOutcome -> IO ProcessOutcome
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ProcessOutcome
ServiceExited (SomeException -> Text
forall e. Exception e => e -> Text
displayExceptionT SomeException
err))

{- How a run ends. A failing status is representable only beside the reason it reports, so
'Ecluse.Startup.runWith' cannot exit non-zero in silence. -}
data ProcessExit
    = ExitedCleanly
    | ExitedWith ExitCode Text

-- The status and the report one outcome owns. Both 'exitCodeFor' and 'exitReasonFor' read it.
processExitFor :: ProcessOutcome -> ProcessExit
processExitFor :: ProcessOutcome -> ProcessExit
processExitFor = \case
    ProcessOutcome
ShutdownRequested -> ProcessExit
ExitedCleanly
    ServiceExited Text
detail -> ExitCode -> Text -> ProcessExit
ExitedWith (Int -> ExitCode
ExitFailure Int
1) (Text
"ecluse: service exited: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
detail)
    -- The boot phase rendered the whole aggregated block, which reports here unprefixed.
    BootFault Text
rendered -> ExitCode -> Text -> ProcessExit
ExitedWith (Int -> ExitCode
ExitFailure Int
2) Text
rendered
    ProcessOutcome
RunCancelled -> ExitCode -> Text -> ProcessExit
ExitedWith (Int -> ExitCode
ExitFailure Int
3) Text
"ecluse: run cancelled"

-- | The process exit status each 'ProcessOutcome' owns.
exitCodeFor :: ProcessOutcome -> ExitCode
exitCodeFor :: ProcessOutcome -> ExitCode
exitCodeFor ProcessOutcome
outcome = case ProcessOutcome -> ProcessExit
processExitFor ProcessOutcome
outcome of
    ProcessExit
ExitedCleanly -> ExitCode
ExitSuccess
    ExitedWith ExitCode
code Text
_ -> ExitCode
code

-- | What an outcome reports before exiting. A graceful shutdown alone has nothing to say.
exitReasonFor :: ProcessOutcome -> Maybe Text
exitReasonFor :: ProcessOutcome -> Maybe Text
exitReasonFor ProcessOutcome
outcome = case ProcessOutcome -> ProcessExit
processExitFor ProcessOutcome
outcome of
    ProcessExit
ExitedCleanly -> Maybe Text
forall a. Maybe a
Nothing
    ExitedWith ExitCode
_ Text
reason -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
reason