{-# LANGUAGE OverloadedStrings #-}

-- | Generic agent seat loop for the free-agent bus.
--
-- Watches ROOT/log.jsonl for posts addressed to NAME(s), calls the supplied
-- handler for each post, and writes the returned replies back through the
-- in-process bus with the cursor advanced. This is the common runtime shared
-- by the Hermes, Kimi, direct-API, and external-command seats.
module Free.Agent.Agent.Runner
  ( runAgentLoop,
  )
where

import Circuit.Agent (Name, Post (..), mkPost)
import Circuit.Agent.Framing (Stamped, stamp, stamped)
import Circuit.Agent.Mark (Mark (..), isEscalate, isHalt, markGlyph, markOf)
import Control.Exception (SomeException, displayException, try)
import Data.Foldable (forM_, traverse_)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.IO qualified as TIO
import Free.Agent.Bus (postLocal)
import Free.Agent.Bus.File
  ( Flow (..),
    QuiesceConfig (..),
    cursorPath,
    readCursor,
    tailLog,
    writeCursor,
  )
import System.FilePath ((</>))
import System.IO (BufferMode (LineBuffering), hPutStrLn, hSetBuffering, stderr, stdout)
import System.Posix.Process (getProcessID)

-- | Start a seat loop.
--
-- The caller supplies the subscription names, the bus root, an optional
-- quiescence config, and a handler that turns one incoming 'Stamped Text' into
-- zero or more reply posts. The handler is responsible for decoration,
-- scrubbing, routing, and filtering; this function handles the bus plumbing.
--
-- Decided quiet: a delivered post carrying a halt mark (🟢 or 🔵) stops the
-- loop; an escalation mark (🔴) is relayed to the pitboss (when a quiescence
-- config names one) and also stops the loop. The quiescence counter is the
-- observed-quiet bridge: after N empty cycles the seat posts 🔵 to the
-- pitboss and exits.
--
-- Self-halt: a 🔵 reply is the seat deciding its own quiet — the loop stops
-- after scribing it. The F2 self-post skip means the seat never reads its
-- own mark back, so the halt is judged here, at commit time. 🟢 stays
-- exchange-level: a seat may land one exchange and host more.
runAgentLoop ::
  -- | Agent name used for cursor and logging.
  Text ->
  -- | Subscription names.
  [Name] ->
  -- | Bus root.
  FilePath ->
  -- | Optional quiescence config.
  Maybe QuiesceConfig ->
  -- | Handler: incoming post -> reply posts.
  (Stamped Text -> IO [Post Text]) ->
  IO ()
runAgentLoop :: Text
-> [Text]
-> [Char]
-> Maybe QuiesceConfig
-> (Stamped Text -> IO [Post Text])
-> IO ()
runAgentLoop Text
agentName [Text]
names [Char]
root Maybe QuiesceConfig
mQuiesce Stamped Text -> IO [Post Text]
handlePost = do
  Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
LineBuffering
  pid <- IO ProcessID
getProcessID
  TIO.putStrLn $ "🟢 free-agent seat starting: " <> T.intercalate "," names <> " (pid=" <> T.pack (show pid) <> ")"
  TIO.putStrLn $ "   root: " <> T.pack root
  let path = [Char]
root [Char] -> [Char] -> [Char]
</> [Char]
"log.jsonl"
      onQuiesce = do
        let qc :: QuiesceConfig
qc = QuiesceConfig -> Maybe QuiesceConfig -> QuiesceConfig
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> QuiesceConfig
forall a. HasCallStack => [Char] -> a
error [Char]
"quiesce action without config") Maybe QuiesceConfig
mQuiesce
            p :: Post Text
p = Text -> [Text] -> Text -> Post Text
forall a. Text -> [Text] -> a -> Post a
mkPost Text
agentName [QuiesceConfig -> Text
qcPitboss QuiesceConfig
qc] (Mark -> Text
markGlyph Mark
StandDown Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" standing down after " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show (QuiesceConfig -> Int
qcCycles QuiesceConfig
qc)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" empty cycles")
        _ <- [Char] -> Post Text -> IO (Stamped Text)
forall a. PostBody a => [Char] -> Post a -> IO (Stamped a)
postLocal [Char]
root Post Text
p
        pure ()
      -- A mark is control, not content: halt and escalation marks are not
      -- handed to the seat handler. Silence follows the mark.
      controlFlow Stamped Text
stored =
        case Post Text -> Maybe Mark
markOf (Stamped Text -> Post Text
forall r a. Stamped r a -> a
stamped Stamped Text
stored) of
          Just Mark
m
            | Mark -> Bool
isHalt Mark
m -> Maybe Flow -> IO (Maybe Flow)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Flow -> Maybe Flow
forall a. a -> Maybe a
Just Flow
Halt)
            | Mark -> Bool
isEscalate Mark
m -> do
                Maybe QuiesceConfig
-> (QuiesceConfig -> IO (Stamped Text)) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe QuiesceConfig
mQuiesce ((QuiesceConfig -> IO (Stamped Text)) -> IO ())
-> (QuiesceConfig -> IO (Stamped Text)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \QuiesceConfig
qc ->
                  [Char] -> Post Text -> IO (Stamped Text)
forall a. PostBody a => [Char] -> Post a -> IO (Stamped a)
postLocal [Char]
root (Text -> [Text] -> Text -> Post Text
forall a. Text -> [Text] -> a -> Post a
mkPost Text
agentName [QuiesceConfig -> Text
qcPitboss QuiesceConfig
qc] (Mark -> Text
markGlyph Mark
Escalate Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" escalation received; standing down"))
                Maybe Flow -> IO (Maybe Flow)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Flow -> Maybe Flow
forall a. a -> Maybe a
Just Flow
Halt)
          Maybe Mark
_ -> Maybe Flow -> IO (Maybe Flow)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Flow
forall a. Maybe a
Nothing
  cursor <- readCursor root agentName
  TIO.putStrLn $ "   cursor: " <> T.pack (cursorPath root agentName) <> " @ " <> T.pack (show cursor)
  tailLog path names cursor (fmap (\QuiesceConfig
qc -> (QuiesceConfig
qc, IO ()
onQuiesce)) mQuiesce) $ \Stamped Text
stored ->
    Stamped Text -> IO (Maybe Flow)
controlFlow Stamped Text
stored IO (Maybe Flow) -> (Maybe Flow -> IO Flow) -> IO Flow
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just Flow
flow -> do
        [Char] -> Text -> PostId -> IO ()
writeCursor [Char]
root Text
agentName ((UTCTime, PostId) -> PostId
forall a b. (a, b) -> b
snd (Stamped Text -> (UTCTime, PostId)
forall r a. Stamped r a -> r
stamp Stamped Text
stored) PostId -> PostId -> PostId
forall a. Num a => a -> a -> a
+ PostId
1)
        Flow -> IO Flow
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Flow
flow
      Maybe Flow
Nothing -> do
        -- F2: skip self-posts — an agent should never receive its own posts
        if Post Text -> Text
forall a. Post a -> Text
from (Stamped Text -> Post Text
forall r a. Stamped r a -> a
stamped Stamped Text
stored) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
agentName
          then do
            [Char] -> Text -> PostId -> IO ()
writeCursor [Char]
root Text
agentName ((UTCTime, PostId) -> PostId
forall a b. (a, b) -> b
snd (Stamped Text -> (UTCTime, PostId)
forall r a. Stamped r a -> r
stamp Stamped Text
stored) PostId -> PostId -> PostId
forall a. Num a => a -> a -> a
+ PostId
1)
            Flow -> IO Flow
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Flow
Continue
          else do
            ereplies <- forall e a. Exception e => IO a -> IO (Either e a)
try @SomeException (Stamped Text -> IO [Post Text]
handlePost Stamped Text
stored)
            flow <- case ereplies of
              Left SomeException
e -> do
                let p :: Post Text
p = Stamped Text -> Post Text
forall r a. Stamped r a -> a
stamped Stamped Text
stored
                    exc :: Text
exc = [Char] -> Text
T.pack (SomeException -> [Char]
forall e. Exception e => e -> [Char]
displayException SomeException
e)
                    recipients :: [Text]
recipients = Post Text -> Text
forall a. Post a -> Text
from Post Text
p Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
-> (QuiesceConfig -> [Text]) -> Maybe QuiesceConfig -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Text -> [Text]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Text])
-> (QuiesceConfig -> Text) -> QuiesceConfig -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuiesceConfig -> Text
qcPitboss) Maybe QuiesceConfig
mQuiesce
                Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
                  [Char]
"🔴 "
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
agentName
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" handler failed on post "
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PostId -> [Char]
forall a. Show a => a -> [Char]
show ((UTCTime, PostId) -> PostId
forall a b. (a, b) -> b
snd (Stamped Text -> (UTCTime, PostId)
forall r a. Stamped r a -> r
stamp Stamped Text
stored))
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": "
                    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
exc
                _ <-
                  [Char] -> Post Text -> IO (Stamped Text)
forall a. PostBody a => [Char] -> Post a -> IO (Stamped a)
postLocal [Char]
root (Post Text -> IO (Stamped Text)) -> Post Text -> IO (Stamped Text)
forall a b. (a -> b) -> a -> b
$
                    Text -> [Text] -> Text -> Post Text
forall a. Text -> [Text] -> a -> Post a
mkPost Text
agentName [Text]
recipients (Mark -> Text
markGlyph Mark
Escalate Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" handler failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
exc)
                -- handler failure: cursor advanced, seat keeps listening
                pure Continue
              Right [Post Text]
replies -> do
                let keep :: Post Text -> Bool
keep Post Text
p =
                      let b :: Text
b = Text -> Text
T.strip (Post Text -> Text
forall a. Post a -> a
body Post Text
p)
                       in Bool -> Bool
not (Text -> Bool
T.null Text
b) Bool -> Bool -> Bool
&& Text
b Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"(empty)"
                    nonEmpty :: [Post Text]
nonEmpty = (Post Text -> Bool) -> [Post Text] -> [Post Text]
forall a. (a -> Bool) -> [a] -> [a]
filter Post Text -> Bool
keep [Post Text]
replies
                (Post Text -> IO (Stamped Text)) -> [Post Text] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ([Char] -> Post Text -> IO (Stamped Text)
forall a. PostBody a => [Char] -> Post a -> IO (Stamped a)
postLocal [Char]
root) [Post Text]
nonEmpty
                -- Self-halt: the seat's own 🔵, judged at commit time.
                Flow -> IO Flow
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Flow -> IO Flow) -> Flow -> IO Flow
forall a b. (a -> b) -> a -> b
$
                  if (Post Text -> Bool) -> [Post Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Maybe Mark -> Maybe Mark -> Bool
forall a. Eq a => a -> a -> Bool
== Mark -> Maybe Mark
forall a. a -> Maybe a
Just Mark
StandDown) (Maybe Mark -> Bool)
-> (Post Text -> Maybe Mark) -> Post Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Post Text -> Maybe Mark
markOf) [Post Text]
replies
                    then Flow
Halt
                    else Flow
Continue
            writeCursor root agentName (snd (stamp stored) + 1)
            pure flow