readit

 1(import (chicken process-context) (chicken file) (chicken format)
 2        matchable (readit parser) srfi-1 srfi-37)
 3(include-relative "util.scm")
 4
 5(define files '())
 6(define fvals '())
 7(define state '())
 8
 9(define (usage)
10  (print "Usage: readit [-x] [-f FILE] [-v VALUE] [NAME]")
11  (exit))
12
13(define help
14  (option
15    '(#\h "help") #f #f
16    (lambda _
17      (usage))))
18
19(define done
20  (option
21    '(#\x "exclude-done") #f #f
22    (lambda (o n x vals)
23      (set! state #\-)
24      vals)))
25
26(define file
27  (option
28    '(#\f "file") #t #t
29    (lambda (o n x vals)
30      (set! files (cons x files))
31      vals)))
32
33(define value
34  (option
35    '(#\v "value") #t #t
36    (lambda (o n x vals)
37      (set! fvals (cons x fvals))
38      vals)))
39
40;; TODO: match regex
41;; TODO: optionally ignore case during matches
42(define (field-matches? fval str)
43  (cond ((readit-ref? fval)
44         (any (lambda (e) (equal? e (string->symbol str)))
45              (vector->list fval)))
46        ((readit-set? fval)
47         (any (lambda (e) (equal? e str)) (vector->list fval)))
48        (else (equal? fval str))))
49
50(define (filter-fields fields name vals)
51  (filter (lambda (field)
52            (match-let (((key . val) field))
53              (and
54                (equal? key name)
55                (every (lambda (v) (field-matches? val v)) vals))))
56          fields))
57
58(define (filter-entries entries state name vals)
59  (filter (lambda (entry)
60            (match-let (((meta fields _) entry))
61              (and
62                (or (null? state) (eqv? (meta-state meta) state))
63                (not (null? (filter-fields fields name vals))))))
64          entries))
65
66(define (main)
67  (let* ((args (parse-args (list help done file value))))
68    (when (> (length args) 1)
69      (usage))
70
71    (let* ((entries
72             (if (null? files)
73               (parse-input (current-input-port))
74               (parse-files files))))
75      (unless (equal? (length args) 0)
76        (for-each (lambda (entry) (print (car entry)))
77                  (filter-entries entries state (car args) fvals))))))
78
79(cond-expand
80  ((or chicken-script compiling) (main))
81  (else #t))