;; lib/prolog/tests/hs_bridge.sx — tests for Prolog↔Hyperscript bridge ;; ;; Verifies pl-hs-query, pl-hs-predicate/N, and pl-hs-install. ;; Also demonstrates the end-to-end DSL pattern: ;; (define allowed (pl-hs-predicate/2 db "allowed")) ;; → (allowed "alice" "edit") is what Hyperscript compiles ;; `when allowed(alice, edit)` to. (define pl-hsb-test-count 0) (define pl-hsb-test-pass 0) (define pl-hsb-test-fail 0) (define pl-hsb-test-failures (list)) (define pl-hsb-test! (fn (name got expected) (begin (set! pl-hsb-test-count (+ pl-hsb-test-count 1)) (if (= got expected) (set! pl-hsb-test-pass (+ pl-hsb-test-pass 1)) (begin (set! pl-hsb-test-fail (+ pl-hsb-test-fail 1)) (append! pl-hsb-test-failures (str name "\n expected: " expected "\n got: " got))))))) ;; ── shared KB ── (define pl-hsb-perm-src "role(alice, admin). role(bob, editor). role(charlie, viewer). permission(admin, read). permission(admin, write). permission(admin, delete). permission(editor, read). permission(editor, write). permission(viewer, read). allowed(U, A) :- role(U, R), permission(R, A).") (define pl-hsb-db (pl-load pl-hsb-perm-src)) ;; ── pl-hs-query ── (pl-hsb-test! "pl-hs-query: ground fact succeeds" (pl-hs-query pl-hsb-db "role(alice, admin)") true) (pl-hsb-test! "pl-hs-query: absent fact fails" (pl-hs-query pl-hsb-db "role(alice, viewer)") false) (pl-hsb-test! "pl-hs-query: rule derivation succeeds" (pl-hs-query pl-hsb-db "allowed(alice, delete)") true) (pl-hsb-test! "pl-hs-query: rule derivation fails" (pl-hs-query pl-hsb-db "allowed(charlie, delete)") false) (pl-hsb-test! "pl-hs-query: arithmetic goal" (pl-hs-query pl-hsb-db "X is 3 + 4, X = 7") true) ;; ── pl-hs-predicate/2 ── (define pl-hsb-allowed (pl-hs-predicate/2 pl-hsb-db "allowed")) (pl-hsb-test! "predicate/2: alice can read" (pl-hsb-allowed "alice" "read") true) (pl-hsb-test! "predicate/2: alice can delete" (pl-hsb-allowed "alice" "delete") true) (pl-hsb-test! "predicate/2: charlie cannot write" (pl-hsb-allowed "charlie" "write") false) (pl-hsb-test! "predicate/2: bob can write" (pl-hsb-allowed "bob" "write") true) (pl-hsb-test! "predicate/2: unknown user fails" (pl-hsb-allowed "eve" "read") false) ;; ── DSL simulation ── ;; Hyperscript compiles `when allowed(user, action) then …` ;; to `(allowed user action)` — a direct SX function call. ;; Here we verify that pattern works end-to-end. (define pl-hsb-user "alice") (define pl-hsb-action "write") (pl-hsb-test! "DSL simulation: (allowed user action) true path" (pl-hsb-allowed pl-hsb-user pl-hsb-action) true) (define pl-hsb-user2 "charlie") (pl-hsb-test! "DSL simulation: (allowed user action) false path" (pl-hsb-allowed pl-hsb-user2 pl-hsb-action) false) ;; ── pl-hs-predicate/1 ── (define pl-hsb-viewer-src "color(red). color(green). color(blue).") (define pl-hsb-color-db (pl-load pl-hsb-viewer-src)) (define pl-hsb-color? (pl-hs-predicate/1 pl-hsb-color-db "color")) (pl-hsb-test! "predicate/1: color(red) succeeds" (pl-hsb-color? "red") true) (pl-hsb-test! "predicate/1: color(purple) fails" (pl-hsb-color? "purple") false) ;; ── pl-hs-predicate/3 ── (define pl-hsb-3ary-src "between_vals(X, Lo, Hi) :- X >= Lo, X =< Hi.") (define pl-hsb-3ary-db (pl-load pl-hsb-3ary-src)) (define pl-hsb-in-range? (pl-hs-predicate/3 pl-hsb-3ary-db "between_vals")) (pl-hsb-test! "predicate/3: 5 in range [1,10]" (pl-hsb-in-range? "5" "1" "10") true) (pl-hsb-test! "predicate/3: 15 not in range [1,10]" (pl-hsb-in-range? "15" "1" "10") false) ;; ── pl-hs-install ── (define pl-hsb-installed (pl-hs-install pl-hsb-db (list (list "allowed" 2) (list "role" 2) (list "permission" 2)))) (pl-hsb-test! "pl-hs-install: returns dict with allowed key" (not (nil? (dict-get pl-hsb-installed "allowed"))) true) (pl-hsb-test! "pl-hs-install: installed allowed fn works" ((dict-get pl-hsb-installed "allowed") "alice" "delete") true) (pl-hsb-test! "pl-hs-install: installed role fn works" ((dict-get pl-hsb-installed "role") "bob" "editor") true) (define pl-hs-bridge-tests-run! (fn () {:failed pl-hsb-test-fail :passed pl-hsb-test-pass :total pl-hsb-test-count :failures pl-hsb-test-failures}))