tx: resolve ref values before type validation (tempid/nested-map/lookup refs)
ober
67bb9927f6f7a1d85c697efd189814b928696a2a
--- a/lib/jerboa-db/tx.ss +++ b/lib/jerboa-db/tx.ss @@ -257,15 +257,41 @@ ;; For now, error on unknown attributes (error 'transact! (format "Unknown attribute: ~a" attr-ident))) - (let ([aid (db-attribute-id attr)] - [cval (coerce-value (db-attribute-value-type attr) val)]) - ;; Validate - (unless (value-matches-type? (db-attribute-value-type attr) cval) + (let* ([aid (db-attribute-id attr)] + [cval (coerce-value (db-attribute-value-type attr) val)] + ;; Resolve ref values to an eid BEFORE validating, so that + ;; tempids, nested component maps, and lookup refs are all + ;; accepted — and so the uniqueness / cardinality-one checks + ;; compare against the resolved entity id, not the raw form. + ;; - nested map (alist): recursively process, use child eid + ;; - lookup ref (attr value): resolve via unique attribute + ;; - tempid: resolve to its permanent eid + [final-val + (cond + [(and (ref-type? attr) + (db-attribute-is-component? attr) + (pair? cval) + (pair? (car cval)) + (symbol? (caar cval))) + (let ([child-eid (resolve-eid (cond [(assq 'db/id cval) => cdr] + [else #f]))]) + (process-entity-map! + (cons (cons 'db/id child-eid) + (filter (lambda (p) (not (eq? (car p) 'db/id))) cval))) + child-eid)] + [(and (ref-type? attr) (pair? cval) + (symbol? (car cval)) (= (length cval) 2)) + (resolve-eid cval)] + [(and (ref-type? attr) (tempid? cval)) + (resolve-eid cval)] + [else cval])]) + ;; Validate the resolved value + (unless (value-matches-type? (db-attribute-value-type attr) final-val) (error 'transact! (format "Type mismatch for ~a: expected ~a, got ~a" - attr-ident (db-attribute-value-type attr) cval))) + attr-ident (db-attribute-value-type attr) final-val))) ;; Check uniqueness - (check-unique-value! attr eid cval) + (check-unique-value! attr eid final-val) ;; Cardinality/one: auto-retract old value. ;; For freshly-allocated entities (eid >= initial-next-eid) no ;; index value can exist — skip the expensive EAVT scan and only @@ -274,37 +300,9 @@ (let ([old (or (tx-current-value eid aid) (and (< eid initial-next-eid) (current-value eid aid)))]) - (when (and old (not (equal? (datom-v old) cval))) + (when (and old (not (equal? (datom-v old) final-val))) (emit-datom! eid aid (datom-v old) #f)))) - ;; Handle ref values: - ;; - tempids: resolve to permanent eid - ;; - nested maps (alists): recursively process, use child eid - ;; - lookup refs: resolve via unique attribute - (let ([final-val - (cond - ;; Nested map: ref-type + component + value is an alist - [(and (ref-type? attr) - (db-attribute-is-component? attr) - (pair? cval) - (pair? (car cval)) - (symbol? (caar cval))) - ;; Process nested entity map, get its eid - (let ([child-eid (resolve-eid (cond [(assq 'db/id cval) => cdr] - [else #f]))]) - ;; Process the nested map - (process-entity-map! - (cons (cons 'db/id child-eid) - (filter (lambda (p) (not (eq? (car p) 'db/id))) cval))) - child-eid)] - ;; Lookup ref in value position - [(and (ref-type? attr) (pair? cval) - (symbol? (car cval)) (= (length cval) 2)) - (resolve-eid cval)] - ;; Tempid in value position - [(and (ref-type? attr) (tempid? cval)) - (resolve-eid cval)] - [else cval])]) - (emit-datom! eid aid final-val #t))))) + (emit-datom! eid aid final-val #t)))) other-pairs))) (define (process-add! eid-raw attr-ident val) --- a/tests/test-core.ss +++ b/tests/test-core.ss @@ -810,6 +810,27 @@ (assert-equal (q '((find ?l) (where (?l line/sku "A"))) d2) '()) (assert-equal (q '((find ?x) (where (?x detail/note "N"))) d2) '()))))))) +(test "tempid and nested-map ref values resolve and validate" + (let ([conn (connect ":memory:")]) + (transact! conn + (list '((db/ident . n/name) (db/valueType . db.type/string) (db/cardinality . db.cardinality/one)) + '((db/ident . n/friend) (db/valueType . db.type/ref) (db/cardinality . db.cardinality/one)) + '((db/ident . n/child) (db/valueType . db.type/ref) (db/cardinality . db.cardinality/one) (db/isComponent . #t)))) + ;; tempid in a ref value: A's friend = B (tempid), resolved within the tx + (let* ([a (tempid)] [b (tempid)] + [r (transact! conn (list `((db/id . ,a) (n/name . "A") (n/friend . ,b)) + `((db/id . ,b) (n/name . "B"))))] + [a-eid (cdr (assv a (tx-report-tempids r)))] + [b-eid (cdr (assv b (tx-report-tempids r)))] + [d (db conn)]) + (assert-equal (caar (q '((find ?f) (in $ ?e) (where (?e n/friend ?f))) d a-eid)) b-eid)) + ;; nested map in a component ref value: parent with an inline child entity + (transact! conn (list '((n/name . "P") (n/child . ((n/name . "C")))))) + (let* ([d (db conn)] + [p-eid (caar (q '((find ?e) (where (?e n/name "P"))) d))] + [c-eid (caar (q '((find ?e) (where (?e n/name "C"))) d))]) + (assert-equal (caar (q '((find ?c) (in $ ?p) (where (?p n/child ?c))) d p-eid)) c-eid)))) + ;; ============================================================ ;; Report ;; ============================================================