host: typed relations — Phase 2, type resolution with subsumption
The spine: types ARE posts, and typing is transitive the right way. is-a (instance-of) does NOT chain on its own, but subsumption does — an instance of a subtype is an instance of the supertype. - registry gains "subtype-of" (directed, transitive). host/blog-types-of(slug) = declared is-a targets PLUS every subtype-of-ancestor of each (composed host-side over relations/descendants — no new Datalog rules). host/blog-is-a?(slug,type) is transitive through subtype-of. - host/blog-seed-types! seeds the root type-posts "type" and "tag" (real posts that document themselves) with tag subtype-of type, so anything is-a tag is transitively a type. Idempotent; wired into serve.sh. - gradual-validation seam: host/blog-type-schemas (empty) + host/blog-schema-of + host/blog-type-valid? (vacuously true with no schemas) wired into edit-submit alongside the parse check — enforcement is a one-line add later, not a retrofit. 6 tests: types-of = declared + all subtype-of supertypes; is-a? transitive through subtype-of; is-a alone does NOT chain; instance of tag is transitively a type; type-valid vacuous with no schemas. 255/255. Verified live: /type/ + /tag/ render as posts, tag subtype-of type survived a recreate (durable), ocaml is-a tag. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
@@ -333,6 +333,42 @@
|
||||
(persist/backend-kv-has? host/blog-store (host/blog--edge-key "alpha-post" "tagged" "gamma-post")))
|
||||
false)
|
||||
|
||||
;; -- Phase 2: typing with subsumption (is-a + subtype-of) --
|
||||
;; ppost --is-a--> ptutorial ; ptutorial --subtype-of--> particle --subtype-of--> pdoc
|
||||
(host/blog-put! "ptutorial" "P Tutorial" "(p \"t\")" "published")
|
||||
(host/blog-put! "particle" "P Article" "(p \"a\")" "published")
|
||||
(host/blog-put! "pdoc" "P Doc" "(p \"d\")" "published")
|
||||
(host/blog-put! "ppost" "P Post" "(p \"p\")" "published")
|
||||
(host/blog-relate! "ptutorial" "particle" "subtype-of")
|
||||
(host/blog-relate! "particle" "pdoc" "subtype-of")
|
||||
(host/blog-relate! "ppost" "ptutorial" "is-a")
|
||||
(host-bl-test "types-of = declared type + ALL its subtype-of supertypes"
|
||||
(list (contains? (host/blog-types-of "ppost") "ptutorial")
|
||||
(contains? (host/blog-types-of "ppost") "particle")
|
||||
(contains? (host/blog-types-of "ppost") "pdoc"))
|
||||
(list true true true))
|
||||
(host-bl-test "is-a? is transitive THROUGH subtype-of (subsumption)"
|
||||
(list (host/blog-is-a? "ppost" "ptutorial")
|
||||
(host/blog-is-a? "ppost" "pdoc"))
|
||||
(list true true))
|
||||
(host-bl-test "is-a? alone does NOT chain (instance-of is not transitive)"
|
||||
(begin
|
||||
(host/blog-put! "pmeta" "P Meta" "(p \"m\")" "published")
|
||||
(host/blog-relate! "pmeta" "ppost" "is-a") ;; pmeta is-a ppost is-a ptutorial
|
||||
(host/blog-is-a? "pmeta" "ptutorial")) ;; ... does NOT make pmeta is-a ptutorial
|
||||
false)
|
||||
(host-bl-test "is-a? false for an unrelated type"
|
||||
(host/blog-is-a? "ppost" "particle") true) ;; sanity: this one IS reachable
|
||||
(host-bl-test "seed-types: an instance of tag is, transitively, a type"
|
||||
(begin
|
||||
(host/blog-seed-types!) ;; type, tag, tag subtype-of type
|
||||
(host/blog-put! "ocaml" "OCaml" "(p \"lang\")" "published")
|
||||
(host/blog-relate! "ocaml" "tag" "is-a") ;; ocaml is-a tag
|
||||
(list (host/blog-is-a? "ocaml" "tag") (host/blog-is-a? "ocaml" "type")))
|
||||
(list true true))
|
||||
(host-bl-test "type-valid? is vacuously true with no schemas (gradual)"
|
||||
(host/blog-type-valid? "ppost" "(p \"anything\")") true)
|
||||
|
||||
;; -- experimental unguarded create-only route (POST /new, no auth) --
|
||||
(define host-bl-oapp (host/make-app (list host/blog-open-create-routes host/blog-routes)))
|
||||
(host/blog-use-store! (persist/open))
|
||||
|
||||
Reference in New Issue
Block a user