1#lang racket/base
2(require "../common/check.rkt")
3
4(provide check-level
5         level>=?
6         level-max
7         level-min
8         parse-filters
9         filters-level-for-topic
10         filters-max-level
11         level->user-representation)
12
13;; A filter set is represented as an improper list of pairs ending
14;; with a (non-pair) level symbol. The ending symbol is the level that
15;; applies if a name match is not found for any of the preceding
16;; elements of the list.
17
18(define (level->value lvl)
19  (case lvl
20    [(none) 0]
21    [(fatal) 1]
22    [(error) 2]
23    [(warning) 3]
24    [(info) 4]
25    [(debug) 5]
26    [else #f]))
27
28(define (level>=? a b)
29  ((level->value a) . >= . (level->value b)))
30
31(define (level-max a b)
32  (if ((level->value a) . < . (level->value b))
33      b
34      a))
35
36(define (level-min a b)
37  (if ((level->value a) . < . (level->value b))
38      a
39      b))
40
41(define (check-level who v)
42  (unless (level->value v)
43    (raise-argument-error who
44                          "(or/c 'none 'fatal 'error 'warning 'info 'debug)"
45                          v)))
46
47;; ----------------------------------------
48
49(define (parse-filters who l #:default-level default-level)
50  (let loop ([l l] [accum null] [default-level default-level])
51  (cond
52    [(null? l)
53     (append accum default-level)]
54    [else
55     (define level (car l))
56     (check-level who level)
57     (cond
58       [(null? (cdr l))
59        (append accum level)]
60       [else
61        (define topic (cadr l))
62        (unless (or (not topic) (symbol? topic))
63          (raise-argument-error who "(or/c #f symbol?)" topic))
64        (if (not topic)
65            (loop (cddr l) accum level)
66            (loop (cddr l)
67                  (cons (cons topic level) accum)
68                  default-level))])])))
69
70(define (filters-level-for-topic filters topic)
71  (let loop ([filters filters])
72    (cond
73      [(pair? filters)
74       (cond
75         [(eq? (caar filters) topic)
76          (cdar filters)]
77         [else
78          (loop (cdr filters))])]
79      [else
80       ;; default:
81       filters])))
82
83(define (filters-max-level filters)
84  (let loop ([filters filters] [best-level 'none])
85    (cond
86      [(pair? filters)
87       (loop (cdr filters)
88             (level-max best-level (cdar filters)))]
89      [else
90       (level-max best-level filters)])))
91
92;; ----------------------------------------
93
94(define (level->user-representation lvl)
95  (if (eq? lvl 'none)
96      #f
97      lvl))
98