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
private/migrations.rkt
+37 -1
View File
@@ -21,7 +21,7 @@
;; Supporting functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define current-schema-version 22)
(define current-schema-version 23)
(define schema-1-statements
(list
@@ -1240,6 +1240,41 @@ SQL
)
(record-schema-version! db 22))
(define (migrate-22->23! db)
(query-exec db
#<<SQL
CREATE TABLE IF NOT EXISTS cmap_renders (
id BIGSERIAL PRIMARY KEY,
concept_map_id BIGINT NOT NULL REFERENCES concept_maps(id) ON DELETE CASCADE,
document_version BIGINT NOT NULL,
mime_type TEXT NOT NULL,
content TEXT NOT NULL,
created_at BIGINT NOT NULL,
UNIQUE(concept_map_id, document_version)
)
SQL
)
(query-exec db
"CREATE INDEX IF NOT EXISTS cmap_renders_map_idx ON cmap_renders(concept_map_id, document_version DESC)")
(query-exec db
#<<SQL
INSERT INTO cmap_renders
(concept_map_id, document_version, mime_type, content, created_at)
SELECT id, current_version, 'image/svg+xml', document ->> 'renderedSvg', updated_at
FROM concept_maps
WHERE jsonb_typeof(document -> 'renderedSvg') = 'string'
ON CONFLICT (concept_map_id, document_version) DO NOTHING
SQL
)
(query-exec db
#<<SQL
UPDATE concept_maps
SET document = document - 'renderedSvg'
WHERE jsonb_typeof(document -> 'renderedSvg') = 'string'
SQL
)
(record-schema-version! db 23))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Bring a racket-wiki PostgreSQL database to the current schema.
; pre : db is a writable PostgreSQL connection and config identifies the
@@ -1277,6 +1312,7 @@ SQL
((= version 19) (migrate-19->20! db) (loop (database-schema-version db)))
((= version 20) (migrate-20->21! db) (loop (database-schema-version db)))
((= version 21) (migrate-21->22! db) (loop (database-schema-version db)))
((= version 22) (migrate-22->23! db) (loop (database-schema-version db)))
((> version current-schema-version)
(error 'migrate-database!
"database schema ~a is newer than this racket-wiki supports (~a)"