{-# LANGUAGE OverloadedStrings #-}

-- | Algebraic wiring of agent meetings.
--
-- Vertices are agent names; edges are labelled with sets of channels
-- (names in 'Post.to'). The algebra is borrowed from @algebraic-graphs@:
--
-- * 'LG.empty' — no agents.
-- * 'LG.vertex' — a single agent.
-- * 'LG.overlay' — independent subgraphs (no new delivery edges).
-- * 'LG.connect' — every agent on the left may post to the channel(s);
--   every agent on the right subscribes to them.
--
-- This captures broadcast buses, stars, chains, and (via a registry that maps
-- a name to a whole subgraph) hierarchical orchestrators.
module Circuit.Agent.Graph
  ( -- * Graph of agents
    AgentGraph,
    ChannelSet,
    AgentNode (..),
    AgentRegistry,
    GraphAgent,

    -- * Construction
    channel,
    bus,
    star,
    chain,
    atomic,
    nested,

    -- * Interpretation
    channelMap,
    toRoster,
    runGraph,
    toAgent,
    flatten,
  )
where

import Algebra.Graph.Labelled qualified as LG
import Circuit.Agent
  ( Agent,
    AgentSeat (..),
    AgentState (..),
    Name,
    Post (..),
    appendInbox,
    emptyInbox,
    loopWithSubs,
    runAgentShard,
    watch,
  )
import Circuit.System (System, system)
import Data.List (foldl')
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (fromMaybe)
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text (Text)
import Prelude hiding (lookup)

-- | A channel is just a 'Name' that appears in 'Post.to'.
type Channel = Name

-- | A set of channels carried by one graph edge.
type ChannelSet = Set Channel

-- | Wiring graph: vertices are agent names, edges are sets of channels.
type AgentGraph = LG.Graph ChannelSet Name

-- | A registry entry is either an atomic pure agent or a nested subgraph.
data AgentNode
  = AtomicAgent (Agent (->) [Post Text] (Post Text) [Post Text])
  | NestedAgent AgentGraph AgentRegistry

-- | Registry of agents.  Names map to atomic agents or whole subgraphs.
type AgentRegistry = Map Name AgentNode

-- | Smart constructor for an atomic registry entry.
atomic :: Agent (->) [Post Text] (Post Text) [Post Text] -> AgentNode
atomic :: Agent (->) [Post Name] (Post Name) [Post Name] -> AgentNode
atomic = Agent (->) [Post Name] (Post Name) [Post Name] -> AgentNode
AtomicAgent

-- | Smart constructor for a nested registry entry.
nested :: AgentGraph -> AgentRegistry -> AgentNode
nested :: AgentGraph -> AgentRegistry -> AgentNode
nested = AgentGraph -> AgentRegistry -> AgentNode
NestedAgent

-- | An agent after graph routing has been applied: the carrier holds the
-- original history plus the output associated with the current state.
type GraphAgent = Agent (->) ([Post Text], Maybe [Post Text]) (Post Text) [Post Text]

-- | A single channel as an edge label.
channel :: Channel -> ChannelSet
channel :: Name -> ChannelSet
channel = Name -> ChannelSet
forall a. a -> Set a
Set.singleton

-- | Every named agent posts to and subscribes to @ch@.
--
-- This is the public-bus configuration.
bus :: [Name] -> Channel -> AgentGraph
bus :: [Name] -> Name -> AgentGraph
bus [Name]
names Name
ch =
  let vs :: AgentGraph
vs = [Name] -> AgentGraph
forall e a. Monoid e => [a] -> Graph e a
LG.vertices [Name]
names
   in ChannelSet -> AgentGraph -> AgentGraph -> AgentGraph
forall e a. e -> Graph e a -> Graph e a -> Graph e a
LG.connect (Name -> ChannelSet
channel Name
ch) AgentGraph
vs AgentGraph
vs

-- | A hub agent that posts to @hubCh@; leaf agents post to @leafCh@.
star :: Name -> [Name] -> Channel -> Channel -> AgentGraph
star :: Name -> [Name] -> Name -> Name -> AgentGraph
star Name
hub [Name]
leaves Name
hubCh Name
leafCh =
  let hubV :: AgentGraph
hubV = Name -> AgentGraph
forall a e. a -> Graph e a
LG.vertex Name
hub
      leafV :: AgentGraph
leafV = [Name] -> AgentGraph
forall e a. Monoid e => [a] -> Graph e a
LG.vertices [Name]
leaves
   in ChannelSet -> AgentGraph -> AgentGraph -> AgentGraph
forall e a. e -> Graph e a -> Graph e a -> Graph e a
LG.connect (Name -> ChannelSet
channel Name
hubCh) AgentGraph
hubV AgentGraph
leafV
        AgentGraph -> AgentGraph -> AgentGraph
forall e a. Monoid e => Graph e a -> Graph e a -> Graph e a
`LG.overlay` ChannelSet -> AgentGraph -> AgentGraph -> AgentGraph
forall e a. e -> Graph e a -> Graph e a -> Graph e a
LG.connect (Name -> ChannelSet
channel Name
leafCh) AgentGraph
leafV AgentGraph
hubV

-- | Chain agents left-to-right on a single channel.
chain :: [Name] -> Channel -> AgentGraph
chain :: [Name] -> Name -> AgentGraph
chain [Name]
names Name
ch =
  case [Name]
names of
    [] -> AgentGraph
forall e a. Graph e a
LG.empty
    (Name
n : [Name]
ns) -> AgentGraph -> [Name] -> AgentGraph
go (Name -> AgentGraph
forall a e. a -> Graph e a
LG.vertex Name
n) [Name]
ns
  where
    go :: AgentGraph -> [Name] -> AgentGraph
go AgentGraph
g [] = AgentGraph
g
    go AgentGraph
g (Name
n : [Name]
ns) = AgentGraph -> [Name] -> AgentGraph
go (ChannelSet -> AgentGraph -> AgentGraph -> AgentGraph
forall e a. e -> Graph e a -> Graph e a -> Graph e a
LG.connect (Name -> ChannelSet
channel Name
ch) AgentGraph
g (Name -> AgentGraph
forall a e. a -> Graph e a
LG.vertex Name
n)) [Name]
ns

-- | Per-vertex incoming and outgoing channel sets.
data VertexInfo = VertexInfo
  { VertexInfo -> ChannelSet
viIn :: ChannelSet,
    VertexInfo -> ChannelSet
viOut :: ChannelSet
  }

emptyInfo :: VertexInfo
emptyInfo :: VertexInfo
emptyInfo = ChannelSet -> ChannelSet -> VertexInfo
VertexInfo ChannelSet
forall a. Set a
Set.empty ChannelSet
forall a. Set a
Set.empty

mergeInfo :: VertexInfo -> VertexInfo -> VertexInfo
mergeInfo :: VertexInfo -> VertexInfo -> VertexInfo
mergeInfo (VertexInfo ChannelSet
i1 ChannelSet
o1) (VertexInfo ChannelSet
i2 ChannelSet
o2) =
  ChannelSet -> ChannelSet -> VertexInfo
VertexInfo (ChannelSet -> ChannelSet -> ChannelSet
forall a. Ord a => Set a -> Set a -> Set a
Set.union ChannelSet
i1 ChannelSet
i2) (ChannelSet -> ChannelSet -> ChannelSet
forall a. Ord a => Set a -> Set a -> Set a
Set.union ChannelSet
o1 ChannelSet
o2)

-- | Compute subscriptions and addressing for every agent in the graph.
channelMap :: AgentGraph -> Map Name VertexInfo
channelMap :: AgentGraph -> Map Name VertexInfo
channelMap = Map Name VertexInfo
-> (Name -> Map Name VertexInfo)
-> (ChannelSet
    -> Map Name VertexInfo
    -> Map Name VertexInfo
    -> Map Name VertexInfo)
-> AgentGraph
-> Map Name VertexInfo
forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
LG.foldg Map Name VertexInfo
forall k a. Map k a
Map.empty Name -> Map Name VertexInfo
forall {k}. k -> Map k VertexInfo
singleton ChannelSet
-> Map Name VertexInfo
-> Map Name VertexInfo
-> Map Name VertexInfo
forall {k}.
Ord k =>
ChannelSet
-> Map k VertexInfo -> Map k VertexInfo -> Map k VertexInfo
connectInfo
  where
    singleton :: k -> Map k VertexInfo
singleton k
n = k -> VertexInfo -> Map k VertexInfo
forall k a. k -> a -> Map k a
Map.singleton k
n VertexInfo
emptyInfo
    connectInfo :: ChannelSet
-> Map k VertexInfo -> Map k VertexInfo -> Map k VertexInfo
connectInfo ChannelSet
chs Map k VertexInfo
left Map k VertexInfo
right =
      let addOut :: Map k VertexInfo -> Map k VertexInfo
addOut = (VertexInfo -> VertexInfo) -> Map k VertexInfo -> Map k VertexInfo
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\VertexInfo
info -> VertexInfo
info {viOut = Set.union chs (viOut info)})
          addIn :: Map k VertexInfo -> Map k VertexInfo
addIn = (VertexInfo -> VertexInfo) -> Map k VertexInfo -> Map k VertexInfo
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\VertexInfo
info -> VertexInfo
info {viIn = Set.union chs (viIn info)})
          left' :: Map k VertexInfo
left' = if ChannelSet -> Bool
forall a. Set a -> Bool
Set.null ChannelSet
chs Bool -> Bool -> Bool
|| Map k VertexInfo -> Bool
forall k a. Map k a -> Bool
Map.null Map k VertexInfo
right then Map k VertexInfo
left else Map k VertexInfo -> Map k VertexInfo
addOut Map k VertexInfo
left
          right' :: Map k VertexInfo
right' = if ChannelSet -> Bool
forall a. Set a -> Bool
Set.null ChannelSet
chs Bool -> Bool -> Bool
|| Map k VertexInfo -> Bool
forall k a. Map k a -> Bool
Map.null Map k VertexInfo
left then Map k VertexInfo
right else Map k VertexInfo -> Map k VertexInfo
addIn Map k VertexInfo
right
       in (VertexInfo -> VertexInfo -> VertexInfo)
-> Map k VertexInfo -> Map k VertexInfo -> Map k VertexInfo
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith VertexInfo -> VertexInfo -> VertexInfo
mergeInfo Map k VertexInfo
left' Map k VertexInfo
right'

-- | Wrap an agent so its emitted posts are addressed to the given channels.
--
-- The outer carrier is @(innerHistory, lastOutput)@. Moore output is read from
-- the state, so we store the routed output produced by the most recent input
-- and return it on the next observation.
routeAgent :: ChannelSet -> Agent (->) [Post Text] (Post Text) [Post Text] -> GraphAgent
routeAgent :: ChannelSet
-> Agent (->) [Post Name] (Post Name) [Post Name] -> GraphAgent
routeAgent ChannelSet
outChs Agent (->) [Post Name] (Post Name) [Post Name]
inner =
  ((([Post Name], Maybe [Post Name]),
  Dir (Mono (Post Name) [Post Name]))
 -> (([Post Name], Maybe [Post Name]),
     Pos (Mono (Post Name) [Post Name])))
-> GraphAgent
forall (arr :: * -> * -> *) s (p :: Poly).
arr (s, Dir p) (s, Pos p) -> System arr s p
system (((([Post Name], Maybe [Post Name]),
   Dir (Mono (Post Name) [Post Name]))
  -> (([Post Name], Maybe [Post Name]),
      Pos (Mono (Post Name) [Post Name])))
 -> GraphAgent)
-> ((([Post Name], Maybe [Post Name]),
     Dir (Mono (Post Name) [Post Name]))
    -> (([Post Name], Maybe [Post Name]),
        Pos (Mono (Post Name) [Post Name])))
-> GraphAgent
forall a b. (a -> b) -> a -> b
$ \(([Post Name]
hist, Maybe [Post Name]
mout), Dir (Mono (Post Name) [Post Name])
d) ->
    case Dir (Mono (Post Name) [Post Name])
d of
      Left Void
_ -> (([Post Name]
hist, Maybe [Post Name]
mout), ([Post Name] -> Maybe [Post Name] -> [Post Name]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Post Name]
mout, ()))
      Right Post Name
inp ->
        let ([Post Name]
outs, AgentSeat [Post Name] Name
seat') = Agent (->) [Post Name] (Post Name) [Post Name]
-> AgentSeat [Post Name] Name
-> [Post Name]
-> ([Post Name], AgentSeat [Post Name] Name)
forall s a.
Agent (->) s (Post a) [Post a]
-> AgentSeat s a -> [Post a] -> ([Post a], AgentSeat s a)
runAgentShard Agent (->) [Post Name] (Post Name) [Post Name]
inner ([Post Name] -> [Post Name] -> AgentSeat [Post Name] Name
forall s a. s -> [Post a] -> AgentSeat s a
AgentSeat [Post Name]
hist []) [Post Name
inp]
            routed :: [Post Name]
routed = (Post Name -> Post Name) -> [Post Name] -> [Post Name]
forall a b. (a -> b) -> [a] -> [b]
map (\Post Name
p -> Post Name
p {to = Set.toList outChs}) [Post Name]
outs
         in ((AgentSeat [Post Name] Name -> [Post Name]
forall s a. AgentSeat s a -> s
asState AgentSeat [Post Name] Name
seat', [Post Name] -> Maybe [Post Name]
forall a. a -> Maybe a
Just [Post Name]
routed), ([Post Name] -> Maybe [Post Name] -> [Post Name]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Post Name]
mout, ()))

-- | Inject parent-imposed channels into a subgraph.  Every internal vertex
-- receives the incoming channels and gains the outgoing channels, so that
-- hierarchical interpretation (nested agent) and flattening agree.
injectChannels :: ChannelSet -> ChannelSet -> AgentGraph -> AgentGraph
injectChannels :: ChannelSet -> ChannelSet -> AgentGraph -> AgentGraph
injectChannels ChannelSet
ins ChannelSet
outs AgentGraph
g =
  AgentGraph -> AgentGraph -> AgentGraph
forall e a. Monoid e => Graph e a -> Graph e a -> Graph e a
LG.overlay (ChannelSet -> AgentGraph -> AgentGraph -> AgentGraph
forall e a. e -> Graph e a -> Graph e a -> Graph e a
LG.connect ChannelSet
ins AgentGraph
forall e a. Graph e a
LG.empty AgentGraph
g) (ChannelSet -> AgentGraph -> AgentGraph -> AgentGraph
forall e a. e -> Graph e a -> Graph e a -> Graph e a
LG.connect ChannelSet
outs AgentGraph
g AgentGraph
forall e a. Graph e a
LG.empty)

-- | Interpret a graph as a single agent.  The carrier is the input history;
-- each new post is fed to the graph and the freshly generated posts are
-- emitted.
toAgent :: AgentGraph -> AgentRegistry -> Agent (->) [Post Text] (Post Text) [Post Text]
toAgent :: AgentGraph
-> AgentRegistry -> Agent (->) [Post Name] (Post Name) [Post Name]
toAgent AgentGraph
graph AgentRegistry
registry =
  (([Post Name], Dir (Mono (Post Name) [Post Name]))
 -> ([Post Name], Pos (Mono (Post Name) [Post Name])))
-> Agent (->) [Post Name] (Post Name) [Post Name]
forall (arr :: * -> * -> *) s (p :: Poly).
arr (s, Dir p) (s, Pos p) -> System arr s p
system ((([Post Name], Dir (Mono (Post Name) [Post Name]))
  -> ([Post Name], Pos (Mono (Post Name) [Post Name])))
 -> Agent (->) [Post Name] (Post Name) [Post Name])
-> (([Post Name], Dir (Mono (Post Name) [Post Name]))
    -> ([Post Name], Pos (Mono (Post Name) [Post Name])))
-> Agent (->) [Post Name] (Post Name) [Post Name]
forall a b. (a -> b) -> a -> b
$ \([Post Name]
hist, Dir (Mono (Post Name) [Post Name])
d) ->
    case Dir (Mono (Post Name) [Post Name])
d of
      Left Void
_ -> ([Post Name]
hist, ([], ()))
      Right Post Name
inp ->
        let hist' :: [Post Name]
hist' = [Post Name]
hist [Post Name] -> [Post Name] -> [Post Name]
forall a. [a] -> [a] -> [a]
++ [Post Name
inp]
            logBefore :: [Post Name]
logBefore = AgentGraph -> AgentRegistry -> [Post Name] -> [Post Name]
runGraph AgentGraph
graph AgentRegistry
registry [Post Name]
hist
            logAfter :: [Post Name]
logAfter = AgentGraph -> AgentRegistry -> [Post Name] -> [Post Name]
runGraph AgentGraph
graph AgentRegistry
registry [Post Name]
hist'
            newPosts :: [Post Name]
newPosts = Int -> [Post Name] -> [Post Name]
forall a. Int -> [a] -> [a]
drop ([Post Name] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Post Name]
logBefore) [Post Name]
logAfter
         in ([Post Name]
hist', ([Post Name]
newPosts, ()))

-- | Resolve a registry entry into a pure agent.  Nested agents are
-- interpreted as agents over their subgraph with parent channels injected.
resolveNode :: ChannelSet -> ChannelSet -> AgentNode -> Agent (->) [Post Text] (Post Text) [Post Text]
resolveNode :: ChannelSet
-> ChannelSet
-> AgentNode
-> Agent (->) [Post Name] (Post Name) [Post Name]
resolveNode ChannelSet
_ ChannelSet
_ (AtomicAgent Agent (->) [Post Name] (Post Name) [Post Name]
a) = Agent (->) [Post Name] (Post Name) [Post Name]
a
resolveNode ChannelSet
ins ChannelSet
outs (NestedAgent AgentGraph
g AgentRegistry
r) = AgentGraph
-> AgentRegistry -> Agent (->) [Post Name] (Post Name) [Post Name]
toAgent (ChannelSet -> ChannelSet -> AgentGraph -> AgentGraph
injectChannels ChannelSet
ins ChannelSet
outs AgentGraph
g) AgentRegistry
r

-- | Build a roster from the graph by routing each agent's outputs along its
-- outgoing edges and subscribing it to its incoming edges.
toRoster :: AgentGraph -> AgentRegistry -> [(Name, GraphAgent)]
toRoster :: AgentGraph -> AgentRegistry -> [(Name, GraphAgent)]
toRoster AgentGraph
graph AgentRegistry
registry =
  [ (Name
n, ChannelSet
-> Agent (->) [Post Name] (Post Name) [Post Name] -> GraphAgent
routeAgent (VertexInfo -> ChannelSet
viOut VertexInfo
info) (ChannelSet
-> ChannelSet
-> AgentNode
-> Agent (->) [Post Name] (Post Name) [Post Name]
resolveNode (VertexInfo -> ChannelSet
viIn VertexInfo
info) (VertexInfo -> ChannelSet
viOut VertexInfo
info) AgentNode
node))
  | (Name
n, VertexInfo
info) <- Map Name VertexInfo -> [(Name, VertexInfo)]
forall k a. Map k a -> [(k, a)]
Map.toList (AgentGraph -> Map Name VertexInfo
channelMap AgentGraph
graph),
    Just AgentNode
node <- [Name -> AgentRegistry -> Maybe AgentNode
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n AgentRegistry
registry]
  ]

-- | Seed a graph-wrapped agent state: inbox sees addressed posts, carrier is
-- empty.
seedGraphState :: [Name] -> [Post Text] -> AgentState ([Post Text], Maybe [Post Text]) [Post Text]
seedGraphState :: [Name]
-> [Post Name]
-> AgentState ([Post Name], Maybe [Post Name]) [Post Name]
seedGraphState [Name]
subs [Post Name]
inputs =
  ([Post Name], Maybe [Post Name])
-> Inbox [Post Name]
-> AgentState ([Post Name], Maybe [Post Name]) [Post Name]
forall s f. s -> Inbox f -> AgentState s f
AgentState ([], Maybe [Post Name]
forall a. Maybe a
Nothing) ((Inbox [Post Name] -> Post Name -> Inbox [Post Name])
-> Inbox [Post Name] -> [Post Name] -> Inbox [Post Name]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Post Name -> Inbox [Post Name] -> Inbox [Post Name])
-> Inbox [Post Name] -> Post Name -> Inbox [Post Name]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Post Name -> Inbox [Post Name] -> Inbox [Post Name]
forall f a. Snoc f (Post a) => Post a -> Inbox f -> Inbox f
appendInbox) (forall a f. Uncons f (Post a) => [Name] -> Inbox f
emptyInbox @Text [Name]
subs) (forall a f. Uncons f (Post a) => [Name] -> f -> [Post a]
watch @Text [Name]
subs [Post Name]
inputs))

-- | Run the wired agents against an initial log.
runGraph ::
  AgentGraph ->
  AgentRegistry ->
  [Post Text] ->
  [Post Text]
runGraph :: AgentGraph -> AgentRegistry -> [Post Name] -> [Post Name]
runGraph AgentGraph
graph AgentRegistry
registry [Post Name]
inputs =
  let roster :: [(Name, GraphAgent)]
roster = AgentGraph -> AgentRegistry -> [(Name, GraphAgent)]
toRoster AgentGraph
graph AgentRegistry
registry
      info :: Map Name VertexInfo
info = AgentGraph -> Map Name VertexInfo
channelMap AgentGraph
graph
      subs :: Name -> [Name]
subs Name
n = ChannelSet -> [Name]
forall a. Set a -> [a]
Set.toList (VertexInfo -> ChannelSet
viIn (VertexInfo -> Maybe VertexInfo -> VertexInfo
forall a. a -> Maybe a -> a
fromMaybe VertexInfo
emptyInfo (Name -> Map Name VertexInfo -> Maybe VertexInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
n Map Name VertexInfo
info)))
      states :: [(Name, AgentState ([Post Name], Maybe [Post Name]) [Post Name])]
states = [(Name
n, [Name]
-> [Post Name]
-> AgentState ([Post Name], Maybe [Post Name]) [Post Name]
seedGraphState (Name -> [Name]
subs Name
n) [Post Name]
inputs) | (Name
n, GraphAgent
_) <- [(Name, GraphAgent)]
roster]
      rosterSubs :: [(Name, [Name], GraphAgent)]
rosterSubs = [(Name
n, Name -> [Name]
subs Name
n, GraphAgent
a) | (Name
n, GraphAgent
a) <- [(Name, GraphAgent)]
roster]
   in case [(Name, [Name], GraphAgent)]
-> [(Name,
     AgentState ([Post Name], Maybe [Post Name]) [Post Name])]
-> [Post Name]
-> ([(Name,
      AgentState ([Post Name], Maybe [Post Name]) [Post Name])],
    [Post Name], [Derivation Name])
forall a s f.
(Snoc f (Post a), Cons f (Post a), Uncons f (Post a)) =>
[RosterEntry s a]
-> [(Name, AgentState s f)]
-> f
-> ([(Name, AgentState s f)], f, [Derivation a])
loopWithSubs [(Name, [Name], GraphAgent)]
rosterSubs [(Name, AgentState ([Post Name], Maybe [Post Name]) [Post Name])]
states [Post Name]
inputs of
        ([(Name, AgentState ([Post Name], Maybe [Post Name]) [Post Name])]
_, [Post Name]
log', [Derivation Name]
_) -> [Post Name]
log'

-- | Map over vertex names.
gmapVertices :: (Name -> Name) -> AgentGraph -> AgentGraph
gmapVertices :: (Name -> Name) -> AgentGraph -> AgentGraph
gmapVertices Name -> Name
f = AgentGraph
-> (Name -> AgentGraph)
-> (ChannelSet -> AgentGraph -> AgentGraph -> AgentGraph)
-> AgentGraph
-> AgentGraph
forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
LG.foldg AgentGraph
forall e a. Graph e a
LG.empty (Name -> AgentGraph
forall a e. a -> Graph e a
LG.vertex (Name -> AgentGraph) -> (Name -> Name) -> Name -> AgentGraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Name
f) ChannelSet -> AgentGraph -> AgentGraph -> AgentGraph
forall e a. e -> Graph e a -> Graph e a -> Graph e a
LG.connect

-- | Flatten a graph by expanding nested vertices into their subgraphs.
-- Returns a graph whose vertices are all atomic and a registry of those atoms.
-- Nested names are prefixed to avoid collisions.
flatten :: AgentGraph -> AgentRegistry -> (AgentGraph, AgentRegistry)
flatten :: AgentGraph -> AgentRegistry -> (AgentGraph, AgentRegistry)
flatten AgentGraph
graph AgentRegistry
registry = (AgentGraph, AgentRegistry)
-> (Name -> (AgentGraph, AgentRegistry))
-> (ChannelSet
    -> (AgentGraph, AgentRegistry)
    -> (AgentGraph, AgentRegistry)
    -> (AgentGraph, AgentRegistry))
-> AgentGraph
-> (AgentGraph, AgentRegistry)
forall b a e. b -> (a -> b) -> (e -> b -> b -> b) -> Graph e a -> b
LG.foldg (AgentGraph, AgentRegistry)
forall {e} {a} {k} {a}. (Graph e a, Map k a)
emptyM Name -> (AgentGraph, AgentRegistry)
vertexM ChannelSet
-> (AgentGraph, AgentRegistry)
-> (AgentGraph, AgentRegistry)
-> (AgentGraph, AgentRegistry)
forall {k} {e} {a} {a}.
Ord k =>
e
-> (Graph e a, Map k a)
-> (Graph e a, Map k a)
-> (Graph e a, Map k a)
connectM AgentGraph
graph
  where
    emptyM :: (Graph e a, Map k a)
emptyM = (Graph e a
forall e a. Graph e a
LG.empty, Map k a
forall k a. Map k a
Map.empty)
    vertexM :: Name -> (AgentGraph, AgentRegistry)
vertexM Name
name =
      case Name -> AgentRegistry -> Maybe AgentNode
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name AgentRegistry
registry of
        Just (NestedAgent AgentGraph
g AgentRegistry
r) ->
          let (AgentGraph
g', AgentRegistry
r') = AgentGraph -> AgentRegistry -> (AgentGraph, AgentRegistry)
flatten AgentGraph
g AgentRegistry
r
              prefix :: Name
prefix = Name
name Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
"/"
              g'' :: AgentGraph
g'' = (Name -> Name) -> AgentGraph -> AgentGraph
gmapVertices (Name
prefix Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<>) AgentGraph
g'
              r'' :: AgentRegistry
r'' = (Name -> Name) -> AgentRegistry -> AgentRegistry
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (Name
prefix Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<>) AgentRegistry
r'
           in (AgentGraph
g'', AgentRegistry
r'')
        Just (AtomicAgent Agent (->) [Post Name] (Post Name) [Post Name]
a) -> (Name -> AgentGraph
forall a e. a -> Graph e a
LG.vertex Name
name, Name -> AgentNode -> AgentRegistry
forall k a. k -> a -> Map k a
Map.singleton Name
name (Agent (->) [Post Name] (Post Name) [Post Name] -> AgentNode
AtomicAgent Agent (->) [Post Name] (Post Name) [Post Name]
a))
        Maybe AgentNode
Nothing -> (Name -> AgentGraph
forall a e. a -> Graph e a
LG.vertex Name
name, AgentRegistry
forall k a. Map k a
Map.empty)
    connectM :: e
-> (Graph e a, Map k a)
-> (Graph e a, Map k a)
-> (Graph e a, Map k a)
connectM e
chs (Graph e a
gl, Map k a
regL) (Graph e a
gr, Map k a
regR) =
      (e -> Graph e a -> Graph e a -> Graph e a
forall e a. e -> Graph e a -> Graph e a -> Graph e a
LG.connect e
chs Graph e a
gl Graph e a
gr, Map k a -> Map k a -> Map k a
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map k a
regL Map k a
regR)