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

refactoring van de cmap structuren bijna compleet

Browse Source
This commit is contained in:
Hans Dijkema
2026-09-03 16:21:21 +02:00
parent 1abc84489f
commit bd1ef6bed0
75 changed files with 2547 additions and 1967 deletions
Download Patch File Download Diff File Expand all files Collapse all files
private/cmap-storage.rkt
+32 -8
View File
@@ -354,6 +354,18 @@ SQL
(hash-set result 'document (text->document (vector-ref row 2)))
result)))
;;; Read the latest SVG render for one database CMap and version.
(define (cmap-render-by-version db cmap-slug version)
(let ((row (query-maybe-row db
#<<SQL
SELECT r.content
FROM cmap_renders r
JOIN concept_maps m ON m.id = r.concept_map_id
WHERE m.slug = $1 AND r.document_version = $2
SQL
cmap-slug version)))
(and row (vector-ref row 0))))
;;; Converts SQL NULL to JSON null and otherwise returns the selected row value.
(define (nullable-row-value row index)
(let ((value (vector-ref row index)))
@@ -731,10 +743,13 @@ SQL
"SELECT " concept-map-columns
" FROM concept_maps WHERE slug = $1 AND archived = FALSE")
slug)))
(if row
(hash-update (row->concept-map row)
'document
(λ (document) (hydrate-concept-definitions db document)))
(if row
(hash-set
(hash-update (row->concept-map row)
'document
(λ (document) (hydrate-concept-definitions db document)))
'renderedSvg
(or (cmap-render-by-version db (vector-ref row 0) (vector-ref row 3)) ""))
#f))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -748,7 +763,7 @@ SQL
; update shared registries, and concept-map-storage-document strips
; duplicate content before insertion. read-concept-map hydrates the result.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (create-concept-map! config slug title document author)
(define (create-concept-map! config slug title document author [rendered-svg ""])
(let* ((clean-slug (string-trim slug))
(clean-title (string-trim title))
(now (current-seconds)))
@@ -766,7 +781,7 @@ SQL
(concept-map-storage-document canonical-document))))
(sync-concept-definitions! db canonical-document author now)
(sync-person-tags! db canonical-document)
(query-value
(let ((cmap-id (query-value
db
#<<SQL
INSERT INTO concept_maps
@@ -774,7 +789,12 @@ INSERT INTO concept_maps
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)))
(unless (string=? rendered-svg "")
(query-exec db
"INSERT INTO cmap_renders (concept_map_id, document_version, mime_type, content, created_at) VALUES ($1, $2, $3, $4, $5)"
cmap-id 1 "image/svg+xml" rendered-svg now))
cmap-id))))))
(read-concept-map config clean-slug)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -845,7 +865,7 @@ SQL
; is pruned by prune-manual-concept-map-versions! before read-back.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (update-concept-map! config slug title document author base-version
[summary "Edited CMap"] [action "manual"])
[summary "Edited CMap"] [action "manual"] [rendered-svg ""])
(unless (member action '("autosave" "manual" "snapshot"))
(error 'update-concept-map! "invalid save action: ~a" action))
(let ((clean-title (string-trim title)))
@@ -898,6 +918,10 @@ SQL
author
(vector-ref row 0))
(sync-person-tags! db canonical-document)
(unless (string=? rendered-svg "")
(query-exec db
"INSERT INTO cmap_renders (concept_map_id, document_version, mime_type, content, created_at) VALUES ($1, $2, $3, $4, $5) ON CONFLICT (concept_map_id, document_version) DO UPDATE SET content = EXCLUDED.content, created_at = EXCLUDED.created_at"
(vector-ref row 0) next-version "image/svg+xml" rendered-svg now))
(unless (string=? action "autosave")
(insert-concept-map-version!
db (vector-ref row 0) next-version clean-title document-text