added mermaid and a lot of cmap changes

private/cmap-storage.rkt

@@ -6,12 +6,17 @@
 
 (require db
          json
+         racket/list
          racket/string
+         "concept-id.rkt"
          "database.rkt"
+         "people.rkt"
          "storage.rkt")
 
 (provide list-concept-maps
+         list-archived-concept-maps
          list-concept-usage
+         list-concept-todos
          list-recent-concept-maps
          search-concept-maps
          read-concept-map
@@ -21,7 +26,8 @@
          create-concept-map!
          rename-concept-map!
          update-concept-map!
-         archive-concept-map!)
+         archive-concept-map!
+         restore-concept-map!)
 
 (define maximum-document-size (* 10 1024 1024))
 
@@ -51,6 +57,210 @@
       (error 'text->document "stored concept map document is not a JSON object"))
     document))
 
+(define (document-concepts document)
+  (define concepts (hash-ref document 'concepts '()))
+  (if (list? concepts) concepts '()))
+
+(define concept-content-keys
+  '(id label synopsis aspects tags descriptionPageSlug pageSlug cmapSlug externalUrl
+       imageSource))
+
+(define placement-content-keys
+  '(label synopsis aspects tags descriptionPageSlug pageSlug cmapSlug externalUrl
+          imageSource))
+
+(define (valid-external-url? value)
+  (and (string? value)
+       (regexp-match? #px"(?i:^https?://[^\\s]+$)" value)))
+
+(define (concept-content concept)
+  (when (and (hash-has-key? concept 'externalUrl)
+             (let ([value (hash-ref concept 'externalUrl)])
+               (and value
+                    (not (eq? value 'null))
+                    (not (and (string? value) (string=? value "")))
+                    (not (valid-external-url? value)))))
+    (error 'concept-content "externalUrl must be a complete http or https URL"))
+  (for/fold ([content (hash)]) ([key (in-list concept-content-keys)]
+                                #:when (hash-has-key? concept key))
+    (hash-set content key
+              (if (eq? key 'tags)
+                  (let ([tags (hash-ref concept key)])
+                    (if (list? tags)
+                        (filter (λ (tag)
+                                  (and (hash? tag)
+                                       (equal? (hash-ref tag 'type #f) "person")))
+                                tags)
+                        '()))
+                  (hash-ref concept key)))))
+
+(define (document-item-concept-ids document)
+  (remove-duplicates
+   (for/list ([item (in-list (let ([items (hash-ref document 'items '())])
+                               (if (list? items) items '())))]
+              #:when (and (hash? item)
+                          (string? (hash-ref item 'conceptId #f))
+                          (not (equal? (hash-ref item 'kind "concept") "phrase"))))
+     (hash-ref item 'conceptId))))
+
+(define (remove-hash-keys value keys)
+  (for/fold ([result value]) ([key (in-list keys)])
+    (hash-remove result key)))
+
+;; A persisted CMap owns structure and presentation only. Full concept content
+;; is stored once, in concept_definitions. The concepts array is retained as an
+;; explicit set of references so the JSON document remains self-describing.
+(define (concept-map-storage-document document)
+  (define items (hash-ref document 'items '()))
+  (define placement-items
+    (for/list ([item (in-list (if (list? items) items '()))])
+      (if (and (hash? item)
+               (not (equal? (hash-ref item 'kind "concept") "phrase")))
+          (remove-hash-keys item placement-content-keys)
+          item)))
+  (define concept-ids
+    (remove-duplicates
+     (append
+      (for/list ([concept (in-list (document-concepts document))]
+                 #:when (and (hash? concept)
+                             (string? (hash-ref concept 'id #f))
+                             (not (string=? (hash-ref concept 'id) ""))))
+        (hash-ref concept 'id))
+      (document-item-concept-ids document))))
+  (for ([concept-id (in-list concept-ids)])
+    (unless (concept-id? concept-id)
+      (error 'concept-map-storage-document "invalid concept UUID: ~a" concept-id)))
+  (hash-set
+   (hash-set document 'items placement-items)
+   'concepts
+   (for/list ([concept-id (in-list concept-ids)])
+     (hash 'id concept-id))))
+
+(define (concept-definition-by-id db concept-id)
+  (define row
+    (query-maybe-row
+     db
+     "SELECT document::text FROM concept_definitions WHERE id = $1"
+     concept-id))
+  (and row (concept-content (text->document (vector-ref row 0)))))
+
+(define (document-concept-id-map db document)
+  (define concepts-by-id
+    (for/hash ([concept (in-list (document-concepts document))]
+               #:when (and (hash? concept) (string? (hash-ref concept 'id #f))))
+      (values (hash-ref concept 'id) concept)))
+  (define items (hash-ref document 'items '()))
+  (define sources
+    (append
+     (document-concepts document)
+     (for/list ([item (in-list (if (list? items) items '()))]
+                #:when (and (hash? item) (string? (hash-ref item 'conceptId #f))))
+       (hash-set item 'id (hash-ref item 'conceptId)))))
+  (define by-name (make-hash))
+  (for/fold ([by-id (hash)]) ([source (in-list sources)]
+                              #:when (and (hash? source)
+                                          (string? (hash-ref source 'id #f))))
+    (define concept-id (hash-ref source 'id))
+    (define repository-concept (hash-ref concepts-by-id concept-id #f))
+    (define label
+      (cond [(and repository-concept (string? (hash-ref repository-concept 'label #f)))
+             (hash-ref repository-concept 'label)]
+            [(string? (hash-ref source 'label #f)) (hash-ref source 'label)]
+            [else ""]))
+    (define name-key (string-downcase (string-trim label)))
+    (define stored-id
+      (and (not (string=? name-key ""))
+           (query-maybe-value
+            db
+            #<<SQL
+SELECT id
+FROM concept_definitions
+WHERE lower(trim(document ->> 'label')) = $1
+ORDER BY updated_at DESC, id DESC
+LIMIT 1
+SQL
+            name-key)))
+    (define canonical-id
+      (or stored-id
+          (and (not (string=? name-key "")) (hash-ref by-name name-key #f))
+          (hash-ref by-id concept-id #f)
+          (normalized-or-new-concept-id concept-id)))
+    (unless (string=? name-key "") (hash-set! by-name name-key canonical-id))
+    (hash-set by-id concept-id canonical-id)))
+
+(define (canonicalize-document-concepts db document)
+  (define id-map (document-concept-id-map db document))
+  (define canonical-concepts
+    (for/fold ([by-id (hash)]) ([concept (in-list (document-concepts document))]
+                                #:when (and (hash? concept)
+                                            (string? (hash-ref concept 'id #f))))
+      (define original-id (hash-ref concept 'id))
+      (define canonical-id (hash-ref id-map original-id original-id))
+      (define stored-definition
+        (and (not (string=? canonical-id original-id))
+             (concept-definition-by-id db canonical-id)))
+      (hash-set by-id canonical-id
+                (hash-set (or stored-definition (concept-content concept))
+                          'id canonical-id))))
+  (define items (hash-ref document 'items '()))
+  (define canonical-items
+    (for/list ([item (in-list (if (list? items) items '()))])
+      (define concept-id (and (hash? item) (hash-ref item 'conceptId #f)))
+      (if (string? concept-id)
+          (hash-set item 'conceptId (hash-ref id-map concept-id concept-id))
+          item)))
+  (hash-set (hash-set document 'concepts (hash-values canonical-concepts))
+            'items canonical-items))
+
+;; Content belongs to a concept, not to one of its placements. Position, size,
+;; colour and typography remain in the CMap item/layout document.
+(define (sync-concept-definitions! db document author now)
+  (for ([concept (in-list (document-concepts document))]
+        #:when (and (hash? concept)
+                    (string? (hash-ref concept 'id #f))
+                    (not (string=? (hash-ref concept 'id) ""))))
+    (unless (concept-id? (hash-ref concept 'id))
+      (error 'sync-concept-definitions! "invalid concept UUID: ~a"
+             (hash-ref concept 'id)))
+    (query-exec
+     db
+     #<<SQL
+INSERT INTO concept_definitions(id, document, updated_at, updated_by)
+VALUES ($1, $2::text::jsonb, $3, $4)
+ON CONFLICT (id) DO UPDATE
+SET document = EXCLUDED.document,
+    updated_at = EXCLUDED.updated_at,
+    updated_by = EXCLUDED.updated_by
+SQL
+     (hash-ref concept 'id)
+     (document->text (concept-content concept))
+     now
+     author)))
+
+(define (hydrate-concept-definitions db document)
+  (define canonical-document (canonicalize-document-concepts db document))
+  (define local-concepts
+    (for/hash ([concept (in-list (document-concepts canonical-document))]
+               #:when (and (hash? concept) (string? (hash-ref concept 'id #f))))
+      (values (hash-ref concept 'id) (concept-content concept))))
+  (define concept-ids
+    (remove-duplicates
+     (append (hash-keys local-concepts) (document-item-concept-ids canonical-document))))
+  (define hydrated
+    (for/list ([concept-id (in-list concept-ids)])
+      (define row
+        (query-maybe-row
+         db
+         "SELECT document::text FROM concept_definitions WHERE id = $1"
+         concept-id))
+      (if row
+          (concept-content (text->document (vector-ref row 0)))
+          (hash-ref local-concepts concept-id (hash 'id concept-id)))))
+  ;; Sanitize legacy documents on the read path too. An editor can therefore
+  ;; never receive item-level content that competes with the central record.
+  (hash-set (concept-map-storage-document canonical-document)
+            'concepts hydrated))
+
 (define (row->concept-map row [include-document? #t])
   (define result
     (hash 'slug (vector-ref row 0)
@@ -119,6 +329,37 @@ SQL
                         " ORDER BY lower(title), title")))))
        (row->concept-map row #f)))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : List archived concept-map metadata for administration.
+; pre    : Database schema migration 9 has been installed.
+; post   : No database state is changed and documents are not transferred.
+; result : A newest-archived-first list including archive audit fields.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (list-archived-concept-maps config)
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (for/list ((row (in-list
+                      (query-rows
+                       db
+                       #<<SQL
+SELECT slug, title, document::text, current_version,
+       created_at, updated_at, created_by, updated_by,
+       archived_at, archived_by
+FROM concept_maps
+WHERE archived = TRUE
+ORDER BY archived_at DESC, lower(title), title
+SQL
+                       ))))
+       (hash-set
+        (hash-set (row->concept-map row #f)
+                  'archivedAt (if (sql-null? (vector-ref row 8))
+                                  'null
+                                  (vector-ref row 8)))
+        'archivedBy (or (and (not (sql-null? (vector-ref row 9)))
+                             (vector-ref row 9))
+                        ""))))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Count current concept placements across every active CMap.
 ; pre    : Concept-map documents use an items array when placements exist.
@@ -137,15 +378,13 @@ SQL
 WITH placements AS (
   SELECT cm.slug,
          cm.title AS cmap_title,
-         CASE
-           WHEN item ->> 'conceptId' ~ '^concept-[0-9]+$'
-             THEN concat('legacy:', cm.slug, ':', item ->> 'conceptId')
-           ELSE item ->> 'conceptId'
-         END AS concept_id,
-         coalesce(nullif(repository.document ->> 'label', ''),
+         item ->> 'conceptId' AS concept_id,
+         coalesce(nullif(definition.document ->> 'label', ''),
+                  nullif(repository.document ->> 'label', ''),
                   nullif(item ->> 'label', ''),
                   'Concept') AS concept_label,
-         coalesce(nullif(repository.document ->> 'pageSlug', ''),
+         coalesce(nullif(definition.document ->> 'pageSlug', ''),
+                  nullif(repository.document ->> 'pageSlug', ''),
                   nullif(item ->> 'pageSlug', '')) AS page_slug
   FROM concept_maps cm
   CROSS JOIN LATERAL jsonb_array_elements(
@@ -167,9 +406,11 @@ WITH placements AS (
     WHERE concept_value ->> 'id' = item ->> 'conceptId'
     LIMIT 1
   ) repository ON TRUE
+  LEFT JOIN concept_definitions definition
+    ON definition.id = item ->> 'conceptId'
   WHERE cm.archived = FALSE
     AND nullif(item ->> 'conceptId', '') IS NOT NULL
-    AND coalesce(item ->> 'kind', 'concept') NOT IN ('phrase', 'submap')
+    AND coalesce(item ->> 'kind', 'concept') <> 'phrase'
 )
 SELECT concept_id, slug, cmap_title, concept_label, page_slug, count(*)
 FROM placements
@@ -186,6 +427,70 @@ SQL
                            (vector-ref row 4))
              'count (vector-ref row 5))))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : List globally defined concepts carrying the TODO aspect.
+; pre    : Concept definitions and current CMap documents are available.
+; post   : No database state is changed and every concept occurs at most once.
+; result : Concept todo hashes with shared content and a current map location.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (list-concept-todos config)
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (for/list ([row (in-list
+                      (query-rows
+                       db
+                       #<<SQL
+SELECT definition.id,
+       coalesce(nullif(definition.document ->> 'label', ''), 'Concept') AS label,
+       coalesce(definition.document ->> 'synopsis', '') AS synopsis,
+       nullif(definition.document ->> 'descriptionPageSlug', '') AS description_page_slug,
+       nullif(definition.document ->> 'pageSlug', '') AS page_slug,
+       nullif(definition.document ->> 'cmapSlug', '') AS linked_cmap_slug,
+       nullif(definition.document ->> 'externalUrl', '') AS external_url,
+       placement.cmap_slug,
+       placement.cmap_title
+FROM concept_definitions definition
+JOIN LATERAL (
+  SELECT cm.slug AS cmap_slug, cm.title AS cmap_title
+  FROM concept_maps cm
+  CROSS JOIN LATERAL jsonb_array_elements(
+    CASE WHEN jsonb_typeof(cm.document -> 'items') = 'array'
+         THEN cm.document -> 'items' ELSE '[]'::jsonb END
+  ) AS item
+  WHERE cm.archived = FALSE
+    AND item ->> 'conceptId' = definition.id
+    AND coalesce(item ->> 'kind', 'concept') <> 'phrase'
+  ORDER BY lower(cm.title), cm.title, cm.slug
+  LIMIT 1
+) placement ON TRUE
+WHERE EXISTS (
+  SELECT 1
+  FROM jsonb_array_elements_text(
+    CASE WHEN jsonb_typeof(definition.document -> 'aspects') = 'array'
+         THEN definition.document -> 'aspects' ELSE '[]'::jsonb END
+  ) AS aspect(value)
+  WHERE lower(trim(aspect.value)) = 'todo'
+)
+ORDER BY lower(coalesce(definition.document ->> 'label', '')),
+         coalesce(definition.document ->> 'label', ''),
+         definition.id
+SQL
+                       ))])
+       (define (nullable index)
+         (define value (vector-ref row index))
+         (if (sql-null? value) 'null value))
+       (hash 'type "concept"
+             'conceptId (vector-ref row 0)
+             'title (vector-ref row 1)
+             'text (vector-ref row 2)
+             'descriptionPageSlug (nullable 3)
+             'pageSlug (nullable 4)
+             'cmapSlug (nullable 5)
+             'externalUrl (nullable 6)
+             'placementCmapSlug (vector-ref row 7)
+             'placementCmapTitle (vector-ref row 8))))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : List recently edited current concept maps.
 ; pre    : Database schema migration 9 has been installed.
@@ -230,14 +535,17 @@ WITH q AS (
          cm.title,
          coalesce((
            SELECT string_agg(
-                    concat_ws(' ', item ->> 'label', item ->> 'synopsis'),
+                    concat_ws(' ', coalesce(definition.document, concept) ->> 'label',
+                                   coalesce(definition.document, concept) ->> 'synopsis'),
                     ' ')
            FROM jsonb_array_elements(
              CASE
-               WHEN jsonb_typeof(cm.document -> 'items') = 'array'
-                 THEN cm.document -> 'items'
+               WHEN jsonb_typeof(cm.document -> 'concepts') = 'array'
+                 THEN cm.document -> 'concepts'
                ELSE '[]'::jsonb
-             END) AS item
+             END) AS concept
+           LEFT JOIN concept_definitions definition
+             ON definition.id = concept ->> 'id'
          ), '') AS concept_text
   FROM concept_maps cm
   WHERE cm.archived = FALSE
@@ -288,7 +596,11 @@ SQL
              "SELECT " concept-map-columns
              " FROM concept_maps WHERE slug = $1 AND archived = FALSE")
             slug))
-         (if row (row->concept-map row) #f)))))
+         (if row
+             (hash-update (row->concept-map row)
+                          'document
+                          (λ (document) (hydrate-concept-definitions db document)))
+             #f)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Create a persistent concept map.
@@ -301,7 +613,6 @@ SQL
   (define clean-slug (string-trim slug))
   (define clean-title (string-trim title))
   (validate-concept-map-input 'create-concept-map! clean-slug clean-title document)
-  (define document-text (document->text document))
   (define now (current-seconds))
   (call-with-wiki-database
    config
@@ -309,6 +620,11 @@ SQL
      (call-with-transaction
       db
       (λ ()
+        (define canonical-document (canonicalize-document-concepts db document))
+        (define document-text
+          (document->text (concept-map-storage-document canonical-document)))
+        (sync-concept-definitions! db canonical-document author now)
+        (sync-person-tags! db canonical-document)
         (query-value
          db
          #<<SQL
@@ -384,7 +700,6 @@ SQL
     (error 'update-concept-map! "invalid save action: ~a" action))
   (define clean-title (string-trim title))
   (validate-concept-map-input 'update-concept-map! slug clean-title document)
-  (define document-text (document->text document))
   (call-with-wiki-database
    config
    (λ (db)
@@ -407,6 +722,10 @@ SQL
           (error 'update-concept-map! "version-conflict"))
         (define next-version (+ current-version 1))
         (define now (current-seconds))
+        (define canonical-document (canonicalize-document-concepts db document))
+        (define document-text
+          (document->text (concept-map-storage-document canonical-document)))
+        (sync-concept-definitions! db canonical-document author now)
         (query-exec
          db
          #<<SQL
@@ -424,6 +743,7 @@ SQL
          now
          author
          (vector-ref row 0))
+        (sync-person-tags! db canonical-document)
         (unless (string=? action "autosave")
           (insert-concept-map-version!
            db (vector-ref row 0) next-version clean-title document-text
@@ -528,24 +848,127 @@ SQL
            #t)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-; goal   : Soft-delete one concept map.
-; pre    : slug identifies a current map.
-; post   : The map is excluded from normal list/read operations.
+; goal   : Archive one concept map after explicit identity confirmation.
+; pre    : slug, exact title and base-version identify the current map.
+; post   : The map is excluded from normal list/read operations atomically.
 ; result : void.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (archive-concept-map! config slug author)
+(define (archive-concept-map! config slug expected-title author base-version)
   (call-with-wiki-database
    config
    (λ (db)
-     (define changed
-       (query-exec
-        db
-        #<<SQL
+     (call-with-transaction
+      db
+      (λ ()
+        (define row
+          (query-maybe-row
+           db
+           "SELECT id, title, current_version FROM concept_maps WHERE slug = $1 AND archived = FALSE FOR UPDATE"
+           slug))
+        (unless row
+          (error 'archive-concept-map! "unknown concept map: ~a" slug))
+        (unless (and (string? expected-title)
+                     (string=? expected-title (vector-ref row 1)))
+          (error 'archive-concept-map! "title-confirmation-mismatch"))
+        (define supplied-version
+          (if (number? base-version)
+              base-version
+              (string->number (format "~a" base-version))))
+        (unless (and supplied-version (= supplied-version (vector-ref row 2)))
+          (error 'archive-concept-map! "version-conflict"))
+        (define now (current-seconds))
+        (query-exec
+         db
+         #<<SQL
 UPDATE concept_maps
 SET archived = TRUE, archived_at = $1, archived_by = $2,
     updated_at = $1, updated_by = $2
-WHERE slug = $3 AND archived = FALSE
+WHERE id = $3
+SQL
+         now author (vector-ref row 0))))))
+  (void))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Restore one archived concept map.
+; pre    : slug identifies an archived map.
+; post   : Archive markers are cleared; content, version and history survive.
+; result : The restored current concept-map hash.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (restore-concept-map! config slug author)
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (define restored-id
+       (query-maybe-value
+        db
+        #<<SQL
+UPDATE concept_maps
+SET archived = FALSE, archived_at = NULL, archived_by = NULL,
+    updated_at = $1, updated_by = $2
+WHERE slug = $3 AND archived = TRUE
+RETURNING id
 SQL
         (current-seconds) author slug))
-     (void changed)))
-  (void))
+     (unless restored-id
+       (error 'restore-concept-map! "unknown archived concept map: ~a" slug))))
+  (read-concept-map config slug))
+
+(module+ test
+  (require rackunit)
+
+  (define concept-a "11111111-1111-4111-8111-111111111111")
+  (define concept-b "22222222-2222-4222-8222-222222222222")
+
+  (define stored-document
+    (concept-map-storage-document
+     (hash 'metadata (hash 'summary "Map summary")
+           'concepts (list (hash 'id concept-a
+                                 'label "Shared concept"
+                                 'synopsis "Central content"))
+           'items (list (hash 'id 1
+                              'conceptId concept-a
+                              'kind "submap"
+                              'label "Stale item label"
+                              'synopsis "Stale item content"
+                              'externalUrl "https://example.com/shared"
+                              'x 40
+                              'backgroundColor "#ffffff")
+                        (hash 'id 2
+                              'conceptId concept-b
+                              'kind "concept"
+                              'label "Item-only concept")
+                        (hash 'id 3
+                              'kind "phrase"
+                              'label "relates to")))))
+
+  (check-equal? (hash-ref stored-document 'concepts)
+                (list (hash 'id concept-a) (hash 'id concept-b)))
+  (define stored-items (hash-ref stored-document 'items))
+  (check-false (hash-has-key? (first stored-items) 'label))
+  (check-false (hash-has-key? (first stored-items) 'synopsis))
+  (check-false (hash-has-key? (first stored-items) 'externalUrl))
+  (check-equal? (hash-ref (first stored-items) 'x) 40)
+  (check-equal? (hash-ref (first stored-items) 'backgroundColor) "#ffffff")
+  (check-equal? (hash-ref (third stored-items) 'label) "relates to")
+  (check-equal? (hash-ref (hash-ref stored-document 'metadata) 'summary)
+                "Map summary")
+  (check-true (concept-id? concept-a))
+  (check-true (concept-id? "A3C4F0D1-22E5-4C42-9A40-CC864993F785"))
+  (check-false (concept-id? "concept-a"))
+  (check-equal? (hash-ref (concept-content
+                           (hash 'id concept-a
+                                 'label "Linked concept"
+                                 'externalUrl "https://example.com/path"))
+                          'externalUrl)
+                "https://example.com/path")
+  (check-exn exn:fail?
+             (lambda ()
+               (concept-content
+                (hash 'id concept-a
+                      'label "Unsafe concept"
+                      'externalUrl "javascript:alert(1)"))))
+  (check-exn exn:fail?
+             (lambda ()
+               (concept-map-storage-document
+                (hash 'concepts (list (hash 'id "legacy:map:concept-1"))
+                      'items '())))))

private/cmap-styles.rkt

@@ -0,0 +1,171 @@
+#lang racket/base
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Wiki-wide CMap appearance styles stored in wiki_settings.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(require db
+         json
+         racket/list
+         racket/string
+         "database.rkt")
+
+(provide read-cmap-styles
+         save-cmap-styles!)
+
+(define setting-key "cmap.styles.v1")
+(define maximum-style-count 100)
+(define maximum-style-name-length 80)
+(define permitted-name-keys
+  '(style-default style-subtle style-emphasis style-warning style-success))
+(define value-keys
+  '(backgroundColor textColor fontFamily fontSize fontWeight fontStyle
+    synopsisTextColor synopsisFontFamily synopsisFontSize synopsisFontWeight
+    synopsisFontStyle submapBackgroundColor submapBorderColor))
+
+(define (seeded-style id name-key background text font size bold? italic? [synopsis-text #f])
+  (hash 'id id
+        'nameKey name-key
+        'protected (string=? id "default")
+        'values
+        (hash 'backgroundColor background
+              'textColor text
+              'fontFamily font
+              'fontSize size
+              'fontWeight (if bold? "700" "400")
+              'fontStyle (if italic? "italic" "normal")
+              'synopsisTextColor (or synopsis-text text)
+              'synopsisFontFamily font
+              'synopsisFontSize (max 6 (- size 2))
+              'synopsisFontWeight "400"
+              'synopsisFontStyle (if italic? "italic" "normal")
+              'submapBackgroundColor "#edf7e8"
+              'submapBorderColor "#57834a")))
+
+(define initial-cmap-styles
+  (list
+   (seeded-style "default" "style-default" "#fff4cf" "#222222" "Arial, Helvetica, sans-serif" 11 #t #f "#4d4d4d")
+   (seeded-style "subtle" "style-subtle" "#f1f3f5" "#56616b" "system-ui, sans-serif" 10 #f #f)
+   (seeded-style "emphasis" "style-emphasis" "#e7f2fb" "#173b57" "Georgia, Times New Roman, serif" 12 #t #f)
+   (seeded-style "warning" "style-warning" "#fff0d5" "#713b00" "Arial, Helvetica, sans-serif" 11 #t #t)
+   (seeded-style "success" "style-success" "#e6f4e2" "#285b27" "Arial, Helvetica, sans-serif" 11 #f #t)))
+
+(define (required-string who value description [maximum-length #f])
+  (unless (and (string? value)
+               (not (string=? (string-trim value) ""))
+               (or (not maximum-length) (<= (string-length (string-trim value)) maximum-length)))
+    (error who "invalid ~a" description))
+  (string-trim value))
+
+(define (style-color who value key)
+  (unless (and (string? value) (regexp-match? #px"(?i:^#[0-9a-f]{6}$)" value))
+    (error who "invalid colour for ~a" key))
+  (string-downcase value))
+
+(define (style-size who value key)
+  (unless (and (real? value) (<= 6 value 54))
+    (error who "invalid font size for ~a" key))
+  value)
+
+(define (normalize-style-values who values)
+  (unless (hash? values) (error who "style values must be an object"))
+  (for ([key (in-list value-keys)])
+    (unless (hash-has-key? values key) (error who "missing style value: ~a" key)))
+  (hash
+   'backgroundColor (style-color who (hash-ref values 'backgroundColor) 'backgroundColor)
+   'textColor (style-color who (hash-ref values 'textColor) 'textColor)
+   'fontFamily (required-string who (hash-ref values 'fontFamily) "font family" 200)
+   'fontSize (style-size who (hash-ref values 'fontSize) 'fontSize)
+   'fontWeight (let ([value (hash-ref values 'fontWeight)])
+                 (unless (member value '("400" "700")) (error who "invalid font weight"))
+                 value)
+   'fontStyle (let ([value (hash-ref values 'fontStyle)])
+                (unless (member value '("normal" "italic")) (error who "invalid font style"))
+                value)
+   'synopsisTextColor (style-color who (hash-ref values 'synopsisTextColor) 'synopsisTextColor)
+   'synopsisFontFamily (required-string who (hash-ref values 'synopsisFontFamily) "synopsis font family" 200)
+   'synopsisFontSize (style-size who (hash-ref values 'synopsisFontSize) 'synopsisFontSize)
+   'synopsisFontWeight (let ([value (hash-ref values 'synopsisFontWeight)])
+                         (unless (member value '("400" "700")) (error who "invalid synopsis font weight"))
+                         value)
+   'synopsisFontStyle (let ([value (hash-ref values 'synopsisFontStyle)])
+                        (unless (member value '("normal" "italic")) (error who "invalid synopsis font style"))
+                        value)
+   'submapBackgroundColor (style-color who (hash-ref values 'submapBackgroundColor) 'submapBackgroundColor)
+   'submapBorderColor (style-color who (hash-ref values 'submapBorderColor) 'submapBorderColor)))
+
+(define (normalize-cmap-styles styles [who 'cmap-styles])
+  (unless (and (list? styles) (<= 1 (length styles) maximum-style-count))
+    (error who "styles must contain between 1 and ~a entries" maximum-style-count))
+  (define seen (make-hash))
+  (define normalized
+    (for/list ([style (in-list styles)])
+      (unless (hash? style) (error who "each style must be an object"))
+      (define id (required-string who (hash-ref style 'id #f) "style id" 120))
+      (unless (regexp-match? #px"^[A-Za-z0-9_-]+$" id) (error who "invalid style id"))
+      (when (hash-ref seen id #f) (error who "duplicate style id: ~a" id))
+      (hash-set! seen id #t)
+      (define name (and (string? (hash-ref style 'name #f))
+                        (required-string who (hash-ref style 'name) "style name" maximum-style-name-length)))
+      (define name-key (and (string? (hash-ref style 'nameKey #f))
+                            (string->symbol (required-string who (hash-ref style 'nameKey) "style name key" 40))))
+      (unless (or name (member name-key permitted-name-keys))
+        (error who "a style needs a name"))
+      (hash 'id id
+            (if (member name-key permitted-name-keys) 'nameKey 'name)
+            (if (member name-key permitted-name-keys) (symbol->string name-key) name)
+            'protected (string=? id "default")
+            'values (normalize-style-values who (hash-ref style 'values #f)))))
+  (unless (hash-ref seen "default" #f) (error who "the default style is required"))
+  normalized)
+
+(define (read-cmap-styles config)
+  (call-with-wiki-database
+   config
+   (lambda (db)
+     (define stored
+       (query-maybe-value db "SELECT value FROM wiki_settings WHERE key = $1" setting-key))
+     (if stored
+         (normalize-cmap-styles (string->jsexpr stored) 'read-cmap-styles)
+         (let ([encoded (jsexpr->string (normalize-cmap-styles initial-cmap-styles))])
+           (query-exec
+            db
+            "INSERT INTO wiki_settings(key, value, updated_at) VALUES ($1, $2, $3) ON CONFLICT(key) DO NOTHING"
+            setting-key encoded (current-seconds))
+           (normalize-cmap-styles
+            (string->jsexpr
+             (query-value db "SELECT value FROM wiki_settings WHERE key = $1" setting-key))
+            'read-cmap-styles))))))
+
+(define (save-cmap-styles! config styles)
+  (define normalized (normalize-cmap-styles styles 'save-cmap-styles!))
+  (define encoded (jsexpr->string normalized))
+  (when (> (bytes-length (string->bytes/utf-8 encoded)) (* 128 1024))
+    (error 'save-cmap-styles! "style data is too large"))
+  (call-with-wiki-database
+   config
+   (lambda (db)
+     (query-exec
+      db
+      "INSERT INTO wiki_settings(key, value, updated_at) VALUES ($1, $2, $3) ON CONFLICT(key) DO UPDATE SET value = excluded.value, updated_at = excluded.updated_at"
+      setting-key encoded (current-seconds))))
+  normalized)
+
+(module+ test
+  (require rackunit)
+  (define values
+    (hash 'backgroundColor "#FFF4CF" 'textColor "#222222"
+          'fontFamily "Arial" 'fontSize 11 'fontWeight "700" 'fontStyle "normal"
+          'synopsisTextColor "#4d4d4d" 'synopsisFontFamily "Arial"
+          'synopsisFontSize 9 'synopsisFontWeight "400" 'synopsisFontStyle "normal"
+          'submapBackgroundColor "#edf7e8" 'submapBorderColor "#57834a"))
+  (define normalized
+    (normalize-cmap-styles
+     (list (hash 'id "default" 'nameKey "style-default" 'values values))))
+  (check-equal? (hash-ref (hash-ref (first normalized) 'values) 'backgroundColor) "#fff4cf")
+  (check-equal? (length (normalize-cmap-styles initial-cmap-styles)) 5)
+  (check-exn exn:fail? (lambda () (normalize-cmap-styles '())))
+  (check-exn exn:fail?
+             (lambda ()
+               (normalize-cmap-styles
+                (list (hash 'id "custom" 'name "Custom" 'values values))))))

private/concept-id.rkt

@@ -0,0 +1,48 @@
+#lang racket/base
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Canonical concept identity helpers.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(require racket/string
+         uuid)
+
+(provide concept-id?
+         normalize-concept-id
+         new-concept-id
+         normalized-or-new-concept-id)
+
+(define prefixed-uuid-concept-id-pattern
+  #px"(?i:^concept-([0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12})$)")
+
+;; Concept ids are stored as plain UUID strings. Validation accepts uppercase
+;; input, while normalization always produces the canonical lowercase form.
+(define (concept-id? value)
+  (uuid-string? value))
+
+(define (normalize-concept-id value)
+  (cond
+    [(uuid-string? value) (string-downcase value)]
+    [(and (string? value)
+          (regexp-match prefixed-uuid-concept-id-pattern value))
+     => (lambda (match) (string-downcase (cadr match)))]
+    [else #f]))
+
+(define (new-concept-id)
+  (uuid-string))
+
+(define (normalized-or-new-concept-id value)
+  (or (normalize-concept-id value)
+      (new-concept-id)))
+
+(module+ test
+  (require rackunit)
+
+  (define sample "a3c4f0d1-22e5-4c42-9a40-cc864993f785")
+  (check-true (concept-id? sample))
+  (check-true (concept-id? (string-upcase sample)))
+  (check-false (concept-id? (string-append "concept-" sample)))
+  (check-equal? (normalize-concept-id (string-upcase sample)) sample)
+  (check-equal? (normalize-concept-id (string-append "concept-" sample)) sample)
+  (check-false (normalize-concept-id "legacy:a:concept-1"))
+  (check-true (concept-id? (new-concept-id))))

private/migrations.rkt

@@ -9,6 +9,7 @@
          racket/path
          racket/string
          "attachment-references.rkt"
+         "concept-id.rkt"
          "config.rkt"
          "todo.rkt")
 
@@ -20,7 +21,7 @@
 ;; Supporting functions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define current-schema-version 12)
+(define current-schema-version 21)
 
 (define schema-1-statements
   (list
@@ -421,6 +422,791 @@ SQL
               )
   (record-schema-version! db 12))
 
+(define (migrate-12->13! db)
+  (query-exec db
+              #<<SQL
+CREATE TABLE IF NOT EXISTS people (
+  id BIGSERIAL PRIMARY KEY,
+  name TEXT NOT NULL,
+  active BOOLEAN NOT NULL DEFAULT TRUE,
+  created_at BIGINT NOT NULL,
+  updated_at BIGINT NOT NULL
+)
+SQL
+              )
+  (query-exec db "CREATE UNIQUE INDEX IF NOT EXISTS people_name_unique_idx ON people(lower(name))")
+  (query-exec
+   db
+   #<<SQL
+WITH person_names AS (
+  SELECT DISTINCT trim(tag ->> 'value') AS name
+  FROM concept_maps cm
+  CROSS JOIN LATERAL jsonb_array_elements(
+    CASE WHEN jsonb_typeof(cm.document -> 'concepts') = 'array'
+         THEN cm.document -> 'concepts' ELSE '[]'::jsonb END
+  ) AS concept
+  CROSS JOIN LATERAL jsonb_array_elements(
+    CASE WHEN jsonb_typeof(concept -> 'tags') = 'array'
+         THEN concept -> 'tags' ELSE '[]'::jsonb END
+  ) AS tag
+  WHERE tag ->> 'type' = 'person' AND trim(coalesce(tag ->> 'value', '')) <> ''
+)
+INSERT INTO people(name, active, created_at, updated_at)
+SELECT name, TRUE, $1, $1 FROM person_names
+ON CONFLICT (lower(name)) DO NOTHING
+SQL
+   (current-seconds))
+  (record-schema-version! db 13))
+
+(define (migrate-13->14! db)
+  ;; Concept identity is shared between CMaps. Older generated numeric ids were
+  ;; only unique inside one map, so namespace those before building the global
+  ;; repository.
+  (query-exec
+   db
+   #<<SQL
+UPDATE concept_maps cm
+SET document = cm.document || jsonb_build_object(
+  'concepts', CASE
+    WHEN jsonb_typeof(cm.document -> 'concepts') = 'array' THEN
+      (SELECT coalesce(jsonb_agg(
+         CASE WHEN concept ->> 'id' ~ '^concept-[0-9]+$'
+              THEN jsonb_set(concept, '{id}', to_jsonb(concat('legacy:', cm.slug, ':', concept ->> 'id')))
+              ELSE concept END
+       ), '[]'::jsonb)
+       FROM jsonb_array_elements(cm.document -> 'concepts') AS concept)
+    ELSE coalesce(cm.document -> 'concepts', '[]'::jsonb)
+  END,
+  'items', CASE
+    WHEN jsonb_typeof(cm.document -> 'items') = 'array' THEN
+      (SELECT coalesce(jsonb_agg(
+         CASE WHEN item ->> 'conceptId' ~ '^concept-[0-9]+$'
+              THEN jsonb_set(item, '{conceptId}', to_jsonb(concat('legacy:', cm.slug, ':', item ->> 'conceptId')))
+              ELSE item END
+       ), '[]'::jsonb)
+       FROM jsonb_array_elements(cm.document -> 'items') AS item)
+    ELSE coalesce(cm.document -> 'items', '[]'::jsonb)
+  END
+)
+WHERE jsonb_typeof(cm.document) = 'object'
+SQL
+   )
+  (query-exec
+   db
+   #<<SQL
+CREATE TABLE IF NOT EXISTS concept_definitions (
+  id TEXT PRIMARY KEY,
+  document JSONB NOT NULL,
+  updated_at BIGINT NOT NULL,
+  updated_by TEXT NOT NULL
+)
+SQL
+   )
+  ;; If a shared concept already has diverging copies, the copy from the most
+  ;; recently edited active map becomes the initial canonical definition.
+  (query-exec
+   db
+   #<<SQL
+WITH candidates AS (
+  SELECT concept ->> 'id' AS id,
+         concept AS document,
+         cm.updated_at,
+         cm.updated_by,
+         row_number() OVER (
+           PARTITION BY concept ->> 'id'
+           ORDER BY cm.updated_at DESC, cm.id DESC
+         ) AS position
+  FROM concept_maps cm
+  CROSS JOIN LATERAL jsonb_array_elements(
+    CASE WHEN jsonb_typeof(cm.document -> 'concepts') = 'array'
+         THEN cm.document -> 'concepts' ELSE '[]'::jsonb END
+  ) AS concept
+  WHERE cm.archived = FALSE AND nullif(concept ->> 'id', '') IS NOT NULL
+)
+INSERT INTO concept_definitions(id, document, updated_at, updated_by)
+SELECT id, document, updated_at, updated_by
+FROM candidates
+WHERE position = 1
+ON CONFLICT (id) DO NOTHING
+SQL
+   )
+  (record-schema-version! db 14))
+
+(define (migrate-14->15! db)
+  ;; Schema 14 originally filled the shared repository only from the concepts
+  ;; array. Sub-CMap heads are placements too, but older documents often keep
+  ;; their content solely on the item. Import those missing definitions.
+  (query-exec
+   db
+   #<<SQL
+WITH candidates AS (
+  SELECT item ->> 'conceptId' AS id,
+         jsonb_strip_nulls(jsonb_build_object(
+           'id', item -> 'conceptId',
+           'label', coalesce(repository.document, item) -> 'label',
+           'synopsis', coalesce(repository.document, item) -> 'synopsis',
+           'aspects', coalesce(repository.document, item) -> 'aspects',
+           'tags', coalesce(repository.document, item) -> 'tags',
+           'descriptionPageSlug', coalesce(repository.document, item) -> 'descriptionPageSlug',
+           'pageSlug', coalesce(repository.document, item) -> 'pageSlug',
+           'cmapSlug', coalesce(repository.document, item) -> 'cmapSlug',
+           'parentCmapLink', coalesce(repository.document, item) -> 'parentCmapLink',
+           'imageSource', coalesce(repository.document, item) -> 'imageSource'
+         )) AS document,
+         cm.updated_at,
+         cm.updated_by,
+         row_number() OVER (
+           PARTITION BY item ->> 'conceptId'
+           ORDER BY cm.updated_at DESC, cm.id DESC
+         ) AS position
+  FROM concept_maps cm
+  CROSS JOIN LATERAL jsonb_array_elements(
+    CASE WHEN jsonb_typeof(cm.document -> 'items') = 'array'
+         THEN cm.document -> 'items' ELSE '[]'::jsonb END
+  ) AS item
+  LEFT JOIN LATERAL (
+    SELECT concept AS document
+    FROM jsonb_array_elements(
+      CASE WHEN jsonb_typeof(cm.document -> 'concepts') = 'array'
+           THEN cm.document -> 'concepts' ELSE '[]'::jsonb END
+    ) AS concept
+    WHERE concept ->> 'id' = item ->> 'conceptId'
+    LIMIT 1
+  ) repository ON TRUE
+  WHERE cm.archived = FALSE
+    AND nullif(item ->> 'conceptId', '') IS NOT NULL
+    AND coalesce(item ->> 'kind', 'concept') <> 'phrase'
+)
+INSERT INTO concept_definitions(id, document, updated_at, updated_by)
+SELECT id, document, updated_at, updated_by
+FROM candidates
+WHERE position = 1
+ON CONFLICT (id) DO NOTHING
+SQL
+   )
+  (record-schema-version! db 15))
+
+(define (migrate-15->16! db)
+  ;; A placement linked to a derived CMap and the head concept of that CMap
+  ;; denote one concept. Retain aliases so old documents and open editors can
+  ;; be canonicalized without making diagram structure part of the concept.
+  (query-exec
+   db
+   #<<SQL
+CREATE TABLE IF NOT EXISTS concept_aliases (
+  alias_id TEXT PRIMARY KEY,
+  canonical_id TEXT NOT NULL,
+  created_at BIGINT NOT NULL,
+  created_by TEXT NOT NULL,
+  CHECK(alias_id <> canonical_id)
+)
+SQL
+   )
+  (query-exec db
+              "CREATE INDEX IF NOT EXISTS concept_aliases_canonical_idx ON concept_aliases(canonical_id)")
+  (query-exec
+   db
+   #<<SQL
+WITH derived_roots AS (
+  SELECT target.slug AS target_slug,
+         root_item ->> 'conceptId' AS canonical_id
+  FROM concept_maps target
+  JOIN concept_maps source
+    ON source.slug = target.document #>> '{derivedView,sourceCmapSlug}'
+  CROSS JOIN LATERAL jsonb_array_elements(
+    CASE WHEN jsonb_typeof(source.document -> 'items') = 'array'
+         THEN source.document -> 'items' ELSE '[]'::jsonb END
+  ) AS root_item
+  WHERE target.archived = FALSE
+    AND source.archived = FALSE
+    AND root_item ->> 'id' = target.document #>> '{derivedView,rootItemId}'
+    AND nullif(root_item ->> 'conceptId', '') IS NOT NULL
+  UNION ALL
+  SELECT target.slug AS target_slug,
+         root_item ->> 'conceptId' AS canonical_id
+  FROM concept_maps target
+  CROSS JOIN LATERAL jsonb_array_elements(
+    CASE WHEN jsonb_typeof(target.document -> 'items') = 'array'
+         THEN target.document -> 'items' ELSE '[]'::jsonb END
+  ) AS root_item
+  LEFT JOIN LATERAL (
+    SELECT concept AS document
+    FROM jsonb_array_elements(
+      CASE WHEN jsonb_typeof(target.document -> 'concepts') = 'array'
+           THEN target.document -> 'concepts' ELSE '[]'::jsonb END
+    ) AS concept
+    WHERE concept ->> 'id' = root_item ->> 'conceptId'
+    LIMIT 1
+  ) repository ON TRUE
+  WHERE target.archived = FALSE
+    AND target.document -> 'derivedView' IS NULL
+    AND nullif(root_item ->> 'conceptId', '') IS NOT NULL
+    AND coalesce(root_item ->> 'kind', 'concept') <> 'phrase'
+    AND nullif(root_item ->> 'parentSubmapId', '') IS NULL
+    AND lower(trim(coalesce(repository.document ->> 'label', root_item ->> 'label', '')))
+        = lower(trim(target.title))
+), linked_placements AS (
+  SELECT DISTINCT item ->> 'conceptId' AS alias_id,
+         derived_roots.canonical_id
+  FROM concept_maps cm
+  CROSS JOIN LATERAL jsonb_array_elements(
+    CASE WHEN jsonb_typeof(cm.document -> 'items') = 'array'
+         THEN cm.document -> 'items' ELSE '[]'::jsonb END
+  ) AS item
+  JOIN derived_roots ON derived_roots.target_slug = item ->> 'cmapSlug'
+  WHERE cm.archived = FALSE
+    AND nullif(item ->> 'conceptId', '') IS NOT NULL
+    AND item ->> 'conceptId' <> derived_roots.canonical_id
+)
+INSERT INTO concept_aliases(alias_id, canonical_id, created_at, created_by)
+SELECT alias_id, canonical_id, $1, 'system:concept-identity-migration'
+FROM linked_placements
+ON CONFLICT (alias_id) DO UPDATE
+SET canonical_id = EXCLUDED.canonical_id
+SQL
+   (current-seconds))
+  ;; Preserve the newest available content when two ids are merged.
+  (query-exec
+   db
+   #<<SQL
+WITH resolved AS (
+  SELECT coalesce(alias.canonical_id, definition.id) AS canonical_id,
+         definition.document,
+         definition.updated_at,
+         definition.updated_by,
+         row_number() OVER (
+           PARTITION BY coalesce(alias.canonical_id, definition.id)
+           ORDER BY definition.updated_at DESC, definition.id DESC
+         ) AS position
+  FROM concept_definitions definition
+  LEFT JOIN concept_aliases alias ON alias.alias_id = definition.id
+)
+INSERT INTO concept_definitions(id, document, updated_at, updated_by)
+SELECT canonical_id,
+       jsonb_set(document - 'kind' - 'parentCmapLink', '{id}', to_jsonb(canonical_id)),
+       updated_at,
+       updated_by
+FROM resolved
+WHERE position = 1
+ON CONFLICT (id) DO UPDATE
+SET document = EXCLUDED.document,
+    updated_at = EXCLUDED.updated_at,
+    updated_by = EXCLUDED.updated_by
+SQL
+   )
+  (record-schema-version! db 16))
+
+(define (migrate-16->17! db)
+  ;; Within one wiki a normalized concept name denotes one concept. Merge ids
+  ;; that predate this invariant, while preserving a canonical id already
+  ;; established through a linked CMap when one exists.
+  (query-exec
+   db
+   #<<SQL
+WITH named AS (
+  SELECT definition.id,
+         definition.document,
+         definition.updated_at,
+         definition.updated_by,
+         lower(trim(definition.document ->> 'label')) AS name_key,
+         coalesce(existing_alias.canonical_id, definition.id) AS resolved_id
+  FROM concept_definitions definition
+  LEFT JOIN concept_aliases existing_alias
+    ON existing_alias.alias_id = definition.id
+  WHERE nullif(trim(definition.document ->> 'label'), '') IS NOT NULL
+), ranked AS (
+  SELECT named.*,
+         first_value(resolved_id) OVER (
+           PARTITION BY name_key
+           ORDER BY updated_at DESC, id DESC
+         ) AS canonical_id,
+         row_number() OVER (
+           PARTITION BY name_key
+           ORDER BY updated_at DESC, id DESC
+         ) AS content_position
+  FROM named
+), new_aliases AS (
+  SELECT DISTINCT id AS alias_id, canonical_id
+  FROM ranked
+  WHERE id <> canonical_id
+), stored_aliases AS (
+  INSERT INTO concept_aliases(alias_id, canonical_id, created_at, created_by)
+  SELECT alias_id, canonical_id, $1, 'system:concept-name-migration'
+  FROM new_aliases
+  ON CONFLICT (alias_id) DO UPDATE
+  SET canonical_id = EXCLUDED.canonical_id
+  RETURNING alias_id
+), winners AS (
+  SELECT DISTINCT ON (canonical_id)
+         canonical_id, document, updated_at, updated_by
+  FROM ranked
+  WHERE content_position = 1
+  ORDER BY canonical_id, updated_at DESC, id DESC
+)
+INSERT INTO concept_definitions(id, document, updated_at, updated_by)
+SELECT canonical_id,
+       jsonb_set(document - 'kind' - 'parentCmapLink', '{id}', to_jsonb(canonical_id)),
+       updated_at,
+       updated_by
+FROM winners
+ON CONFLICT (id) DO UPDATE
+SET document = EXCLUDED.document,
+    updated_at = EXCLUDED.updated_at,
+    updated_by = EXCLUDED.updated_by
+SQL
+   (current-seconds))
+  (query-exec
+   db
+   #<<SQL
+UPDATE concept_maps cm
+SET document = cm.document || jsonb_build_object(
+  'items', CASE
+    WHEN jsonb_typeof(cm.document -> 'items') = 'array' THEN
+      (SELECT coalesce(jsonb_agg(
+         CASE WHEN alias.canonical_id IS NOT NULL
+              THEN jsonb_set(item, '{conceptId}', to_jsonb(alias.canonical_id))
+              ELSE item END
+         ORDER BY ordinal
+       ), '[]'::jsonb)
+       FROM jsonb_array_elements(cm.document -> 'items') WITH ORDINALITY AS entry(item, ordinal)
+       LEFT JOIN concept_aliases alias ON alias.alias_id = item ->> 'conceptId')
+    ELSE coalesce(cm.document -> 'items', '[]'::jsonb)
+  END,
+  'concepts', CASE
+    WHEN jsonb_typeof(cm.document -> 'concepts') = 'array' THEN
+      (SELECT coalesce(jsonb_agg(rewritten ORDER BY ordinal), '[]'::jsonb)
+       FROM (
+         SELECT DISTINCT ON (coalesce(alias.canonical_id, concept ->> 'id'))
+                CASE WHEN alias.canonical_id IS NOT NULL
+                     THEN jsonb_set(concept, '{id}', to_jsonb(alias.canonical_id))
+                     ELSE concept END AS rewritten,
+                ordinal
+         FROM jsonb_array_elements(cm.document -> 'concepts') WITH ORDINALITY
+              AS entry(concept, ordinal)
+         LEFT JOIN concept_aliases alias ON alias.alias_id = concept ->> 'id'
+         ORDER BY coalesce(alias.canonical_id, concept ->> 'id'), ordinal DESC
+       ) definitions)
+    ELSE coalesce(cm.document -> 'concepts', '[]'::jsonb)
+  END
+)
+WHERE EXISTS (
+  SELECT 1
+  FROM jsonb_array_elements(
+    CASE WHEN jsonb_typeof(cm.document -> 'items') = 'array'
+         THEN cm.document -> 'items' ELSE '[]'::jsonb END
+  ) AS item
+  JOIN concept_aliases alias ON alias.alias_id = item ->> 'conceptId'
+)
+OR EXISTS (
+  SELECT 1
+  FROM jsonb_array_elements(
+    CASE WHEN jsonb_typeof(cm.document -> 'concepts') = 'array'
+         THEN cm.document -> 'concepts' ELSE '[]'::jsonb END
+  ) AS concept
+  JOIN concept_aliases alias ON alias.alias_id = concept ->> 'id'
+)
+SQL
+   )
+  (query-exec
+   db
+   #<<SQL
+DELETE FROM concept_definitions definition
+USING concept_aliases alias
+WHERE definition.id = alias.alias_id
+SQL
+   )
+  (record-schema-version! db 17))
+
+(define (migrate-17->18! db)
+  ;; Normalize the current documents themselves. Compatibility aliases are not
+  ;; part of the final model: every active placement is rewritten to the one
+  ;; id selected for its normalized name, then duplicate definitions are gone.
+  (query-exec
+   db
+   #<<SQL
+CREATE TEMP TABLE concept_id_merge (
+  old_id TEXT PRIMARY KEY,
+  canonical_id TEXT NOT NULL
+) ON COMMIT DROP
+SQL
+   )
+  (query-exec
+   db
+   #<<SQL
+WITH placements AS (
+  SELECT item ->> 'conceptId' AS concept_id,
+         lower(trim(coalesce(repository.document ->> 'label', item ->> 'label', ''))) AS name_key,
+         cm.updated_at,
+         cm.id AS map_id
+  FROM concept_maps cm
+  CROSS JOIN LATERAL jsonb_array_elements(
+    CASE WHEN jsonb_typeof(cm.document -> 'items') = 'array'
+         THEN cm.document -> 'items' ELSE '[]'::jsonb END
+  ) AS item
+  LEFT JOIN LATERAL (
+    SELECT concept AS document
+    FROM jsonb_array_elements(
+      CASE WHEN jsonb_typeof(cm.document -> 'concepts') = 'array'
+           THEN cm.document -> 'concepts' ELSE '[]'::jsonb END
+    ) AS concept
+    WHERE concept ->> 'id' = item ->> 'conceptId'
+    LIMIT 1
+  ) repository ON TRUE
+  WHERE cm.archived = FALSE
+    AND nullif(item ->> 'conceptId', '') IS NOT NULL
+    AND coalesce(item ->> 'kind', 'concept') <> 'phrase'
+), latest_name_per_id AS (
+  SELECT DISTINCT ON (concept_id)
+         concept_id, name_key, updated_at, map_id
+  FROM placements
+  WHERE name_key <> ''
+  ORDER BY concept_id, updated_at DESC, map_id DESC
+), ranked AS (
+  SELECT concept_id,
+         first_value(concept_id) OVER (
+           PARTITION BY name_key
+           ORDER BY updated_at DESC, map_id DESC, concept_id DESC
+         ) AS canonical_id
+  FROM latest_name_per_id
+)
+INSERT INTO concept_id_merge(old_id, canonical_id)
+SELECT concept_id, canonical_id
+FROM ranked
+WHERE concept_id <> canonical_id
+SQL
+   )
+  (query-exec
+   db
+   #<<SQL
+UPDATE concept_maps cm
+SET document = cm.document || jsonb_build_object(
+  'items', CASE
+    WHEN jsonb_typeof(cm.document -> 'items') = 'array' THEN
+      (SELECT coalesce(jsonb_agg(
+         CASE WHEN merge.canonical_id IS NOT NULL
+              THEN jsonb_set(item, '{conceptId}', to_jsonb(merge.canonical_id))
+              ELSE item END
+         ORDER BY ordinal
+       ), '[]'::jsonb)
+       FROM jsonb_array_elements(cm.document -> 'items') WITH ORDINALITY AS entry(item, ordinal)
+       LEFT JOIN concept_id_merge merge ON merge.old_id = item ->> 'conceptId')
+    ELSE coalesce(cm.document -> 'items', '[]'::jsonb)
+  END,
+  'concepts', CASE
+    WHEN jsonb_typeof(cm.document -> 'concepts') = 'array' THEN
+      (SELECT coalesce(jsonb_agg(rewritten ORDER BY ordinal), '[]'::jsonb)
+       FROM (
+         SELECT DISTINCT ON (coalesce(merge.canonical_id, concept ->> 'id'))
+                CASE WHEN merge.canonical_id IS NOT NULL
+                     THEN jsonb_set(concept, '{id}', to_jsonb(merge.canonical_id))
+                     ELSE concept END AS rewritten,
+                ordinal
+         FROM jsonb_array_elements(cm.document -> 'concepts') WITH ORDINALITY
+              AS entry(concept, ordinal)
+         LEFT JOIN concept_id_merge merge ON merge.old_id = concept ->> 'id'
+         ORDER BY coalesce(merge.canonical_id, concept ->> 'id'), ordinal DESC
+       ) definitions)
+    ELSE coalesce(cm.document -> 'concepts', '[]'::jsonb)
+  END
+)
+WHERE EXISTS (
+  SELECT 1
+  FROM jsonb_array_elements(
+    CASE WHEN jsonb_typeof(cm.document -> 'items') = 'array'
+         THEN cm.document -> 'items' ELSE '[]'::jsonb END
+  ) AS item
+  JOIN concept_id_merge merge ON merge.old_id = item ->> 'conceptId'
+)
+OR EXISTS (
+  SELECT 1
+  FROM jsonb_array_elements(
+    CASE WHEN jsonb_typeof(cm.document -> 'concepts') = 'array'
+         THEN cm.document -> 'concepts' ELSE '[]'::jsonb END
+  ) AS concept
+  JOIN concept_id_merge merge ON merge.old_id = concept ->> 'id'
+)
+SQL
+   )
+  (query-exec db "DELETE FROM concept_definitions")
+  (query-exec
+   db
+   #<<SQL
+WITH candidates AS (
+  SELECT concept ->> 'id' AS id,
+         concept - 'kind' - 'parentCmapLink' AS document,
+         cm.updated_at,
+         cm.updated_by,
+         cm.id AS map_id
+  FROM concept_maps cm
+  CROSS JOIN LATERAL jsonb_array_elements(
+    CASE WHEN jsonb_typeof(cm.document -> 'concepts') = 'array'
+         THEN cm.document -> 'concepts' ELSE '[]'::jsonb END
+  ) AS concept
+  WHERE cm.archived = FALSE AND nullif(concept ->> 'id', '') IS NOT NULL
+  UNION ALL
+  SELECT item ->> 'conceptId' AS id,
+         jsonb_strip_nulls(jsonb_build_object(
+           'id', item -> 'conceptId',
+           'label', item -> 'label',
+           'synopsis', item -> 'synopsis',
+           'aspects', item -> 'aspects',
+           'tags', item -> 'tags',
+           'descriptionPageSlug', item -> 'descriptionPageSlug',
+           'pageSlug', item -> 'pageSlug',
+           'cmapSlug', item -> 'cmapSlug',
+           'imageSource', item -> 'imageSource'
+         )) AS document,
+         cm.updated_at,
+         cm.updated_by,
+         cm.id AS map_id
+  FROM concept_maps cm
+  CROSS JOIN LATERAL jsonb_array_elements(
+    CASE WHEN jsonb_typeof(cm.document -> 'items') = 'array'
+         THEN cm.document -> 'items' ELSE '[]'::jsonb END
+  ) AS item
+  WHERE cm.archived = FALSE
+    AND nullif(item ->> 'conceptId', '') IS NOT NULL
+    AND coalesce(item ->> 'kind', 'concept') <> 'phrase'
+), ranked AS (
+  SELECT candidates.*,
+         row_number() OVER (
+           PARTITION BY id
+           ORDER BY updated_at DESC, map_id DESC
+         ) AS position
+  FROM candidates
+)
+INSERT INTO concept_definitions(id, document, updated_at, updated_by)
+SELECT id, jsonb_set(document, '{id}', to_jsonb(id)), updated_at, updated_by
+FROM ranked
+WHERE position = 1
+SQL
+   )
+  (query-exec db "DROP TABLE IF EXISTS concept_aliases")
+  (record-schema-version! db 18))
+
+(define (migrate-18->19! db)
+  ;; Concept content must have exactly one source. Remove the old denormalized
+  ;; copies from placements; linking phrases retain their own text because
+  ;; they are relations rather than concepts.
+  (query-exec
+   db
+   #<<SQL
+UPDATE concept_maps cm
+SET document = jsonb_set(
+  cm.document,
+  '{items}',
+  (SELECT coalesce(jsonb_agg(
+     CASE WHEN coalesce(item ->> 'kind', 'concept') = 'phrase'
+          THEN item
+          ELSE item
+               - 'label'
+               - 'synopsis'
+               - 'aspects'
+               - 'tags'
+               - 'descriptionPageSlug'
+               - 'pageSlug'
+               - 'cmapSlug'
+               - 'imageSource'
+          END
+     ORDER BY ordinal
+   ), '[]'::jsonb)
+   FROM jsonb_array_elements(
+     CASE WHEN jsonb_typeof(cm.document -> 'items') = 'array'
+          THEN cm.document -> 'items' ELSE '[]'::jsonb END
+   ) WITH ORDINALITY AS entry(item, ordinal)),
+  TRUE
+)
+WHERE jsonb_typeof(cm.document) = 'object'
+SQL
+   )
+  (record-schema-version! db 19))
+
+(define (migrate-19->20! db)
+  ;; Current CMaps store concept references only. Full concept content lives in
+  ;; concept_definitions and is hydrated into API responses on read. Historical
+  ;; snapshots remain immutable.
+  (query-exec
+   db
+   #<<SQL
+UPDATE concept_maps cm
+SET document = cm.document || jsonb_build_object(
+  'items',
+    (SELECT coalesce(jsonb_agg(
+       CASE WHEN coalesce(item ->> 'kind', 'concept') = 'phrase'
+            THEN item
+            ELSE item
+                 - 'label'
+                 - 'synopsis'
+                 - 'aspects'
+                 - 'tags'
+                 - 'descriptionPageSlug'
+                 - 'pageSlug'
+                 - 'cmapSlug'
+                 - 'imageSource'
+            END
+       ORDER BY ordinal
+     ), '[]'::jsonb)
+     FROM jsonb_array_elements(
+       CASE WHEN jsonb_typeof(cm.document -> 'items') = 'array'
+            THEN cm.document -> 'items' ELSE '[]'::jsonb END
+     ) WITH ORDINALITY AS entry(item, ordinal)),
+  'concepts',
+    (SELECT coalesce(jsonb_agg(jsonb_build_object('id', concept_id)
+                               ORDER BY ordinal), '[]'::jsonb)
+     FROM (
+       SELECT DISTINCT ON (concept_id) concept_id, ordinal
+       FROM (
+         SELECT concept ->> 'id' AS concept_id, ordinal
+         FROM jsonb_array_elements(
+           CASE WHEN jsonb_typeof(cm.document -> 'concepts') = 'array'
+                THEN cm.document -> 'concepts' ELSE '[]'::jsonb END
+         ) WITH ORDINALITY AS concept_entry(concept, ordinal)
+         UNION ALL
+         SELECT item ->> 'conceptId' AS concept_id, 1000000000 + ordinal
+         FROM jsonb_array_elements(
+           CASE WHEN jsonb_typeof(cm.document -> 'items') = 'array'
+                THEN cm.document -> 'items' ELSE '[]'::jsonb END
+         ) WITH ORDINALITY AS item_entry(item, ordinal)
+         WHERE coalesce(item ->> 'kind', 'concept') <> 'phrase'
+       ) all_references
+       WHERE nullif(concept_id, '') IS NOT NULL
+       ORDER BY concept_id, ordinal
+     ) concept_references)
+)
+WHERE jsonb_typeof(cm.document) = 'object'
+SQL
+   )
+  (record-schema-version! db 20))
+
+(define (migrate-20->21! db)
+  ;; Current concept identity is a plain globally unique UUID. Preserve the
+  ;; UUID portion of newer concept-<uuid> identifiers and allocate a UUID only
+  ;; for genuinely old/local ids. CMap slugs and historical snapshots are not
+  ;; identity aliases and deliberately remain unchanged.
+  (query-exec
+   db
+   #<<SQL
+CREATE TEMP TABLE concept_uuid_rekey (
+  old_id TEXT PRIMARY KEY,
+  new_id TEXT NOT NULL
+) ON COMMIT DROP
+SQL
+   )
+  (define old-ids
+    (query-list
+     db
+     #<<SQL
+WITH all_current_ids AS (
+  SELECT id AS old_id FROM concept_definitions
+  UNION
+  SELECT concept ->> 'id' AS old_id
+  FROM concept_maps cm
+  CROSS JOIN LATERAL jsonb_array_elements(
+    CASE WHEN jsonb_typeof(cm.document -> 'concepts') = 'array'
+         THEN cm.document -> 'concepts' ELSE '[]'::jsonb END
+  ) AS concept
+  UNION
+  SELECT item ->> 'conceptId' AS old_id
+  FROM concept_maps cm
+  CROSS JOIN LATERAL jsonb_array_elements(
+    CASE WHEN jsonb_typeof(cm.document -> 'items') = 'array'
+         THEN cm.document -> 'items' ELSE '[]'::jsonb END
+  ) AS item
+  WHERE coalesce(item ->> 'kind', 'concept') <> 'phrase'
+)
+SELECT old_id
+FROM all_current_ids
+WHERE nullif(old_id, '') IS NOT NULL
+ORDER BY old_id
+SQL
+     ))
+  ;; Reserve every already canonical UUID before generating replacements, so a
+  ;; random id can never collide with a UUID encountered later in the query.
+  (define used-ids (make-hash))
+  (for ([old-id (in-list old-ids)])
+    (define normalized (normalize-concept-id old-id))
+    (when normalized (hash-set! used-ids normalized #t)))
+  (define (fresh-unused-id)
+    (let loop ()
+      (define candidate (new-concept-id))
+      (if (hash-has-key? used-ids candidate)
+          (loop)
+          (begin
+            (hash-set! used-ids candidate #t)
+            candidate))))
+  (for ([old-id (in-list old-ids)])
+    (query-exec
+     db
+     "INSERT INTO concept_uuid_rekey(old_id, new_id) VALUES ($1, $2)"
+     old-id
+     (or (normalize-concept-id old-id) (fresh-unused-id))))
+  (query-exec
+   db
+   #<<SQL
+UPDATE concept_maps cm
+SET document = cm.document || jsonb_build_object(
+  'items',
+    (SELECT coalesce(jsonb_agg(
+       CASE WHEN rekey.new_id IS NULL
+            THEN item
+            ELSE jsonb_set(item, '{conceptId}', to_jsonb(rekey.new_id))
+            END
+       ORDER BY ordinal
+     ), '[]'::jsonb)
+     FROM jsonb_array_elements(
+       CASE WHEN jsonb_typeof(cm.document -> 'items') = 'array'
+            THEN cm.document -> 'items' ELSE '[]'::jsonb END
+     ) WITH ORDINALITY AS entry(item, ordinal)
+     LEFT JOIN concept_uuid_rekey rekey ON rekey.old_id = item ->> 'conceptId'),
+  'concepts',
+    (SELECT coalesce(jsonb_agg(jsonb_build_object('id', new_id)
+                               ORDER BY ordinal), '[]'::jsonb)
+     FROM (
+       SELECT DISTINCT ON (rekey.new_id) rekey.new_id, ordinal
+       FROM jsonb_array_elements(
+         CASE WHEN jsonb_typeof(cm.document -> 'concepts') = 'array'
+              THEN cm.document -> 'concepts' ELSE '[]'::jsonb END
+       ) WITH ORDINALITY AS entry(concept, ordinal)
+       JOIN concept_uuid_rekey rekey ON rekey.old_id = concept ->> 'id'
+       ORDER BY rekey.new_id, ordinal
+     ) rewritten_concepts)
+)
+WHERE jsonb_typeof(cm.document) = 'object'
+SQL
+   )
+  (query-exec
+   db
+   #<<SQL
+CREATE TEMP TABLE rekeyed_concept_definitions ON COMMIT DROP AS
+SELECT DISTINCT ON (rekey.new_id)
+       rekey.new_id AS id,
+       jsonb_set(definition.document, '{id}', to_jsonb(rekey.new_id)) AS document,
+       definition.updated_at,
+       definition.updated_by
+FROM concept_definitions definition
+JOIN concept_uuid_rekey rekey ON rekey.old_id = definition.id
+ORDER BY rekey.new_id, definition.updated_at DESC, definition.id
+SQL
+   )
+  (query-exec db "DELETE FROM concept_definitions")
+  (query-exec
+   db
+   #<<SQL
+INSERT INTO concept_definitions(id, document, updated_at, updated_by)
+SELECT id, document, updated_at, updated_by
+FROM rekeyed_concept_definitions
+SQL
+   )
+  (query-exec
+   db
+   #<<SQL
+ALTER TABLE concept_definitions
+ADD CONSTRAINT concept_definitions_uuid_id_check
+CHECK (id ~ '^[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}$')
+SQL
+   )
+  (record-schema-version! db 21))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Bring a racket-wiki PostgreSQL database to the current schema.
 ; pre    : db is a writable PostgreSQL connection and config identifies the
@@ -468,6 +1254,33 @@ SQL
      (define after-concept-map-history (database-schema-version db))
      (when (= after-concept-map-history 11)
        (migrate-11->12! db))
+     (define after-concept-map-history-cleanup (database-schema-version db))
+     (when (= after-concept-map-history-cleanup 12)
+       (migrate-12->13! db))
+     (define after-people (database-schema-version db))
+     (when (= after-people 13)
+       (migrate-13->14! db))
+     (define after-concept-definitions (database-schema-version db))
+     (when (= after-concept-definitions 14)
+       (migrate-14->15! db))
+     (define after-submap-concepts (database-schema-version db))
+     (when (= after-submap-concepts 15)
+       (migrate-15->16! db))
+     (define after-concept-link-aliases (database-schema-version db))
+     (when (= after-concept-link-aliases 16)
+       (migrate-16->17! db))
+     (define after-concept-name-merge (database-schema-version db))
+     (when (= after-concept-name-merge 17)
+       (migrate-17->18! db))
+     (define after-concept-normalization (database-schema-version db))
+     (when (= after-concept-normalization 18)
+       (migrate-18->19! db))
+     (define after-placement-content-cleanup (database-schema-version db))
+     (when (= after-placement-content-cleanup 19)
+       (migrate-19->20! db))
+     (define after-central-concept-references (database-schema-version db))
+     (when (= after-central-concept-references 20)
+       (migrate-20->21! db))
      (define resulting-version (database-schema-version db))
      (when (> resulting-version current-schema-version)
        (error 'migrate-database!

private/people.rkt

@@ -0,0 +1,119 @@
+#lang racket/base
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Wiki-wide registry for person tags used by CMap concepts.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(require db
+         racket/list
+         racket/string
+         "database.rkt")
+
+(provide list-people
+         create-person!
+         update-person!
+         sync-person-tags!)
+
+(define (row->person row)
+  (hash 'id (vector-ref row 0)
+        'name (vector-ref row 1)
+        'active (vector-ref row 2)))
+
+(define (list-people config [include-inactive? #t])
+  (call-with-wiki-database
+   config
+   (lambda (db)
+     (for/list ((row (in-list
+                      (query-rows
+                       db
+                       (string-append
+                        "SELECT id, name, active FROM people"
+                        (if include-inactive? "" " WHERE active = TRUE")
+                        " ORDER BY lower(name), name")))))
+       (row->person row)))))
+
+(define (clean-person-name who name)
+  (unless (string? name)
+    (raise-argument-error who "string?" name))
+  (define clean (string-trim name))
+  (when (or (string=? clean "") (> (string-length clean) 200))
+    (error who "person name must contain between 1 and 200 characters"))
+  clean)
+
+(define (create-person! config name)
+  (define clean-name (clean-person-name 'create-person! name))
+  (call-with-wiki-database
+   config
+   (lambda (db)
+     (define now (current-seconds))
+     (row->person
+      (query-row
+       db
+       #<<SQL
+INSERT INTO people(name, active, created_at, updated_at)
+VALUES ($1, TRUE, $2, $2)
+ON CONFLICT (lower(name)) DO UPDATE
+SET name = excluded.name, active = TRUE, updated_at = excluded.updated_at
+RETURNING id, name, active
+SQL
+       clean-name now)))))
+
+(define (update-person! config id name active?)
+  (define clean-name (clean-person-name 'update-person! name))
+  (call-with-wiki-database
+   config
+   (lambda (db)
+     (define row
+       (query-maybe-row
+        db
+        #<<SQL
+UPDATE people
+SET name = $1, active = $2, updated_at = $3
+WHERE id = $4
+RETURNING id, name, active
+SQL
+        clean-name (if active? #t #f) (current-seconds) id))
+     (and row (row->person row)))))
+
+(define (person-tag-names document)
+  (remove-duplicates
+   (for*/list ((concept (in-list
+                         (append (hash-ref document 'concepts '())
+                                 (hash-ref document 'items '()))))
+               #:when (hash? concept)
+               (tag (in-list (hash-ref concept 'tags '())))
+               #:when (and (hash? tag)
+                           (string=? (hash-ref tag 'type "") "person")
+                           (string? (hash-ref tag 'value #f))
+                           (not (string=? (string-trim (hash-ref tag 'value)) ""))))
+     (string-trim (hash-ref tag 'value)))
+   string-ci=?))
+
+;; Called inside the concept-map write transaction. New names become active;
+;; an explicitly deactivated existing name remains deactivated.
+(define (sync-person-tags! db document)
+  (define now (current-seconds))
+  (for ((name (in-list (person-tag-names document))))
+    (query-exec
+     db
+     #<<SQL
+INSERT INTO people(name, active, created_at, updated_at)
+VALUES ($1, TRUE, $2, $2)
+ON CONFLICT (lower(name)) DO NOTHING
+SQL
+     name now))
+  (void))
+
+(module+ test
+  (require rackunit)
+  (check-equal?
+   (person-tag-names
+    (hash 'concepts
+          (list (hash 'tags
+                      (list (hash 'type "person" 'value " Alex Morgan ")
+                            (hash 'type "label" 'value "architecture")))
+                (hash 'tags
+                      (list (hash 'type "person" 'value "alex morgan")
+                            (hash 'type "person" 'value "Sam de Vries"))))
+          'items '()))
+   '("Alex Morgan" "Sam de Vries")))

private/vendor.rkt

@@ -25,6 +25,8 @@
          "https://cdn.jsdelivr.net/npm/easymde@2.21.0/dist/easymde.min.css")
    (cons "purify.min.js"
          "https://cdn.jsdelivr.net/npm/dompurify@3.4.13/dist/purify.min.js")
+   (cons "mermaid.min.js"
+         "https://cdn.jsdelivr.net/npm/mermaid@11.17.1/dist/mermaid.min.js")
    (cons "highlight.min.js"
          "https://cdn.jsdelivr.net/gh/highlightjs/cdn-release@11.12.0/build/highlight.min.js")
    (cons "highlight-scheme.min.js"