forked from cadence/breezewiki
		
	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
 | 
				
			||||||
                         (e-ref name)))
 | 
					                  (cast (environment-variables-ref (current-environment-variables) name)
 | 
				
			||||||
         (filter (λ (name) (string-prefix? (string-downcase (bytes->string/latin-1 name)) "bw_")) e-names))))
 | 
					                        Bytes)))])
 | 
				
			||||||
 | 
					    (map (λ ([name : Bytes])
 | 
				
			||||||
 | 
					           (cons (string->symbol (string-downcase (substring (bytes->string/latin-1 name) 3)))
 | 
				
			||||||
 | 
					                 (e-ref name)))
 | 
				
			||||||
 | 
					         (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…
	
	Add table
		Add a link
		
	
		Reference in a new issue