giles
eff216ef40
Type registry (briefing / console-trace / behaviour TAG / agent-commit + spawn/finding/refactor/test/session-merge/decision subtypes) with reflexive transitive is-a? and create-only register-type!. Agent commits ARE git commits (:agent-type rides as an open field, participates in the CID, DAG machinery applies unchanged). 65/65. Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
326 lines
9.0 KiB
Plaintext
326 lines
9.0 KiB
Plaintext
; Phase 1 — schema: agentic object types as content-addressed typed objects
|
|
; over the sx-git store. Fixture: one repo, one briefing, a spawn genesis
|
|
; commit + a finding child (both real git commits), a console trace bound to
|
|
; the genesis by cid, a behaviour tag object. Reused as the assertion target.
|
|
|
|
(define ag-fix-db (persist/mem-backend))
|
|
(define ag-fix-repo (git/repo-named ag-fix-db "agentic-test"))
|
|
|
|
(define
|
|
ag-fix-briefing
|
|
(agentic/briefing "harden parser" "find tokenizer edge cases" {:author "giles"}))
|
|
(define ag-fix-briefing-cid (git/write ag-fix-repo ag-fix-briefing))
|
|
|
|
(define
|
|
ag-fix-tree-cid
|
|
(git/tree-from-files ag-fix-repo (assoc {} "notes.md" "start\n")))
|
|
|
|
(define
|
|
ag-fix-genesis
|
|
(agentic/agent-commit ag-fix-tree-cid (list) "spawn" {:message "genesis" :agent "agent-1" :briefing ag-fix-briefing-cid}))
|
|
(define ag-fix-genesis-cid (git/write ag-fix-repo ag-fix-genesis))
|
|
|
|
(define
|
|
ag-fix-finding
|
|
(agentic/agent-commit
|
|
ag-fix-tree-cid
|
|
(list ag-fix-genesis-cid)
|
|
"finding"
|
|
{:message "found tokenizer bug" :behaviour-cid "sx1:beefbeef" :agent "agent-1" :briefing ag-fix-briefing-cid}))
|
|
(define ag-fix-finding-cid (git/write ag-fix-repo ag-fix-finding))
|
|
|
|
(define
|
|
ag-fix-trace
|
|
(agentic/console-trace
|
|
(list
|
|
(agentic/trace-entry "console" "$ run tests")
|
|
(agentic/trace-entry "tool" "sx_eval (+ 1 2)"))
|
|
{:commit ag-fix-genesis-cid}))
|
|
(define ag-fix-trace-cid (git/write ag-fix-repo ag-fix-trace))
|
|
|
|
(define
|
|
ag-fix-behaviour
|
|
(agentic/behaviour "tdd-loop" "(red green refactor)" {}))
|
|
|
|
; ---- type registry ----
|
|
(agentic-test "briefing is a registered type" (agentic/type? "briefing") true)
|
|
(agentic-test
|
|
"console-trace is a registered type"
|
|
(agentic/type? "console-trace")
|
|
true)
|
|
(agentic-test "behaviour TAG is registered" (agentic/type? "behaviour") true)
|
|
(agentic-test
|
|
"agent-commit base is registered"
|
|
(agentic/type? "agent-commit")
|
|
true)
|
|
(agentic-test
|
|
"all commit subtypes registered"
|
|
(every?
|
|
(fn (n) (agentic/type? n))
|
|
(list "spawn" "finding" "refactor" "test" "session-merge" "decision"))
|
|
true)
|
|
(agentic-test
|
|
"unknown type is not registered"
|
|
(agentic/type? "frobnicate")
|
|
false)
|
|
(agentic-test "type? is nil-safe" (agentic/type? nil) false)
|
|
(agentic-test
|
|
"finding's parent is agent-commit"
|
|
(agentic/type-parent "finding")
|
|
"agent-commit")
|
|
(agentic-test
|
|
"agent-commit has no parent"
|
|
(agentic/type-parent "agent-commit")
|
|
nil)
|
|
(agentic-test
|
|
"is-a? walks subtype to base"
|
|
(agentic/is-a? "finding" "agent-commit")
|
|
true)
|
|
(agentic-test "is-a? is reflexive" (agentic/is-a? "finding" "finding") true)
|
|
(agentic-test
|
|
"is-a? rejects unrelated types"
|
|
(agentic/is-a? "finding" "briefing")
|
|
false)
|
|
(agentic-test
|
|
"object types are not commit kinds"
|
|
(agentic/is-a? "briefing" "agent-commit")
|
|
false)
|
|
(agentic-test
|
|
"commit-kind? on a subtype"
|
|
(agentic/commit-kind? "decision")
|
|
true)
|
|
(agentic-test
|
|
"commit-kind? rejects object types"
|
|
(agentic/commit-kind? "briefing")
|
|
false)
|
|
(agentic-test
|
|
"commit-kinds sorted"
|
|
(=
|
|
(agentic/commit-kinds)
|
|
(list
|
|
"agent-commit"
|
|
"decision"
|
|
"finding"
|
|
"refactor"
|
|
"session-merge"
|
|
"spawn"
|
|
"test"))
|
|
true)
|
|
(agentic-test
|
|
"register-type! extends the registry"
|
|
(begin
|
|
(agentic/register-type!
|
|
"review"
|
|
"agent-commit"
|
|
"commit"
|
|
"review of another session")
|
|
(agentic/type? "review"))
|
|
true)
|
|
(agentic-test
|
|
"registered subtype is-a agent-commit"
|
|
(agentic/is-a? "review" "agent-commit")
|
|
true)
|
|
(agentic-test
|
|
"register-type! is create-only"
|
|
(agentic/register-type! "finding" "agent-commit" "commit" "dup")
|
|
nil)
|
|
(agentic-test
|
|
"register-type! requires an existing parent"
|
|
(agentic/register-type! "orphan" "no-such-base" "commit" "x")
|
|
nil)
|
|
|
|
; ---- briefing ----
|
|
(agentic-test "briefing is typed" (get ag-fix-briefing :type) "briefing")
|
|
(agentic-test
|
|
"briefing? true on briefing"
|
|
(agentic/briefing? ag-fix-briefing)
|
|
true)
|
|
(agentic-test
|
|
"briefing? false on commit"
|
|
(agentic/briefing? ag-fix-genesis)
|
|
false)
|
|
(agentic-test
|
|
"briefing title accessor"
|
|
(agentic/briefing-title ag-fix-briefing)
|
|
"harden parser")
|
|
(agentic-test
|
|
"briefing goal accessor"
|
|
(agentic/briefing-goal ag-fix-briefing)
|
|
"find tokenizer edge cases")
|
|
(agentic-test
|
|
"briefing open meta round-trips"
|
|
(get ag-fix-briefing :author)
|
|
"giles")
|
|
(agentic-test
|
|
"briefing protected keys win over meta"
|
|
(agentic/briefing-title (agentic/briefing "real" "g" {:type "hack" :title "fake"}))
|
|
"real")
|
|
(agentic-test
|
|
"briefing cid is deterministic"
|
|
(=
|
|
ag-fix-briefing-cid
|
|
(git/cid
|
|
(agentic/briefing "harden parser" "find tokenizer edge cases" {:author "giles"})))
|
|
true)
|
|
(agentic-test
|
|
"briefing cid differs by goal"
|
|
(=
|
|
ag-fix-briefing-cid
|
|
(git/cid (agentic/briefing "harden parser" "other goal" {:author "giles"})))
|
|
false)
|
|
(agentic-test
|
|
"briefing cid carries the native scheme"
|
|
(starts-with? ag-fix-briefing-cid "sx1:")
|
|
true)
|
|
(agentic-test
|
|
"briefing round-trips through the store"
|
|
(agentic/briefing? (git/read ag-fix-repo ag-fix-briefing-cid))
|
|
true)
|
|
(agentic-test
|
|
"stored briefing title survives"
|
|
(agentic/briefing-title (git/read ag-fix-repo ag-fix-briefing-cid))
|
|
"harden parser")
|
|
(agentic-test
|
|
"git/object-type sees the briefing type"
|
|
(git/object-type (git/read ag-fix-repo ag-fix-briefing-cid))
|
|
"briefing")
|
|
|
|
; ---- agent-commit ----
|
|
(agentic-test
|
|
"agent-commit IS a git commit"
|
|
(git/commit? ag-fix-genesis)
|
|
true)
|
|
(agentic-test
|
|
"agent-commit? true on agent commit"
|
|
(agentic/agent-commit? ag-fix-genesis)
|
|
true)
|
|
(agentic-test
|
|
"agent-commit? false on plain git commit"
|
|
(agentic/agent-commit? (git/commit ag-fix-tree-cid (list) {:message "plain"}))
|
|
false)
|
|
(agentic-test
|
|
"agent-commit? false on briefing"
|
|
(agentic/agent-commit? ag-fix-briefing)
|
|
false)
|
|
(agentic-test
|
|
"commit-kind reads the subtype"
|
|
(agentic/commit-kind ag-fix-genesis)
|
|
"spawn")
|
|
(agentic-test
|
|
"kind-of? walks to the base"
|
|
(agentic/kind-of? ag-fix-finding "agent-commit")
|
|
true)
|
|
(agentic-test
|
|
"kind-of? exact kind"
|
|
(agentic/kind-of? ag-fix-finding "finding")
|
|
true)
|
|
(agentic-test
|
|
"kind-of? rejects a sibling kind"
|
|
(agentic/kind-of? ag-fix-finding "refactor")
|
|
false)
|
|
(agentic-test
|
|
"unknown kind is rejected"
|
|
(agentic/agent-commit ag-fix-tree-cid (list) "frobnicate" {})
|
|
nil)
|
|
(agentic-test
|
|
"object type rejected as commit kind"
|
|
(agentic/agent-commit ag-fix-tree-cid (list) "briefing" {})
|
|
nil)
|
|
(agentic-test
|
|
"commit-briefing links the genesis briefing"
|
|
(agentic/commit-briefing ag-fix-finding)
|
|
ag-fix-briefing-cid)
|
|
(agentic-test
|
|
"linked briefing reads back as a briefing"
|
|
(agentic/briefing?
|
|
(git/read ag-fix-repo (agentic/commit-briefing ag-fix-finding)))
|
|
true)
|
|
(agentic-test
|
|
"commit-agent accessor"
|
|
(agentic/commit-agent ag-fix-finding)
|
|
"agent-1")
|
|
(agentic-test
|
|
"behaviour-cid rides an agent-commit"
|
|
(agentic/commit-behaviour ag-fix-finding)
|
|
"sx1:beefbeef")
|
|
(agentic-test
|
|
"agentic fields participate in the cid"
|
|
(=
|
|
ag-fix-genesis-cid
|
|
(git/cid (git/commit ag-fix-tree-cid (list) {:message "genesis"})))
|
|
false)
|
|
(agentic-test
|
|
"stored agent-commit round-trips its kind"
|
|
(agentic/commit-kind (git/read ag-fix-repo ag-fix-genesis-cid))
|
|
"spawn")
|
|
(agentic-test
|
|
"git message accessor still applies"
|
|
(git/commit-message ag-fix-finding)
|
|
"found tokenizer bug")
|
|
(agentic-test
|
|
"agent-commit participates in the DAG"
|
|
(= (git/parents ag-fix-repo ag-fix-finding-cid) (list ag-fix-genesis-cid))
|
|
true)
|
|
(agentic-test
|
|
"log walks agent commits newest first"
|
|
(=
|
|
(git/log ag-fix-repo ag-fix-finding-cid)
|
|
(list ag-fix-finding-cid ag-fix-genesis-cid))
|
|
true)
|
|
|
|
; ---- console-trace ----
|
|
(agentic-test "trace is typed" (get ag-fix-trace :type) "console-trace")
|
|
(agentic-test
|
|
"console-trace? true on trace"
|
|
(agentic/console-trace? ag-fix-trace)
|
|
true)
|
|
(agentic-test
|
|
"console-trace? false on briefing"
|
|
(agentic/console-trace? ag-fix-briefing)
|
|
false)
|
|
(agentic-test
|
|
"trace holds its entries"
|
|
(len (agentic/trace-entries ag-fix-trace))
|
|
2)
|
|
(agentic-test
|
|
"trace entry kind"
|
|
(get (nth (agentic/trace-entries ag-fix-trace) 0) :kind)
|
|
"console")
|
|
(agentic-test
|
|
"trace entry text"
|
|
(get (nth (agentic/trace-entries ag-fix-trace) 1) :text)
|
|
"sx_eval (+ 1 2)")
|
|
(agentic-test
|
|
"trace names its commit by cid"
|
|
(get ag-fix-trace :commit)
|
|
ag-fix-genesis-cid)
|
|
(agentic-test
|
|
"trace cid is deterministic"
|
|
(=
|
|
ag-fix-trace-cid
|
|
(git/cid
|
|
(agentic/console-trace
|
|
(list
|
|
(agentic/trace-entry "console" "$ run tests")
|
|
(agentic/trace-entry "tool" "sx_eval (+ 1 2)"))
|
|
{:commit ag-fix-genesis-cid})))
|
|
true)
|
|
(agentic-test
|
|
"trace round-trips through the store"
|
|
(agentic/console-trace? (git/read ag-fix-repo ag-fix-trace-cid))
|
|
true)
|
|
|
|
; ---- behaviour (TAG only — library HELD Phase 8) ----
|
|
(agentic-test "behaviour is typed" (get ag-fix-behaviour :type) "behaviour")
|
|
(agentic-test
|
|
"behaviour? true on behaviour"
|
|
(agentic/behaviour? ag-fix-behaviour)
|
|
true)
|
|
(agentic-test
|
|
"behaviour tag is an object type"
|
|
(agentic/type-kind "behaviour")
|
|
"object")
|
|
(agentic-test
|
|
"behaviour is content-addressable"
|
|
(starts-with? (git/cid ag-fix-behaviour) "sx1:")
|
|
true) |