~williewillus/r16

r16/config.rkt -rw-r--r-- 837 bytes
d426a80dVincent Lee Expose replied-to message contents 7 days ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
#lang racket/base

(require racket/contract)
(provide config/c check-config)

(define-syntax-rule (config/c [key vpred] ...)
  (make-contract
   #:name '(config/c [key vpred] ...)
   #:first-order
   (lambda (x) (hash? x))
   #:projection
   (lambda (b)
     (compose
      (let ([check-val ((contract-projection vpred) b)])
        (lambda (x)
          (unless (hash? x)
            (raise-blame-error
             b x
             '(expected "hash?" given "~e")
             x))
          (unless (hash-has-key? x 'key)
            (raise-blame-error
             b x
             '(expected "hash with key ~e" given "~e")
             'key x)) ...
          (check-val (hash-ref x 'key))
          x)) ...))))

(define (check-config predicate config)
  (contract predicate config
            'config 'config
            'config #f))