cmap functions, email, architecture documentation.

This commit is contained in:
2026-08-18 03:33:10 +02:00
parent 12f1ed2764
commit 63b7ca0853
33 changed files with 3974 additions and 80 deletions
+105 -11
View File
@@ -14,6 +14,8 @@
list-recent-concept-maps
search-concept-maps
read-concept-map
concept-map-history
read-concept-map-version
create-concept-map!
rename-concept-map!
update-concept-map!
@@ -70,6 +72,15 @@
(document->text document)
(void))
(define (insert-concept-map-version! db map-id version title document-text author action summary now)
(query-exec db
#<<SQL
INSERT INTO concept_map_versions
(concept_map_id, version, title, document, author, action, summary, created_at)
VALUES ($1, $2, $3, $4::text::jsonb, $5, $6, $7, $8)
SQL
map-id version title document-text author action summary now))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : List current concept-map metadata.
; pre : Database schema migration 9 has been installed.
@@ -208,14 +219,21 @@ SQL
(call-with-wiki-database
config
(λ (db)
(query-exec
(call-with-transaction
db
#<<SQL
(λ ()
(define map-id
(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)))
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)))))
(read-concept-map config clean-slug))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -237,7 +255,7 @@ SQL
(define row
(query-maybe-row
db
"SELECT id, current_version FROM concept_maps WHERE slug = $1 AND archived = FALSE FOR UPDATE"
"SELECT id, current_version, document::text FROM concept_maps WHERE slug = $1 AND archived = FALSE FOR UPDATE"
slug))
(unless row
(error 'rename-concept-map! "unknown concept map: ~a" slug))
@@ -248,6 +266,8 @@ SQL
(string->number (format "~a" base-version))))
(unless (and supplied-version (= supplied-version current-version))
(error 'rename-concept-map! "version-conflict"))
(define next-version (+ current-version 1))
(define now (current-seconds))
(query-exec
db
#<<SQL
@@ -259,10 +279,13 @@ SET title = $1,
WHERE id = $5
SQL
clean-title
(+ current-version 1)
(current-seconds)
next-version
now
author
(vector-ref row 0))))))
(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)))))
(read-concept-map config slug))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -271,7 +294,8 @@ SQL
; post : Title, document, version and audit fields are updated atomically.
; result : The updated concept-map hash.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (update-concept-map! config slug title document author base-version)
(define (update-concept-map! config slug title document author base-version
[summary "Edited CMap"] [action "edit"])
(define clean-title (string-trim title))
(validate-concept-map-input 'update-concept-map! slug clean-title document)
(define document-text (document->text document))
@@ -295,6 +319,8 @@ SQL
(string->number (format "~a" base-version))))
(unless (and supplied-version (= supplied-version current-version))
(error 'update-concept-map! "version-conflict"))
(define next-version (+ current-version 1))
(define now (current-seconds))
(query-exec
db
#<<SQL
@@ -308,12 +334,80 @@ WHERE id = $6
SQL
clean-title
document-text
(+ current-version 1)
(current-seconds)
next-version
now
author
(vector-ref row 0))))))
(vector-ref row 0))
(insert-concept-map-version!
db (vector-ref row 0) next-version clean-title document-text
author action summary now)))))
(read-concept-map config slug))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Read immutable version metadata for a concept map.
; pre : slug identifies a current concept map.
; post : Version rows have only been read.
; result : A newest-first list without the potentially large documents.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (concept-map-history config slug)
(call-with-wiki-database
config
(λ (db)
(define map-id
(query-maybe-value
db
"SELECT id FROM concept_maps WHERE slug = $1 AND archived = FALSE"
slug))
(unless map-id
(error 'concept-map-history "unknown concept map: ~a" slug))
(for/list ((row (in-list
(query-rows db
#<<SQL
SELECT version, title, author, action, summary, created_at
FROM concept_map_versions
WHERE concept_map_id = $1
ORDER BY version DESC
SQL
map-id))))
(hash 'version (vector-ref row 0)
'title (vector-ref row 1)
'author (vector-ref row 2)
'action (vector-ref row 3)
'summary (vector-ref row 4)
'createdAt (vector-ref row 5))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Read one immutable concept-map version.
; pre : slug and version identify a possible historical version.
; post : Version rows have only been read.
; result : Version metadata including its editor document, or #f.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (read-concept-map-version config slug version)
(define version-number
(if (number? version) version (string->number version)))
(and version-number
(call-with-wiki-database
config
(λ (db)
(define row
(query-maybe-row db
#<<SQL
SELECT cmv.version, cmv.title, cmv.document::text, cmv.author,
cmv.action, cmv.summary, cmv.created_at
FROM concept_map_versions cmv
JOIN concept_maps cm ON cm.id = cmv.concept_map_id
WHERE cm.slug = $1 AND cm.archived = FALSE AND cmv.version = $2
SQL
slug version-number))
(and row
(hash 'version (vector-ref row 0)
'title (vector-ref row 1)
'document (text->document (vector-ref row 2))
'author (vector-ref row 3)
'action (vector-ref row 4)
'summary (vector-ref row 5)
'createdAt (vector-ref row 6)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Soft-delete one concept map.
; pre : slug identifies a current map.