agentic-sx Phase 2: branch — one branch = one agent (TDD)
space handle (repo + relations Datalog db); spawn! = branch-from-briefing with a genesis spawn commit at the fork point; commit! verb snapshots a full worktree VALUE into a typed agent-commit and CAS-advances the branch (no shared index — multi-agent safe). Topology: fork-point via merge-base, agents from refs, typed edges sub-agent-of/reviews/merges. Session merges always record a two-parent session-merge commit (no-ff); conflicts commit nothing and conclude via merge-resolve!. 53/53 (118/118 total). Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
317
lib/agentic/branch.sx
Normal file
317
lib/agentic/branch.sx
Normal file
@@ -0,0 +1,317 @@
|
||||
; lib/agentic/branch.sx — agentic-sx Phase 2: one branch = one agent.
|
||||
; spawn = branch-from-briefing: write the briefing, then a genesis "spawn"
|
||||
; agent-commit whose parent is the fork point; the branch ref IS the agent.
|
||||
; The commit verb snapshots a full worktree VALUE (path -> data) into a typed
|
||||
; agent-commit and advances the branch by CAS — no shared index, multi-agent
|
||||
; safe by construction. Branch topology = agent topology: fork points via
|
||||
; git/merge-base, plus relations typed edges (sub-agent-of / reviews /
|
||||
; merges) in a Datalog db carried on the space handle.
|
||||
; Edge direction: (rel src dst kind) reads src=parent/actor, dst=child/object
|
||||
; (root child sub-agent-of), (reviewer reviewee reviews), (into from merges).
|
||||
; Session merges are always recorded as a two-parent "session-merge" commit
|
||||
; (no fast-forward) so the merge itself is an agent action with metadata.
|
||||
; Requires: lib/agentic/schema.sx, lib/git/*, lib/relations/* (+ datalog).
|
||||
|
||||
; ---- space: repo + relations db ----
|
||||
(define agentic/space (fn (db name) {:repo (git/repo-named db name) :rels (relations-build-db (list))}))
|
||||
|
||||
(define agentic/space-repo (fn (sp) (get sp :repo)))
|
||||
(define agentic/space-rels (fn (sp) (get sp :rels)))
|
||||
|
||||
(define agentic/branch-name (fn (agent) (str "agents/" agent)))
|
||||
|
||||
; ---- typed edges over relations ----
|
||||
(define
|
||||
agentic/relate!
|
||||
(fn
|
||||
(sp src dst kind)
|
||||
(begin
|
||||
(dl-assert! (agentic/space-rels sp) (relations-rel src dst kind))
|
||||
true)))
|
||||
|
||||
(define
|
||||
agentic/sub-agents
|
||||
(fn
|
||||
(sp agent)
|
||||
(sort
|
||||
(relations-children-of
|
||||
(agentic/space-rels sp)
|
||||
agent
|
||||
(quote sub-agent-of)))))
|
||||
|
||||
(define
|
||||
agentic/parent-agent
|
||||
(fn
|
||||
(sp agent)
|
||||
(let
|
||||
((ps (relations-parents-of (agentic/space-rels sp) agent (quote sub-agent-of))))
|
||||
(if (= (len ps) 0) nil (nth ps 0)))))
|
||||
|
||||
(define
|
||||
agentic/agent-tree
|
||||
(fn
|
||||
(sp agent)
|
||||
(sort
|
||||
(relations-descendants
|
||||
(agentic/space-rels sp)
|
||||
agent
|
||||
(quote sub-agent-of)))))
|
||||
|
||||
(define
|
||||
agentic/reviews!
|
||||
(fn
|
||||
(sp reviewer reviewee)
|
||||
(agentic/relate! sp reviewer reviewee (quote reviews))))
|
||||
|
||||
(define
|
||||
agentic/reviewers
|
||||
(fn
|
||||
(sp agent)
|
||||
(sort
|
||||
(relations-parents-of (agentic/space-rels sp) agent (quote reviews)))))
|
||||
|
||||
(define
|
||||
agentic/reviewing
|
||||
(fn
|
||||
(sp agent)
|
||||
(sort
|
||||
(relations-children-of (agentic/space-rels sp) agent (quote reviews)))))
|
||||
|
||||
(define
|
||||
agentic/merged-sessions
|
||||
(fn
|
||||
(sp agent)
|
||||
(sort
|
||||
(relations-children-of (agentic/space-rels sp) agent (quote merges)))))
|
||||
|
||||
(define
|
||||
agentic/merged-into
|
||||
(fn
|
||||
(sp agent)
|
||||
(sort
|
||||
(relations-parents-of (agentic/space-rels sp) agent (quote merges)))))
|
||||
|
||||
; ---- spawn = branch-from-briefing ----
|
||||
; base-cid nil => root agent over an empty tree; parent-agent nil => no edge.
|
||||
; => {:agent :branch :briefing :genesis} | {:conflict true :actual cid}
|
||||
(define
|
||||
agentic/spawn-at!
|
||||
(fn
|
||||
(sp agent briefing base-cid parent-agent)
|
||||
(let
|
||||
((repo (agentic/space-repo sp)))
|
||||
(let
|
||||
((bcid (git/write repo briefing))
|
||||
(tree
|
||||
(if
|
||||
(nil? base-cid)
|
||||
(git/tree-from-files repo {})
|
||||
(git/commit-tree (git/read repo base-cid))))
|
||||
(parents (if (nil? base-cid) (list) (list base-cid))))
|
||||
(let
|
||||
((g (agentic/agent-commit tree parents "spawn" {:message (str "spawn: " (agentic/briefing-title briefing)) :agent agent :briefing bcid})))
|
||||
(let
|
||||
((gcid (git/write repo g)))
|
||||
(let
|
||||
((res (git/branch-create! repo (agentic/branch-name agent) gcid)))
|
||||
(if
|
||||
(and (dict? res) (has-key? res :conflict))
|
||||
res
|
||||
(begin
|
||||
(if
|
||||
(nil? parent-agent)
|
||||
nil
|
||||
(agentic/relate!
|
||||
sp
|
||||
parent-agent
|
||||
agent
|
||||
(quote sub-agent-of)))
|
||||
{:agent agent :briefing bcid :branch (agentic/branch-name agent) :genesis gcid})))))))))
|
||||
|
||||
(define
|
||||
agentic/spawn!
|
||||
(fn (sp agent briefing) (agentic/spawn-at! sp agent briefing nil nil)))
|
||||
|
||||
(define
|
||||
agentic/spawn-from!
|
||||
(fn
|
||||
(sp agent briefing parent-agent)
|
||||
(let
|
||||
((h (agentic/head sp parent-agent)))
|
||||
(if
|
||||
(nil? h)
|
||||
{:agent parent-agent :error "no-such-agent"}
|
||||
(agentic/spawn-at! sp agent briefing h parent-agent)))))
|
||||
|
||||
; ---- heads / listing ----
|
||||
(define
|
||||
agentic/head
|
||||
(fn
|
||||
(sp agent)
|
||||
(git/branch-get (agentic/space-repo sp) (agentic/branch-name agent))))
|
||||
|
||||
(define
|
||||
agentic/agents
|
||||
(fn (sp) (git/refs-under (agentic/space-repo sp) "heads/agents/")))
|
||||
|
||||
; ---- the commit verb: snapshot + typed agent-commit + CAS advance ----
|
||||
; files = the agent's FULL worktree value (path -> data). Briefing and agent
|
||||
; identity propagate from the branch head. => cid | {:error ...} | {:conflict ...}
|
||||
(define
|
||||
agentic/commit!
|
||||
(fn
|
||||
(sp agent kind files meta)
|
||||
(let
|
||||
((repo (agentic/space-repo sp)))
|
||||
(let
|
||||
((head (agentic/head sp agent)))
|
||||
(cond
|
||||
((nil? head) {:agent agent :error "no-such-agent"})
|
||||
((not (agentic/commit-kind? kind)) {:error "unknown-kind" :kind kind})
|
||||
(else
|
||||
(let
|
||||
((tree (git/tree-from-files repo files))
|
||||
(b (agentic/commit-briefing (git/read repo head))))
|
||||
(let
|
||||
((pm (if (nil? b) {:agent agent} {:agent agent :briefing b})))
|
||||
(let
|
||||
((cid (git/write repo (agentic/agent-commit tree (list head) kind (merge meta pm)))))
|
||||
(let
|
||||
((res (git/branch-cas! repo (agentic/branch-name agent) head cid)))
|
||||
(if (and (dict? res) (has-key? res :conflict)) res cid)))))))))))
|
||||
|
||||
; commits authored by this agent, newest first, from its branch head
|
||||
(define
|
||||
agentic/session-log
|
||||
(fn
|
||||
(sp agent)
|
||||
(let
|
||||
((repo (agentic/space-repo sp)))
|
||||
(let
|
||||
((head (agentic/head sp agent)))
|
||||
(if
|
||||
(nil? head)
|
||||
(list)
|
||||
(filter
|
||||
(fn (cid) (= (agentic/commit-agent (git/read repo cid)) agent))
|
||||
(git/log repo head)))))))
|
||||
|
||||
; the branch's genesis spawn commit (oldest spawn authored by this agent)
|
||||
(define
|
||||
agentic/genesis
|
||||
(fn
|
||||
(sp agent)
|
||||
(let
|
||||
((repo (agentic/space-repo sp)))
|
||||
(let
|
||||
((head (agentic/head sp agent)))
|
||||
(if
|
||||
(nil? head)
|
||||
nil
|
||||
(let
|
||||
((hits (filter (fn (cid) (let ((c (git/read repo cid))) (and (= (agentic/commit-kind c) "spawn") (= (agentic/commit-agent c) agent)))) (git/log repo head))))
|
||||
(if (= (len hits) 0) nil (last hits))))))))
|
||||
|
||||
(define
|
||||
agentic/briefing-of
|
||||
(fn
|
||||
(sp agent)
|
||||
(let
|
||||
((repo (agentic/space-repo sp)))
|
||||
(let
|
||||
((g (agentic/genesis sp agent)))
|
||||
(if
|
||||
(nil? g)
|
||||
nil
|
||||
(let
|
||||
((bcid (agentic/commit-briefing (git/read repo g))))
|
||||
(if (nil? bcid) nil (git/read repo bcid))))))))
|
||||
|
||||
; ---- topology: fork points via the DAG ----
|
||||
(define
|
||||
agentic/fork-point
|
||||
(fn
|
||||
(sp agent-a agent-b)
|
||||
(let
|
||||
((ha (agentic/head sp agent-a)) (hb (agentic/head sp agent-b)))
|
||||
(if
|
||||
(or (nil? ha) (nil? hb))
|
||||
nil
|
||||
(git/merge-base (agentic/space-repo sp) ha hb)))))
|
||||
|
||||
; ---- session merge: always an explicit two-parent session-merge commit ----
|
||||
(define
|
||||
agentic/merge-commit-at!
|
||||
(fn
|
||||
(sp into-agent from-agent ours theirs tree meta)
|
||||
(let
|
||||
((repo (agentic/space-repo sp)))
|
||||
(let
|
||||
((b (agentic/commit-briefing (git/read repo ours))))
|
||||
(let
|
||||
((pm (if (nil? b) {:agent into-agent :merged-agent from-agent} {:agent into-agent :briefing b :merged-agent from-agent})))
|
||||
(let
|
||||
((cid (git/write repo (agentic/agent-commit tree (list ours theirs) "session-merge" (merge meta pm)))))
|
||||
(let
|
||||
((res (git/branch-cas! repo (agentic/branch-name into-agent) ours cid)))
|
||||
(if
|
||||
(and (dict? res) (has-key? res :conflict))
|
||||
res
|
||||
(begin
|
||||
(agentic/relate! sp into-agent from-agent (quote merges))
|
||||
{:cid cid :result "merged"})))))))))
|
||||
|
||||
; => {:result "up-to-date"} | {:result "merged" :cid} |
|
||||
; {:result "conflicts" :tree :conflicts (paths)} | {:error ...}
|
||||
; Conflicts commit nothing — resolve with agentic/merge-resolve!.
|
||||
(define
|
||||
agentic/merge-session!
|
||||
(fn
|
||||
(sp into-agent from-agent meta)
|
||||
(let
|
||||
((repo (agentic/space-repo sp)))
|
||||
(let
|
||||
((ours (agentic/head sp into-agent))
|
||||
(theirs (agentic/head sp from-agent)))
|
||||
(cond
|
||||
((nil? ours) {:agent into-agent :error "no-such-agent"})
|
||||
((nil? theirs) {:agent from-agent :error "no-such-agent"})
|
||||
(else
|
||||
(let
|
||||
((m (git/merge-commits repo ours theirs)))
|
||||
(cond
|
||||
((= (get m :result) "up-to-date") m)
|
||||
((= (get m :result) "conflicts") m)
|
||||
(else
|
||||
(let
|
||||
((tree (if (= (get m :result) "fast-forward") (git/commit-tree (git/read repo theirs)) (get m :tree))))
|
||||
(agentic/merge-commit-at!
|
||||
sp
|
||||
into-agent
|
||||
from-agent
|
||||
ours
|
||||
theirs
|
||||
tree
|
||||
meta)))))))))))
|
||||
|
||||
; conclude a conflicted session merge with resolved worktree files
|
||||
(define
|
||||
agentic/merge-resolve!
|
||||
(fn
|
||||
(sp into-agent from-agent files meta)
|
||||
(let
|
||||
((repo (agentic/space-repo sp)))
|
||||
(let
|
||||
((ours (agentic/head sp into-agent))
|
||||
(theirs (agentic/head sp from-agent)))
|
||||
(if
|
||||
(or (nil? ours) (nil? theirs))
|
||||
{:error "no-such-agent"}
|
||||
(agentic/merge-commit-at!
|
||||
sp
|
||||
into-agent
|
||||
from-agent
|
||||
ours
|
||||
theirs
|
||||
(git/tree-from-files repo files)
|
||||
meta))))))
|
||||
@@ -13,7 +13,7 @@ if [ ! -x "$SX_SERVER" ]; then
|
||||
exit 1
|
||||
fi
|
||||
|
||||
SUITES=(schema)
|
||||
SUITES=(schema branch)
|
||||
|
||||
OUT_JSON="lib/agentic/scoreboard.json"
|
||||
OUT_MD="lib/agentic/scoreboard.md"
|
||||
|
||||
@@ -1,8 +1,9 @@
|
||||
{
|
||||
"suites": {
|
||||
"schema": {"pass": 65, "fail": 0}
|
||||
"schema": {"pass": 65, "fail": 0},
|
||||
"branch": {"pass": 53, "fail": 0}
|
||||
},
|
||||
"total_pass": 65,
|
||||
"total_pass": 118,
|
||||
"total_fail": 0,
|
||||
"total": 65
|
||||
"total": 118
|
||||
}
|
||||
|
||||
@@ -5,4 +5,5 @@ _Generated by `lib/agentic/conformance.sh`_
|
||||
| Suite | Pass | Fail | Total |
|
||||
|-------|-----:|-----:|------:|
|
||||
| schema | 65 | 0 | 65 |
|
||||
| **Total** | **65** | **0** | **65** |
|
||||
| branch | 53 | 0 | 53 |
|
||||
| **Total** | **118** | **0** | **118** |
|
||||
|
||||
333
lib/agentic/tests/branch.sx
Normal file
333
lib/agentic/tests/branch.sx
Normal file
@@ -0,0 +1,333 @@
|
||||
; Phase 2 — branch: one branch = one agent. Fixture story: root-1 coordinates
|
||||
; a refactor; lexer-1 + parser-1 spawn from its plan commit (lexer-1a nested
|
||||
; under lexer-1); their sessions merge back (ff-shaped and true 3-way), then
|
||||
; risky-1 collides with root-1 on plan.md and the conflict is resolved via
|
||||
; merge-resolve!. Edges: sub-agent-of / reviews / merges.
|
||||
|
||||
(define agb-db (persist/mem-backend))
|
||||
(define agb-sp (agentic/space agb-db "agentic-branch-test"))
|
||||
(define agb-repo (agentic/space-repo agb-sp))
|
||||
|
||||
(define
|
||||
agb-root-briefing
|
||||
(agentic/briefing "coordinate refactor" "split parser module" {}))
|
||||
(define agb-root (agentic/spawn! agb-sp "root-1" agb-root-briefing))
|
||||
|
||||
(agentic-test "spawn returns the agent" (get agb-root :agent) "root-1")
|
||||
(agentic-test
|
||||
"spawn creates the agent branch"
|
||||
(contains? (git/branches agb-repo) "agents/root-1")
|
||||
true)
|
||||
(agentic-test
|
||||
"head is the genesis"
|
||||
(= (agentic/head agb-sp "root-1") (get agb-root :genesis))
|
||||
true)
|
||||
(agentic-test
|
||||
"genesis is a spawn commit"
|
||||
(agentic/commit-kind (git/read agb-repo (get agb-root :genesis)))
|
||||
"spawn")
|
||||
(agentic-test
|
||||
"genesis records the briefing"
|
||||
(agentic/commit-briefing (git/read agb-repo (get agb-root :genesis)))
|
||||
(get agb-root :briefing))
|
||||
(agentic-test
|
||||
"briefing-of reads back the briefing"
|
||||
(agentic/briefing-title (agentic/briefing-of agb-sp "root-1"))
|
||||
"coordinate refactor")
|
||||
(agentic-test
|
||||
"root genesis has no parents"
|
||||
(= (git/parents agb-repo (get agb-root :genesis)) (list))
|
||||
true)
|
||||
(agentic-test
|
||||
"spawn is create-only"
|
||||
(has-key? (agentic/spawn! agb-sp "root-1" agb-root-briefing) :conflict)
|
||||
true)
|
||||
(agentic-test
|
||||
"agents lists the branch set"
|
||||
(= (agentic/agents agb-sp) (list "root-1"))
|
||||
true)
|
||||
|
||||
; ---- the commit verb ----
|
||||
(define
|
||||
agb-c1
|
||||
(agentic/commit!
|
||||
agb-sp
|
||||
"root-1"
|
||||
"decision"
|
||||
(assoc {} "plan.md" "split into lexer+parser\n")
|
||||
{:message "plan recorded"}))
|
||||
|
||||
(agentic-test "commit! returns a cid" (starts-with? agb-c1 "sx1:") true)
|
||||
(agentic-test
|
||||
"commit! advances the head"
|
||||
(= (agentic/head agb-sp "root-1") agb-c1)
|
||||
true)
|
||||
(agentic-test
|
||||
"commit! records the kind"
|
||||
(agentic/commit-kind (git/read agb-repo agb-c1))
|
||||
"decision")
|
||||
(agentic-test
|
||||
"briefing propagates to every commit"
|
||||
(agentic/commit-briefing (git/read agb-repo agb-c1))
|
||||
(get agb-root :briefing))
|
||||
(agentic-test
|
||||
"commit! snapshots the worktree"
|
||||
(get (git/commit-files agb-repo agb-c1) "plan.md")
|
||||
"split into lexer+parser\n")
|
||||
(agentic-test
|
||||
"unknown kind is rejected"
|
||||
(get
|
||||
(agentic/commit! agb-sp "root-1" "frobnicate" {} {})
|
||||
:error)
|
||||
"unknown-kind")
|
||||
(agentic-test
|
||||
"commit to unknown agent fails"
|
||||
(get
|
||||
(agentic/commit! agb-sp "ghost" "finding" {} {})
|
||||
:error)
|
||||
"no-such-agent")
|
||||
(agentic-test
|
||||
"session-log newest first"
|
||||
(=
|
||||
(agentic/session-log agb-sp "root-1")
|
||||
(list agb-c1 (get agb-root :genesis)))
|
||||
true)
|
||||
(agentic-test
|
||||
"genesis found from head"
|
||||
(= (agentic/genesis agb-sp "root-1") (get agb-root :genesis))
|
||||
true)
|
||||
|
||||
; ---- sub-agents fork at the parent head ----
|
||||
(define
|
||||
agb-lex-briefing
|
||||
(agentic/briefing "extract lexer" "pull tokenizer into lexer.sx" {}))
|
||||
(define
|
||||
agb-lex
|
||||
(agentic/spawn-from! agb-sp "lexer-1" agb-lex-briefing "root-1"))
|
||||
(define
|
||||
agb-par-briefing
|
||||
(agentic/briefing "extract parser" "pull grammar into parser.sx" {}))
|
||||
(define
|
||||
agb-par
|
||||
(agentic/spawn-from! agb-sp "parser-1" agb-par-briefing "root-1"))
|
||||
|
||||
(agentic-test
|
||||
"spawn-from creates the sub branch"
|
||||
(get agb-lex :agent)
|
||||
"lexer-1")
|
||||
(agentic-test
|
||||
"sub genesis forks at the parent head"
|
||||
(= (git/parents agb-repo (get agb-lex :genesis)) (list agb-c1))
|
||||
true)
|
||||
(agentic-test
|
||||
"sub genesis inherits the base tree"
|
||||
(get (git/commit-files agb-repo (get agb-lex :genesis)) "plan.md")
|
||||
"split into lexer+parser\n")
|
||||
(agentic-test
|
||||
"sub-agent edges recorded"
|
||||
(= (agentic/sub-agents agb-sp "root-1") (list "lexer-1" "parser-1"))
|
||||
true)
|
||||
(agentic-test
|
||||
"parent-agent edge"
|
||||
(agentic/parent-agent agb-sp "lexer-1")
|
||||
"root-1")
|
||||
(agentic-test
|
||||
"root has no parent agent"
|
||||
(agentic/parent-agent agb-sp "root-1")
|
||||
nil)
|
||||
(agentic-test
|
||||
"spawn-from unknown parent fails"
|
||||
(get (agentic/spawn-from! agb-sp "x-1" agb-lex-briefing "ghost") :error)
|
||||
"no-such-agent")
|
||||
(agentic-test
|
||||
"agents lists all branches sorted"
|
||||
(= (agentic/agents agb-sp) (list "lexer-1" "parser-1" "root-1"))
|
||||
true)
|
||||
|
||||
(define
|
||||
agb-lex2
|
||||
(agentic/spawn-from!
|
||||
agb-sp
|
||||
"lexer-1a"
|
||||
(agentic/briefing "lexer unicode" "handle utf8 in the lexer" {})
|
||||
"lexer-1"))
|
||||
|
||||
(agentic-test
|
||||
"agent-tree is transitive"
|
||||
(=
|
||||
(agentic/agent-tree agb-sp "root-1")
|
||||
(list "lexer-1" "lexer-1a" "parser-1"))
|
||||
true)
|
||||
|
||||
; ---- parallel session work ----
|
||||
(define
|
||||
agb-lc1
|
||||
(agentic/commit!
|
||||
agb-sp
|
||||
"lexer-1"
|
||||
"refactor"
|
||||
(merge
|
||||
(git/commit-files agb-repo (get agb-lex :genesis))
|
||||
(assoc {} "lexer.sx" "(define lexer 1)\n"))
|
||||
{:message "lexer extracted"}))
|
||||
(define
|
||||
agb-pc1
|
||||
(agentic/commit!
|
||||
agb-sp
|
||||
"parser-1"
|
||||
"refactor"
|
||||
(merge
|
||||
(git/commit-files agb-repo (get agb-par :genesis))
|
||||
(assoc {} "parser.sx" "(define parser 1)\n"))
|
||||
{:message "parser extracted"}))
|
||||
|
||||
(agentic-test
|
||||
"fork-point of sibling agents"
|
||||
(= (agentic/fork-point agb-sp "lexer-1" "parser-1") agb-c1)
|
||||
true)
|
||||
(agentic-test
|
||||
"fork-point with itself is its head"
|
||||
(= (agentic/fork-point agb-sp "lexer-1" "lexer-1") agb-lc1)
|
||||
true)
|
||||
(agentic-test
|
||||
"fork-point with unknown agent"
|
||||
(agentic/fork-point agb-sp "lexer-1" "ghost")
|
||||
nil)
|
||||
|
||||
; ---- session merge: ff-shaped history still gets a merge commit ----
|
||||
(define agb-m1 (agentic/merge-session! agb-sp "root-1" "lexer-1" {:message "absorb lexer session"}))
|
||||
|
||||
(agentic-test "session merge merges" (get agb-m1 :result) "merged")
|
||||
(agentic-test
|
||||
"merge commit has both session parents"
|
||||
(= (git/parents agb-repo (get agb-m1 :cid)) (list agb-c1 agb-lc1))
|
||||
true)
|
||||
(agentic-test
|
||||
"merge advances the into head"
|
||||
(= (agentic/head agb-sp "root-1") (get agb-m1 :cid))
|
||||
true)
|
||||
(agentic-test
|
||||
"merge commit is a session-merge"
|
||||
(agentic/commit-kind (git/read agb-repo (get agb-m1 :cid)))
|
||||
"session-merge")
|
||||
(agentic-test
|
||||
"merge names the merged agent"
|
||||
(get (git/read agb-repo (get agb-m1 :cid)) :merged-agent)
|
||||
"lexer-1")
|
||||
(agentic-test
|
||||
"merged tree carries the merged session"
|
||||
(get (git/commit-files agb-repo (get agb-m1 :cid)) "lexer.sx")
|
||||
"(define lexer 1)\n")
|
||||
(agentic-test
|
||||
"merge keeps the into briefing"
|
||||
(agentic/commit-briefing (git/read agb-repo (get agb-m1 :cid)))
|
||||
(get agb-root :briefing))
|
||||
(agentic-test
|
||||
"merges edge recorded"
|
||||
(= (agentic/merged-sessions agb-sp "root-1") (list "lexer-1"))
|
||||
true)
|
||||
(agentic-test
|
||||
"merged-into inverse"
|
||||
(= (agentic/merged-into agb-sp "lexer-1") (list "root-1"))
|
||||
true)
|
||||
(agentic-test
|
||||
"re-merge is up-to-date"
|
||||
(get (agentic/merge-session! agb-sp "root-1" "lexer-1" {}) :result)
|
||||
"up-to-date")
|
||||
|
||||
; ---- true three-way merge ----
|
||||
(define agb-m2 (agentic/merge-session! agb-sp "root-1" "parser-1" {:message "absorb parser session"}))
|
||||
|
||||
(agentic-test "three-way session merge" (get agb-m2 :result) "merged")
|
||||
(agentic-test
|
||||
"three-way tree unions the sessions"
|
||||
(get (git/commit-files agb-repo (get agb-m2 :cid)) "parser.sx")
|
||||
"(define parser 1)\n")
|
||||
(agentic-test
|
||||
"three-way tree keeps ours side"
|
||||
(get (git/commit-files agb-repo (get agb-m2 :cid)) "lexer.sx")
|
||||
"(define lexer 1)\n")
|
||||
|
||||
; ---- conflicting sessions ----
|
||||
(define
|
||||
agb-risk
|
||||
(agentic/spawn-from!
|
||||
agb-sp
|
||||
"risky-1"
|
||||
(agentic/briefing "rewrite plan" "contentious plan edit" {})
|
||||
"root-1"))
|
||||
(define agb-risk-files (git/commit-files agb-repo (get agb-risk :genesis)))
|
||||
(define
|
||||
agb-rc1
|
||||
(agentic/commit!
|
||||
agb-sp
|
||||
"risky-1"
|
||||
"decision"
|
||||
(merge agb-risk-files (assoc {} "plan.md" "risky rewrite\n"))
|
||||
{:message "risky plan"}))
|
||||
(define
|
||||
agb-rootc2
|
||||
(agentic/commit!
|
||||
agb-sp
|
||||
"root-1"
|
||||
"decision"
|
||||
(merge agb-risk-files (assoc {} "plan.md" "steady as she goes\n"))
|
||||
{:message "root plan"}))
|
||||
(define agb-mc (agentic/merge-session! agb-sp "root-1" "risky-1" {:message "risky merge"}))
|
||||
|
||||
(agentic-test
|
||||
"conflicting sessions surface conflicts"
|
||||
(get agb-mc :result)
|
||||
"conflicts")
|
||||
(agentic-test
|
||||
"conflict paths name the file"
|
||||
(= (get agb-mc :conflicts) (list "plan.md"))
|
||||
true)
|
||||
(agentic-test
|
||||
"conflicted merge commits nothing"
|
||||
(= (agentic/head agb-sp "root-1") agb-rootc2)
|
||||
true)
|
||||
|
||||
(define
|
||||
agb-res
|
||||
(agentic/merge-resolve!
|
||||
agb-sp
|
||||
"root-1"
|
||||
"risky-1"
|
||||
(merge
|
||||
agb-risk-files
|
||||
(assoc {} "plan.md" "steady, with one risky idea\n"))
|
||||
{:message "negotiated"}))
|
||||
|
||||
(agentic-test
|
||||
"merge-resolve! concludes the merge"
|
||||
(get agb-res :result)
|
||||
"merged")
|
||||
(agentic-test
|
||||
"resolution advances the head"
|
||||
(= (agentic/head agb-sp "root-1") (get agb-res :cid))
|
||||
true)
|
||||
(agentic-test
|
||||
"resolution has both parents"
|
||||
(= (git/parents agb-repo (get agb-res :cid)) (list agb-rootc2 agb-rc1))
|
||||
true)
|
||||
(agentic-test
|
||||
"resolved content wins"
|
||||
(get (git/commit-files agb-repo (get agb-res :cid)) "plan.md")
|
||||
"steady, with one risky idea\n")
|
||||
|
||||
; ---- reviews + edge isolation ----
|
||||
(agentic/reviews! agb-sp "parser-1" "lexer-1")
|
||||
|
||||
(agentic-test
|
||||
"reviewers edge"
|
||||
(= (agentic/reviewers agb-sp "lexer-1") (list "parser-1"))
|
||||
true)
|
||||
(agentic-test
|
||||
"reviewing inverse"
|
||||
(= (agentic/reviewing agb-sp "parser-1") (list "lexer-1"))
|
||||
true)
|
||||
(agentic-test
|
||||
"edge kinds are isolated"
|
||||
(= (agentic/sub-agents agb-sp "parser-1") (list))
|
||||
true)
|
||||
Reference in New Issue
Block a user