Migrate config.rkt to Typed Racket

This commit is contained in:
Cadence Ember 2022-10-04 22:00:44 +13:00
parent 79f04565c7
commit 6b176e3f8f
Signed by untrusted user: cadence
GPG key ID: BC1C2C61CF521B17
2 changed files with 34 additions and 12 deletions

View file

@ -1,23 +1,32 @@
#lang racket/base #lang typed/racket/base
(require racket/function (require racket/function
racket/pretty racket/pretty
racket/runtime-path racket/runtime-path
racket/string racket/string)
ini) (require/typed ini
[#:opaque Ini ini?]
[read-ini (Input-Port -> Ini)]
[ini->hash (Ini -> (Immutable-HashTable Symbol (Immutable-HashTable Symbol String)))])
(provide (provide
config-parameter config-parameter
config-true? config-true?
config-get) config-get)
(module+ test
(require "typed-rackunit.rkt"))
(define-runtime-path path-config "../config.ini") (define-runtime-path path-config "../config.ini")
(: config-parameter (Symbol -> (Parameterof String)))
(define (config-parameter key) (define (config-parameter key)
(hash-ref config key)) (hash-ref config key))
(: config-true? (Symbol -> Boolean))
(define (config-true? key) (define (config-true? key)
(not (member ((config-parameter key)) '("" "false")))) (not (member ((config-parameter key)) '("" "false"))))
(: config-get (Symbol -> String))
(define (config-get key) (define (config-get key)
((config-parameter key))) ((config-parameter key)))
@ -56,18 +65,24 @@
(define env-alist (define env-alist
(let ([e-names (environment-variables-names (current-environment-variables))] (let ([e-names (environment-variables-names (current-environment-variables))]
[e-ref (λ (name) (bytes->string/latin-1 (environment-variables-ref (current-environment-variables) name)))]) [e-ref (λ ([name : Bytes])
(map (λ (name) (cons (string->symbol (string-downcase (substring (bytes->string/latin-1 name) 3))) (bytes->string/latin-1
(cast (environment-variables-ref (current-environment-variables) name)
Bytes)))])
(map (λ ([name : Bytes])
(cons (string->symbol (string-downcase (substring (bytes->string/latin-1 name) 3)))
(e-ref name))) (e-ref name)))
(filter (λ (name) (string-prefix? (string-downcase (bytes->string/latin-1 name)) "bw_")) e-names)))) (filter (λ ([name : Bytes]) (string-prefix? (string-downcase (bytes->string/latin-1 name))
"bw_"))
e-names))))
(when (> (length env-alist) 0) (when (> (length env-alist) 0)
(printf "note: ~a items loaded from environment variables~n" (length env-alist))) (printf "note: ~a items loaded from environment variables~n" (length env-alist)))
(define combined-alist (append default-config loaded-alist env-alist)) (define combined-alist (append default-config loaded-alist env-alist))
(define config (define config
(make-hasheq (make-immutable-hasheq
(map (λ (pair) (map (λ ([pair : (Pairof Symbol String)])
(cons (car pair) (make-parameter (cdr pair)))) (cons (car pair) (make-parameter (cdr pair))))
combined-alist))) combined-alist)))
@ -75,8 +90,8 @@
; all values here are optimised for maximum prettiness ; all values here are optimised for maximum prettiness
(parameterize ([pretty-print-columns 80]) (parameterize ([pretty-print-columns 80])
(display "config: ") (display "config: ")
(pretty-write (sort (pretty-write ((inst sort (Pairof Symbol String))
(hash->list (make-hasheq combined-alist)) (hash->list (make-immutable-hasheq combined-alist))
symbol<? symbol<?
#:key car)))) #:key car))))
@ -85,3 +100,10 @@
(displayln (displayln
(string-append "warning: configuring canonical_origin is highly recommended for production!\n" (string-append "warning: configuring canonical_origin is highly recommended for production!\n"
" see https://docs.breezewiki.com/Configuration.html")))) " see https://docs.breezewiki.com/Configuration.html"))))
(module+ test
; this is just a sanity check
(parameterize ([(config-parameter 'application_name) "JeffWiki"]
[(config-parameter 'strict_proxy) ""])
(check-equal? (config-get 'application_name) "JeffWiki")
(check-false (config-true? 'strict_proxy))))

View file

@ -1,7 +1,7 @@
#lang typed/racket/base #lang typed/racket/base
(require racket/string (require racket/string
"config.rkt"
"pure-utils.rkt") "pure-utils.rkt")
(require/typed "config.rkt" [config-true? (Symbol -> Boolean)])
(provide (provide
; regex to match wiki names ; regex to match wiki names