133 lines
5.4 KiB
Racket
133 lines
5.4 KiB
Racket
#lang racket/base
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Wiki and user settings for the browser-side CMap workspace.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(require db
|
|
racket/string
|
|
"database.rkt")
|
|
|
|
(provide read-cmap-settings
|
|
save-start-cmap!
|
|
save-cmap-page-guides!
|
|
save-cmap-zoom!)
|
|
|
|
(define start-cmap-setting-key "cmap.start.v1")
|
|
|
|
(define (clean-context-key who context-key)
|
|
(unless (and (string? context-key)
|
|
(not (string=? (string-trim context-key) ""))
|
|
(<= (string-length context-key) 200))
|
|
(error who "invalid CMap context"))
|
|
context-key)
|
|
|
|
(define (clean-zoom who zoom)
|
|
(unless (and (exact-integer? zoom) (<= 25 zoom 300))
|
|
(error who "zoom must be an integer between 25 and 300"))
|
|
zoom)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Read the wiki start CMap and one user's CMap view preferences.
|
|
; pre : user-id identifies an authenticated wiki user.
|
|
; post : The database is unchanged; missing preferences receive defaults.
|
|
; result : A JSON-compatible settings hash.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (read-cmap-settings config user-id)
|
|
(call-with-wiki-database
|
|
config
|
|
(λ (db)
|
|
(define start-slug
|
|
(or (query-maybe-value
|
|
db
|
|
"SELECT value FROM wiki_settings WHERE key = $1"
|
|
start-cmap-setting-key)
|
|
""))
|
|
(define page-guide-row
|
|
(query-maybe-row
|
|
db
|
|
"SELECT page_guides_visible FROM user_cmap_preferences WHERE user_id = $1"
|
|
user-id))
|
|
(define page-guides-visible
|
|
(if page-guide-row (vector-ref page-guide-row 0) #t))
|
|
(define zoom-rows
|
|
(query-rows
|
|
db
|
|
"SELECT cmap_slug, context_key, zoom_percent FROM user_cmap_zoom_levels WHERE user_id = $1 ORDER BY cmap_slug, context_key"
|
|
user-id))
|
|
(define zooms
|
|
(for/list ((row (in-list zoom-rows)))
|
|
(hash 'cmapSlug (vector-ref row 0)
|
|
'contextKey (vector-ref row 1)
|
|
'zoomPercent (vector-ref row 2))))
|
|
(hash 'startCmapSlug start-slug
|
|
'pageGuidesVisible page-guides-visible
|
|
'zooms zooms))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Select the wiki-wide start CMap.
|
|
; pre : slug is empty, or identifies a current non-archived CMap.
|
|
; post : The start setting is removed or updated atomically.
|
|
; result : The stored slug, or the empty string when cleared.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (save-start-cmap! config slug)
|
|
(define clean-slug (if (string? slug) (string-trim slug) ""))
|
|
(call-with-wiki-database
|
|
config
|
|
(λ (db)
|
|
(cond
|
|
((string=? clean-slug "")
|
|
(query-exec db "DELETE FROM wiki_settings WHERE key = $1" start-cmap-setting-key))
|
|
((query-maybe-value
|
|
db
|
|
"SELECT 1 FROM concept_maps WHERE slug = $1 AND archived = FALSE"
|
|
clean-slug)
|
|
(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"
|
|
start-cmap-setting-key clean-slug (current-seconds)))
|
|
(else
|
|
(error 'save-start-cmap! "the selected start CMap does not exist")))))
|
|
clean-slug)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Store one user's wiki-wide A4 page-guide preference.
|
|
; pre : visible is a boolean and user-id identifies an authenticated user.
|
|
; post : The user's preference is inserted or updated atomically.
|
|
; result : The stored boolean.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (save-cmap-page-guides! config user-id visible)
|
|
(unless (boolean? visible)
|
|
(error 'save-cmap-page-guides! "pageGuidesVisible must be a boolean"))
|
|
(call-with-wiki-database
|
|
config
|
|
(λ (db)
|
|
(query-exec
|
|
db
|
|
"INSERT INTO user_cmap_preferences(user_id, page_guides_visible, updated_at) VALUES ($1, $2, $3) ON CONFLICT(user_id) DO UPDATE SET page_guides_visible = excluded.page_guides_visible, updated_at = excluded.updated_at"
|
|
user-id visible (current-seconds))))
|
|
visible)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Store one user's zoom for one CMap context.
|
|
; pre : The CMap exists, context-key is non-empty and zoom is 25 through 300.
|
|
; post : This single context preference is inserted or updated atomically.
|
|
; result : The normalized zoom percentage.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (save-cmap-zoom! config user-id cmap-slug context-key zoom)
|
|
(define clean-context (clean-context-key 'save-cmap-zoom! context-key))
|
|
(define clean-zoom-percent (clean-zoom 'save-cmap-zoom! zoom))
|
|
(call-with-wiki-database
|
|
config
|
|
(λ (db)
|
|
(unless (query-maybe-value
|
|
db
|
|
"SELECT 1 FROM concept_maps WHERE slug = $1 AND archived = FALSE"
|
|
cmap-slug)
|
|
(error 'save-cmap-zoom! "the selected CMap does not exist"))
|
|
(query-exec
|
|
db
|
|
"INSERT INTO user_cmap_zoom_levels(user_id, cmap_slug, context_key, zoom_percent, updated_at) VALUES ($1, $2, $3, $4, $5) ON CONFLICT(user_id, cmap_slug, context_key) DO UPDATE SET zoom_percent = excluded.zoom_percent, updated_at = excluded.updated_at"
|
|
user-id cmap-slug clean-context clean-zoom-percent (current-seconds))))
|
|
clean-zoom-percent)
|