{-# LANGUAGE OverloadedStrings #-}

-- | Generic query-to-shard adapters.
--
-- Turns any @Text -> IO Text@ boundary into a 'Shard' that consumes addressed
-- posts and emits reply posts.  The functions here know nothing about external
-- CLI processes, session files, or concrete binaries — that operational layer
-- lives in @Free.Agent.Cli@.
module Circuit.Agent.Query
  ( -- * Session assembly and reply building
    sessionPrompt,
    replyPosts,
    synthesisPosts,

    -- * Shard adapters
    queryShard,
    queryShardWith,
    synthShard,
    echoShard,
    runShardIO,
  )
where

import Circuit.Agent (Poles (..), Post (..), PostId, Shard, close, mkPost, replyTo, shard, sortNub, synthesis)
import Circuit.Category (K (..))
import Data.IORef (atomicModifyIORef', newIORef, writeIORef)
import Data.Maybe (listToMaybe)
import Data.Text (Text)
import Data.Text qualified as T

-- | Session assembly for the opaque seat: bodies, oldest-first, one per line.
--
-- This is the discoverable side of the boundary (data).  How the query folds
-- it is not.
sessionPrompt :: [Post Text] -> Text
sessionPrompt :: [Post Text] -> Text
sessionPrompt = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> ([Post Text] -> [Text]) -> [Post Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Post Text -> Text) -> [Post Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Post Text -> Text
forall a. Post a -> a
body

-- | Build reply posts from a cleaned agent response.
--
-- Addresses the last input's sender, preserves any other names on the
-- original wire (e.g. the bus channel), and threads onto the last input's
-- 'PostId' when one is supplied.  Empty reply → no posts (quiet).
--
-- The caller passes one 'PostId' per input post in the same order.  If the
-- ids are missing or misaligned, the reply is still addressed correctly but
-- carries no thread edge (see 'mkPost') — the honest fallback when a shard
-- does not have access to the stamped log.
replyPosts :: Text -> [Post Text] -> [PostId] -> Text -> [Post Text]
replyPosts :: Text -> [Post Text] -> [PostId] -> Text -> [Post Text]
replyPosts Text
who [Post Text]
ins [PostId]
ids Text
reply =
  case ([Post Text] -> Maybe (Post Text)
forall a. [a] -> Maybe a
listToMaybe ([Post Text] -> [Post Text]
forall a. [a] -> [a]
reverse [Post Text]
ins), Text -> Text
T.strip Text
reply) of
    (Maybe (Post Text)
_, Text
r) | Text -> Bool
T.null Text
r -> []
    (Maybe (Post Text)
Nothing, Text
_) -> []
    (Just Post Text
lastIn, Text
r) ->
      let to' :: [Text]
to' = Post Text -> Text
forall a. Post a -> Text
from Post Text
lastIn Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
who) (Post Text -> [Text]
forall a. Post a -> [Text]
to Post Text
lastIn)
       in case [PostId] -> Maybe PostId
forall a. [a] -> Maybe a
listToMaybe ([PostId] -> [PostId]
forall a. [a] -> [a]
reverse [PostId]
ids) of
            Just PostId
parentId -> [Text -> PostId -> Post Text -> Text -> Post Text
forall a b. Text -> PostId -> Post a -> b -> Post b
replyTo Text
who PostId
parentId Post Text
lastIn Text
r]
            Maybe PostId
Nothing -> [Text -> [Text] -> Text -> Post Text
forall a. Text -> [Text] -> a -> Post a
mkPost Text
who [Text]
to' Text
r]

-- | Build one synthesis post from a cleaned agent response.
--
-- The honest twin of 'replyPosts' for seats that fold /every/ input into
-- their answer: ancestry cites every input's 'PostId' (see 'synthesis'),
-- and the audience is every input's sender and wire name, minus self.
-- Empty reply or no inputs → no posts (quiet).
--
-- The caller passes one 'PostId' per input post.  If ids are missing the
-- synthesis is still addressed correctly but carries no thread edge.
synthesisPosts :: Text -> [Post Text] -> [PostId] -> Text -> [Post Text]
synthesisPosts :: Text -> [Post Text] -> [PostId] -> Text -> [Post Text]
synthesisPosts Text
who [Post Text]
ins [PostId]
ids Text
reply =
  case ([Post Text]
ins, Text -> Text
T.strip Text
reply) of
    ([Post Text]
_, Text
r) | Text -> Bool
T.null Text
r -> []
    ([], Text
_) -> []
    ([Post Text]
_, Text
r) ->
      let audience :: [Text]
audience = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
who) ([Text] -> [Text]
forall a. Ord a => [a] -> [a]
sortNub ((Post Text -> [Text]) -> [Post Text] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Post Text
p -> Post Text -> Text
forall a. Post a -> Text
from Post Text
p Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Post Text -> [Text]
forall a. Post a -> [Text]
to Post Text
p) [Post Text]
ins))
          parentIds :: [PostId]
parentIds = Int -> [PostId] -> [PostId]
forall a. Int -> [a] -> [a]
take ([Post Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Post Text]
ins) [PostId]
ids
       in [if [PostId] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PostId]
parentIds then Text -> [Text] -> Text -> Post Text
forall a. Text -> [Text] -> a -> Post a
mkPost Text
who [Text]
audience Text
r else Text -> [Text] -> [PostId] -> Text -> Post Text
forall b. Text -> [Text] -> [PostId] -> b -> Post b
synthesis Text
who [Text]
audience [PostId]
parentIds Text
r]

-- | Opaque evaluate seat: any @Text -> IO Text@ behind list ends.
--
-- Commit assembles a session prompt from the input posts; emit is
-- 'replyPosts' of the query result (empty = quiet).
--
-- TODO: this generic seat does not have access to stamped log ids, so
-- emitted replies carry no thread edge.  Callers that need provenance
-- should use a variant that supplies parent ids.
queryShard :: Text -> (Text -> IO Text) -> IO (Shard IO [Post Text] [Post Text])
queryShard :: Text -> (Text -> IO Text) -> IO (Shard IO [Post Text] [Post Text])
queryShard = (Text -> [Post Text] -> [PostId] -> Text -> [Post Text])
-> Text
-> (Text -> IO Text)
-> IO (Shard IO [Post Text] [Post Text])
queryShardWith Text -> [Post Text] -> [PostId] -> Text -> [Post Text]
replyPosts

-- | Opaque synthesis seat: like 'queryShard', but the emit cites every
-- input's sender as ancestry ('synthesisPosts').  For seats that fold the
-- whole input into one answer — the honest-provenance twin of
-- 'queryShard'.
--
-- TODO: like 'queryShard', the generic seat has no ids and therefore emits
-- syntheses without thread edges.
synthShard :: Text -> (Text -> IO Text) -> IO (Shard IO [Post Text] [Post Text])
synthShard :: Text -> (Text -> IO Text) -> IO (Shard IO [Post Text] [Post Text])
synthShard = (Text -> [Post Text] -> [PostId] -> Text -> [Post Text])
-> Text
-> (Text -> IO Text)
-> IO (Shard IO [Post Text] [Post Text])
queryShardWith Text -> [Post Text] -> [PostId] -> Text -> [Post Text]
synthesisPosts

-- | 'queryShard' parameterised on the reply-to-posts builder.
queryShardWith ::
  (Text -> [Post Text] -> [PostId] -> Text -> [Post Text]) ->
  Text ->
  (Text -> IO Text) ->
  IO (Shard IO [Post Text] [Post Text])
queryShardWith :: (Text -> [Post Text] -> [PostId] -> Text -> [Post Text])
-> Text
-> (Text -> IO Text)
-> IO (Shard IO [Post Text] [Post Text])
queryShardWith Text -> [Post Text] -> [PostId] -> Text -> [Post Text]
posts Text
who Text -> IO Text
query = do
  outbox <- [Post Text] -> IO (IORef [Post Text])
forall a. a -> IO (IORef a)
newIORef []
  pure $
    shard
      ( \[Post Text]
ins ->
          if [Post Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Post Text]
ins
            then IORef [Post Text] -> [Post Text] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [Post Text]
outbox []
            else do
              reply <- Text -> IO Text
query ([Post Text] -> Text
sessionPrompt [Post Text]
ins)
              -- Generic seats have no stamped parent ids; the builder's
              -- fallback (mkPost) keeps addressing honest.
              writeIORef outbox (posts who ins [] reply)
      )
      (atomicModifyIORef' outbox ([],))

-- | Mock seat: reply body is the session prompt (echo).
--
-- Demonstrates the living-agent path without a real query.
echoShard :: Text -> IO (Shard IO [Post Text] [Post Text])
echoShard :: Text -> IO (Shard IO [Post Text] [Post Text])
echoShard Text
who = Text -> (Text -> IO Text) -> IO (Shard IO [Post Text] [Post Text])
queryShard Text
who Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | One closed shard turn: commit @ins@, emit replies.
runShardIO :: Shard IO [Post Text] [Post Text] -> [Post Text] -> IO [Post Text]
runShardIO :: Shard IO [Post Text] [Post Text] -> [Post Text] -> IO [Post Text]
runShardIO Shard IO [Post Text] [Post Text]
sh = K IO [Post Text] [Post Text] -> [Post Text] -> IO [Post Text]
forall {k} (m :: k -> *) a (b :: k). K m a b -> a -> m b
runK (In (K IO) [Post Text]
-> Out (K IO) [Post Text] -> K IO [Post Text] [Post Text]
forall {k} (arr :: k -> k -> *) (a :: k).
In arr a -> Out arr a -> arr a a
close (Shard IO [Post Text] [Post Text] -> In (K IO) [Post Text]
forall {k1} {k2} (arr :: k1 -> k2 -> *) (a :: k1) (b :: k2).
Poles arr a b -> In arr a
conjoint Shard IO [Post Text] [Post Text]
sh) (Shard IO [Post Text] [Post Text] -> Out (K IO) [Post Text]
forall {k1} {k2} (arr :: k1 -> k2 -> *) (a :: k1) (b :: k2).
Poles arr a b -> Out arr b
companion Shard IO [Post Text] [Post Text]
sh))