hans/racket-wiki
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Lots of changes to the cmap stuff

Browse Source
This commit is contained in:
Hans Dijkema
2026-08-22 13:51:15 +02:00
parent 63b7ca0853
commit 20c1584016
17 changed files with 3105 additions and 204 deletions
Download Patch File Download Diff File Expand all files Collapse all files
private/cmap-storage.rkt
+138 -19
View File
@@ -11,11 +11,13 @@
"storage.rkt")
(provide list-concept-maps
list-concept-usage
list-recent-concept-maps
search-concept-maps
read-concept-map
concept-map-history
read-concept-map-version
delete-concept-map-version!
create-concept-map!
rename-concept-map!
update-concept-map!
@@ -81,6 +83,23 @@ VALUES ($1, $2, $3, $4::text::jsonb, $5, $6, $7, $8)
SQL
map-id version title document-text author action summary now))
(define (prune-manual-concept-map-versions! db map-id)
(query-exec
db
#<<SQL
DELETE FROM concept_map_versions
WHERE concept_map_id = $1
AND action = 'manual'
AND version NOT IN (
SELECT version
FROM concept_map_versions
WHERE concept_map_id = $1 AND action = 'manual'
ORDER BY version DESC
LIMIT 5
)
SQL
map-id))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : List current concept-map metadata.
; pre : Database schema migration 9 has been installed.
@@ -100,6 +119,73 @@ SQL
" ORDER BY lower(title), title")))))
(row->concept-map row #f)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Count current concept placements across every active CMap.
; pre : Concept-map documents use an items array when placements exist.
; post : No database state is changed.
; result : Rows containing global concept identity, linked page, concept/map
; labels, CMap slug and placement count.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (list-concept-usage config)
(call-with-wiki-database
config
(λ (db)
(for/list ((row (in-list
(query-rows
db
#<<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', ''),
nullif(item ->> 'label', ''),
'Concept') AS concept_label,
coalesce(nullif(repository.document ->> 'pageSlug', ''),
nullif(item ->> 'pageSlug', '')) AS page_slug
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_value AS document
FROM jsonb_array_elements(
CASE
WHEN jsonb_typeof(cm.document -> 'concepts') = 'array'
THEN cm.document -> 'concepts'
ELSE '[]'::jsonb
END
) AS concept_entry(concept_value)
WHERE concept_value ->> 'id' = item ->> 'conceptId'
LIMIT 1
) repository ON TRUE
WHERE cm.archived = FALSE
AND nullif(item ->> 'conceptId', '') IS NOT NULL
AND coalesce(item ->> 'kind', 'concept') NOT IN ('phrase', 'submap')
)
SELECT concept_id, slug, cmap_title, concept_label, page_slug, count(*)
FROM placements
GROUP BY concept_id, slug, cmap_title, concept_label, page_slug
ORDER BY concept_id, lower(cmap_title), cmap_title
SQL
))))
(hash 'conceptId (vector-ref row 0)
'cmapSlug (vector-ref row 1)
'cmapTitle (vector-ref row 2)
'label (vector-ref row 3)
'pageSlug (if (sql-null? (vector-ref row 4))
'null
(vector-ref row 4))
'count (vector-ref row 5))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : List recently edited current concept maps.
; pre : Database schema migration 9 has been installed.
@@ -207,7 +293,8 @@ SQL
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Create a persistent concept map.
; pre : slug is unused, title is non-empty and document is a JSON object.
; post : One concept_maps row exists at version 1.
; post : One concept_maps row exists at version 1; history starts only when
; the user explicitly saves or creates a snapshot.
; result : The newly stored concept-map hash.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (create-concept-map! config slug title document author)
@@ -222,24 +309,22 @@ SQL
(call-with-transaction
db
(λ ()
(define map-id
(query-value
db
#<<SQL
(query-value
db
#<<SQL
INSERT INTO concept_maps
(slug, title, document, current_version, created_at, updated_at, created_by, updated_by)
VALUES ($1, $2, $3::text::jsonb, 1, $4, $4, $5, $5)
RETURNING id
SQL
clean-slug clean-title document-text now author))
(insert-concept-map-version!
db map-id 1 clean-title document-text author "create" "Created CMap" now)))))
clean-slug clean-title document-text now author)))))
(read-concept-map config clean-slug))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Rename a concept map without storing unsaved editor content.
; pre : slug identifies a current map and base-version is current.
; post : Title, version and audit fields are updated atomically.
; post : Title, version and audit fields are updated atomically without
; adding a user-facing history item.
; result : The renamed concept-map hash with its unchanged document.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (rename-concept-map! config slug title author base-version)
@@ -283,19 +368,20 @@ SQL
now
author
(vector-ref row 0))
(insert-concept-map-version!
db (vector-ref row 0) next-version clean-title (vector-ref row 2)
author "rename" "Renamed CMap" now)))))
(void)))))
(read-concept-map config slug))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Store a new version of an existing concept map.
; goal : Store the current state of an existing concept map.
; pre : base-version equals the current database version.
; post : Title, document, version and audit fields are updated atomically.
; post : Current state and version are updated atomically. Autosaves create
; no history row; snapshots are unlimited; only five manual saves remain.
; result : The updated concept-map hash.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (update-concept-map! config slug title document author base-version
[summary "Edited CMap"] [action "edit"])
[summary "Edited CMap"] [action "manual"])
(unless (member action '("autosave" "manual" "snapshot"))
(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))
@@ -338,9 +424,12 @@ SQL
now
author
(vector-ref row 0))
(insert-concept-map-version!
db (vector-ref row 0) next-version clean-title document-text
author action summary now)))))
(unless (string=? action "autosave")
(insert-concept-map-version!
db (vector-ref row 0) next-version clean-title document-text
author action summary now))
(when (string=? action "manual")
(prune-manual-concept-map-versions! db (vector-ref row 0)))))))
(read-concept-map config slug))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -365,7 +454,7 @@ SQL
#<<SQL
SELECT version, title, author, action, summary, created_at
FROM concept_map_versions
WHERE concept_map_id = $1
WHERE concept_map_id = $1 AND action IN ('snapshot', 'manual')
ORDER BY version DESC
SQL
map-id))))
@@ -408,6 +497,36 @@ SQL
'summary (vector-ref row 5)
'createdAt (vector-ref row 6)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Delete one user-facing concept-map history item.
; pre : slug identifies a current map and version is numeric.
; post : Only the selected snapshot or manual-save row is removed; the
; current concept_maps document and version are unchanged.
; result : #t when an item was deleted, #f when it did not exist.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (delete-concept-map-version! config slug version)
(define version-number
(if (number? version) version (string->number version)))
(and version-number
(call-with-wiki-database
config
(lambda (db)
(and
(query-maybe-value
db
#<<SQL
DELETE FROM concept_map_versions cmv
USING concept_maps cm
WHERE cm.id = cmv.concept_map_id
AND cm.slug = $1
AND cm.archived = FALSE
AND cmv.version = $2
AND cmv.action IN ('snapshot', 'manual')
RETURNING cmv.version
SQL
slug version-number)
#t)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Soft-delete one concept map.
; pre : slug identifies a current map.
private/migrations.rkt
+41 -1
View File
@@ -20,7 +20,7 @@
;; Supporting functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define current-schema-version 11)
(define current-schema-version 12)
(define schema-1-statements
(list
@@ -384,6 +384,43 @@ SQL
)
(record-schema-version! db 11))
(define (migrate-11->12! db)
;; Older clients stored both automatic and explicit saves as `edit`. Preserve
;; the explicit saves, discard redundant autosave copies, and enforce the new
;; five-item manual history limit per CMap.
(query-exec db
#<<SQL
UPDATE concept_map_versions
SET action = 'manual'
WHERE action = 'edit'
AND summary IN ('Manual save', 'Handmatig opgeslagen')
SQL
)
(query-exec db
#<<SQL
DELETE FROM concept_map_versions
WHERE action = 'edit'
AND summary IN ('Automatic save', 'Automatisch opgeslagen')
SQL
)
(query-exec db
#<<SQL
WITH ranked AS (
SELECT id,
row_number() OVER (
PARTITION BY concept_map_id
ORDER BY version DESC
) AS position
FROM concept_map_versions
WHERE action = 'manual'
)
DELETE FROM concept_map_versions cmv
USING ranked
WHERE cmv.id = ranked.id AND ranked.position > 5
SQL
)
(record-schema-version! db 12))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Bring a racket-wiki PostgreSQL database to the current schema.
; pre : db is a writable PostgreSQL connection and config identifies the
@@ -428,6 +465,9 @@ SQL
(define after-user-profiles (database-schema-version db))
(when (= after-user-profiles 10)
(migrate-10->11! db))
(define after-concept-map-history (database-schema-version db))
(when (= after-concept-map-history 11)
(migrate-11->12! db))
(define resulting-version (database-schema-version db))
(when (> resulting-version current-schema-version)
(error 'migrate-database!