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

{- | The local-development immediate-halt wiring: an interactive session's
"quit now" key, inert outside a terminal. "Ecluse.Runtime.Server"'s 'runWarp'
wraps the whole run in 'withInteractiveHalt'.
-}
module Ecluse.Runtime.Server.Halt (
    InteractiveHalt (..),
    defaultInteractiveHalt,
    withInteractiveHalt,
) where

import System.Exit (ExitCode (ExitFailure))
import System.IO (hIsTerminalDevice, isEOF)
import System.Posix.Process (exitImmediately)
import UnliftIO.Async (withAsync)

{- | The local-development immediate-halt wiring, as injection points a test drives without
a terminal. Ctrl-D exits the process at once and aborts the drain. It is inert on a non-TTY.
-}
data InteractiveHalt = InteractiveHalt
    { InteractiveHalt -> IO Bool
haltOnInteractive :: IO Bool
    -- ^ Whether to arm the halt. A non-interactive process never installs the watcher.
    , InteractiveHalt -> IO ()
awaitHaltSignal :: IO ()
    {- ^ Block until the dev's halt signal. The real wiring reads standard input
    until end-of-input (Ctrl-D). It returns when the watcher should fire.
    -}
    , InteractiveHalt -> IO ()
halt :: IO ()
    {- ^ Stop the process immediately, bypassing the drain wait. The real wiring is a direct
    @_exit@ ('exitImmediately').
    -}
    }

{- | The real local-dev halt: armed only on a terminal and fired by end-of-input, exiting at
once without a drain. Status 130 is the conventional "terminated from the terminal" code.
-}
defaultInteractiveHalt :: InteractiveHalt
defaultInteractiveHalt :: InteractiveHalt
defaultInteractiveHalt =
    InteractiveHalt
        { haltOnInteractive :: IO Bool
haltOnInteractive = Handle -> IO Bool
hIsTerminalDevice Handle
stdin
        , awaitHaltSignal :: IO ()
awaitHaltSignal = IO ()
awaitStdinEof
        , halt :: IO ()
halt = ExitCode -> IO ()
forall a. ExitCode -> IO a
exitImmediately (Int -> ExitCode
ExitFailure Int
130)
        }

-- On a terminal, end-of-input arrives when the dev presses Ctrl-D.
awaitStdinEof :: IO ()
awaitStdinEof :: IO ()
awaitStdinEof =
    IO Bool
isEOF IO Bool -> (Bool -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
True -> IO ()
forall (f :: * -> *). Applicative f => f ()
pass
        Bool
False -> IO Text -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void IO Text
forall (m :: * -> *). MonadIO m => m Text
getLine IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
awaitStdinEof

{- | Run an action with the immediate-halt watcher armed only when 'haltOnInteractive' is
'True'. The watcher lives exactly as long as the action, so it never outlives it.
-}
withInteractiveHalt :: InteractiveHalt -> IO a -> IO a
withInteractiveHalt :: forall a. InteractiveHalt -> IO a -> IO a
withInteractiveHalt InteractiveHalt
ih IO a
action =
    InteractiveHalt -> IO Bool
haltOnInteractive InteractiveHalt
ih IO Bool -> (Bool -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
False -> IO a
action
        Bool
True -> IO () -> (Async () -> IO a) -> IO a
forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> (Async a -> m b) -> m b
withAsync (InteractiveHalt -> IO ()
awaitHaltSignal InteractiveHalt
ih IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> InteractiveHalt -> IO ()
halt InteractiveHalt
ih) (IO a -> Async () -> IO a
forall a b. a -> b -> a
const IO a
action)