Migrate config.rkt to Typed Racket
This commit is contained in:
parent
79f04565c7
commit
6b176e3f8f
2 changed files with 34 additions and 12 deletions
|
@ -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))))
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue