refactoring by skill
This commit is contained in:
+72
-49
@@ -97,59 +97,82 @@
|
||||
(define (normalize-cmap-styles styles [who 'cmap-styles])
|
||||
(unless (and (list? styles) (<= 1 (length styles) maximum-style-count))
|
||||
(error who "styles must contain between 1 and ~a entries" maximum-style-count))
|
||||
(define seen (make-hash))
|
||||
(define normalized
|
||||
(for/list ([style (in-list styles)])
|
||||
(unless (hash? style) (error who "each style must be an object"))
|
||||
(define id (required-string who (hash-ref style 'id #f) "style id" 120))
|
||||
(unless (regexp-match? #px"^[A-Za-z0-9_-]+$" id) (error who "invalid style id"))
|
||||
(when (hash-ref seen id #f) (error who "duplicate style id: ~a" id))
|
||||
(hash-set! seen id #t)
|
||||
(define name (and (string? (hash-ref style 'name #f))
|
||||
(required-string who (hash-ref style 'name) "style name" maximum-style-name-length)))
|
||||
(define name-key (and (string? (hash-ref style 'nameKey #f))
|
||||
(string->symbol (required-string who (hash-ref style 'nameKey) "style name key" 40))))
|
||||
(unless (or name (member name-key permitted-name-keys))
|
||||
(error who "a style needs a name"))
|
||||
(hash 'id id
|
||||
(if (member name-key permitted-name-keys) 'nameKey 'name)
|
||||
(if (member name-key permitted-name-keys) (symbol->string name-key) name)
|
||||
'protected (string=? id "default")
|
||||
'values (normalize-style-values who (hash-ref style 'values #f)))))
|
||||
(unless (hash-ref seen "default" #f) (error who "the default style is required"))
|
||||
normalized)
|
||||
(let* ((seen (make-hash))
|
||||
(normalized
|
||||
(for/list ([style (in-list styles)])
|
||||
(unless (hash? style) (error who "each style must be an object"))
|
||||
(let* ((id (required-string who (hash-ref style 'id #f) "style id" 120))
|
||||
(name (and (string? (hash-ref style 'name #f))
|
||||
(required-string who
|
||||
(hash-ref style 'name)
|
||||
"style name"
|
||||
maximum-style-name-length)))
|
||||
(name-key
|
||||
(and (string? (hash-ref style 'nameKey #f))
|
||||
(string->symbol
|
||||
(required-string who
|
||||
(hash-ref style 'nameKey)
|
||||
"style name key"
|
||||
40)))))
|
||||
(unless (regexp-match? #px"^[A-Za-z0-9_-]+$" id)
|
||||
(error who "invalid style id"))
|
||||
(when (hash-ref seen id #f)
|
||||
(error who "duplicate style id: ~a" id))
|
||||
(hash-set! seen id #t)
|
||||
(unless (or name (member name-key permitted-name-keys))
|
||||
(error who "a style needs a name"))
|
||||
(hash 'id id
|
||||
(if (member name-key permitted-name-keys) 'nameKey 'name)
|
||||
(if (member name-key permitted-name-keys) (symbol->string name-key) name)
|
||||
'protected (string=? id "default")
|
||||
'values (normalize-style-values who (hash-ref style 'values #f)))))))
|
||||
(unless (hash-ref seen "default" #f)
|
||||
(error who "the default style is required"))
|
||||
normalized))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Read the shared CMap appearance styles.
|
||||
; pre : The wiki database is configured and its schema is initialized.
|
||||
; post : Default styles are inserted when no style setting exists yet.
|
||||
; result : A validated, normalized non-empty list of style hashes.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (read-cmap-styles config)
|
||||
(call-with-wiki-database
|
||||
config
|
||||
(lambda (db)
|
||||
(define stored
|
||||
(query-maybe-value db "SELECT value FROM wiki_settings WHERE key = $1" setting-key))
|
||||
(if stored
|
||||
(normalize-cmap-styles (string->jsexpr stored) 'read-cmap-styles)
|
||||
(let ([encoded (jsexpr->string (normalize-cmap-styles initial-cmap-styles))])
|
||||
(query-exec
|
||||
db
|
||||
"INSERT INTO wiki_settings(key, value, updated_at) VALUES ($1, $2, $3) ON CONFLICT(key) DO NOTHING"
|
||||
setting-key encoded (current-seconds))
|
||||
(normalize-cmap-styles
|
||||
(string->jsexpr
|
||||
(query-value db "SELECT value FROM wiki_settings WHERE key = $1" setting-key))
|
||||
'read-cmap-styles))))))
|
||||
(λ (db)
|
||||
(let ((stored
|
||||
(query-maybe-value db "SELECT value FROM wiki_settings WHERE key = $1" setting-key)))
|
||||
(if stored
|
||||
(normalize-cmap-styles (string->jsexpr stored) 'read-cmap-styles)
|
||||
(let ((encoded (jsexpr->string (normalize-cmap-styles initial-cmap-styles))))
|
||||
(query-exec
|
||||
db
|
||||
"INSERT INTO wiki_settings(key, value, updated_at) VALUES ($1, $2, $3) ON CONFLICT(key) DO NOTHING"
|
||||
setting-key encoded (current-seconds))
|
||||
(normalize-cmap-styles
|
||||
(string->jsexpr
|
||||
(query-value db "SELECT value FROM wiki_settings WHERE key = $1" setting-key))
|
||||
'read-cmap-styles)))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Validate and store the shared CMap appearance styles.
|
||||
; pre : styles is a non-empty list containing the required default style.
|
||||
; post : The normalized style setting is stored atomically in the database.
|
||||
; result : The normalized list of stored style hashes.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (save-cmap-styles! config styles)
|
||||
(define normalized (normalize-cmap-styles styles 'save-cmap-styles!))
|
||||
(define encoded (jsexpr->string normalized))
|
||||
(when (> (bytes-length (string->bytes/utf-8 encoded)) (* 128 1024))
|
||||
(error 'save-cmap-styles! "style data is too large"))
|
||||
(call-with-wiki-database
|
||||
config
|
||||
(lambda (db)
|
||||
(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"
|
||||
setting-key encoded (current-seconds))))
|
||||
normalized)
|
||||
(let* ((normalized (normalize-cmap-styles styles 'save-cmap-styles!))
|
||||
(encoded (jsexpr->string normalized)))
|
||||
(when (> (bytes-length (string->bytes/utf-8 encoded)) (* 128 1024))
|
||||
(error 'save-cmap-styles! "style data is too large"))
|
||||
(call-with-wiki-database
|
||||
config
|
||||
(λ (db)
|
||||
(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"
|
||||
setting-key encoded (current-seconds))))
|
||||
normalized))
|
||||
|
||||
(module+ test
|
||||
(require rackunit)
|
||||
@@ -164,8 +187,8 @@
|
||||
(list (hash 'id "default" 'nameKey "style-default" 'values values))))
|
||||
(check-equal? (hash-ref (hash-ref (first normalized) 'values) 'backgroundColor) "#fff4cf")
|
||||
(check-equal? (length (normalize-cmap-styles initial-cmap-styles)) 5)
|
||||
(check-exn exn:fail? (lambda () (normalize-cmap-styles '())))
|
||||
(check-exn exn:fail? (λ () (normalize-cmap-styles '())))
|
||||
(check-exn exn:fail?
|
||||
(lambda ()
|
||||
(λ ()
|
||||
(normalize-cmap-styles
|
||||
(list (hash 'id "custom" 'name "Custom" 'values values))))))
|
||||
|
||||
Reference in New Issue
Block a user