schema: make :db/ident unique/identity (idempotent schema upsert)
Jaime Fournier <jaimef@linbsd.org>
9c2c510fe4cd68e98ea2c0ffc0e86a4670e2c3ad
diff --git a/lib/jerboa-db/schema.ss b/lib/jerboa-db/schema.ss
index 37df119..6f21be6 100644
--- a/lib/jerboa-db/schema.ss
+++ b/lib/jerboa-db/schema.ss
@@ -140,11 +140,14 @@
;; ---- Bootstrap built-in schema attributes ----
(def (bootstrap-schema! reg)
- (define (install! id ident vtype card)
- (let ([attr (make-db-attribute ident id vtype card #f #t #f #f #f #f #f)])
+ (define (install! id ident vtype card . opt)
+ (let* ([uniq (if (pair? opt) (car opt) #f)]
+ [attr (make-db-attribute ident id vtype card uniq #t #f #f #f #f #f)])
(schema-install-attribute! reg attr)))
- ;; Reserve IDs 0-19 for system attributes
- (install! 0 +db/ident+ 'db.type/keyword 'db.cardinality/one)
+ ;; Reserve IDs 0-19 for system attributes.
+ ;; :db/ident is unique/identity so re-transacting a schema attribute upserts
+ ;; (idempotent) and reassigning a keyword raises a uniqueness conflict.
+ (install! 0 +db/ident+ 'db.type/keyword 'db.cardinality/one 'db.unique/identity)
(install! 1 +db/valueType+ 'db.type/keyword 'db.cardinality/one)
(install! 2 +db/cardinality+ 'db.type/keyword 'db.cardinality/one)
(install! 3 +db/unique+ 'db.type/keyword 'db.cardinality/one)
diff --git a/tests/test-core.ss b/tests/test-core.ss
index 3f1724b..3096510 100644
--- a/tests/test-core.ss
+++ b/tests/test-core.ss
@@ -846,6 +846,17 @@
(transact! conn (list `(db/add ,red-eid db/ident color/red)))
(assert-equal (caar (q '((find ?e) (where (?e db/ident color/red))) (db conn))) red-eid))))
+(test ":db/ident unique/identity: re-transacting an attribute upserts (idempotent)"
+ (let ([conn (connect ":memory:")])
+ (transact! conn
+ (list '((db/ident . app/title) (db/valueType . db.type/string) (db/cardinality . db.cardinality/one))))
+ (let ([eid1 (caar (q '((find ?e) (where (?e db/ident app/title))) (db conn)))])
+ ;; re-transacting the same ident upserts to the same entity (no duplicate)
+ (transact! conn (list '((db/ident . app/title) (db/doc . "the title"))))
+ (let ([rows (q '((find ?e) (where (?e db/ident app/title))) (db conn))])
+ (assert-equal (length rows) 1)
+ (assert-equal (caar rows) eid1)))))
+
;; ============================================================
;; Report
;; ============================================================