-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathcli-parsing.scm
104 lines (92 loc) · 3.35 KB
/
cli-parsing.scm
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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
(import (srfi 48))
(import (srfi 69))
(define-structure cli-option type key name description default)
(define (is-option? key)
(string=? (substring key 0 1) "-"))
(define (cli-option-key-match? key cli-opt)
(string=? (substring key 1 2) (cli-option-key cli-opt)))
(define (cli-option-name-match? name cli-opt)
(string=? name (cli-option-name cli-opt)))
(define (coerce-option-value value type)
(cond
((eq? type 'string)
value)
((eq? type 'number)
(string->number value))
(else (error (format "Unknown option type ~a" (cli-option-type cli-opt))))))
(define (option-exists? key cli-opts)
(let loop ((cli-opts cli-opts) (exists #f))
(cond
((null-list? cli-opts)
exists)
(exists exists)
(else
(loop (cdr cli-opts) (cli-option-key-match? key (car cli-opts)))))))
(define (make-help-message cli-opts)
(string-append "Usage: mnemonipass [OPTIONS]\n"
"Creates a mnemonic password from dictionary files provided.\n"
"\n"
(make-cli-options-description cli-opts)
"\n"
"Examples:\n"
"mnemonipass -n ./nouns -v ./verbs Creates simple password using nouns and verbs files as dictionary.\n"
"mnemonipass -n ./nouns -v ./verbs -a ./adverbs -j ./adjectives -w 6 -d 3 -s Creates stronger password using 4 dictionaries, 3 digits with special characters.\n"
"\n"))
(define (make-cli-options-description cli-opts)
(let ((nice-default (lambda (opt)
(cond
((eq? opt #!void)
"None")
((eq? opt #f)
"No")
((eq? opt #t)
"Yes")
(else opt)))))
(let loop ((cli-opts cli-options) (descr ""))
(if (null-list? cli-opts)
descr
(loop (cdr cli-opts)
(string-append
(format "~t-~a - ~a (default: ~a)~%"
(cli-option-key (car cli-opts))
(cli-option-description (car cli-opts))
(nice-default (cli-option-default (car cli-opts))))
descr))))))
(define (get-options-value proc key cli-opts)
(let loop ((cli-opts cli-opts))
(cond
((null-list? cli-opts)
(error (format "Invalid option ~a ~%" key)))
((cli-option-key-match? key (car cli-opts))
(proc (car cli-opts)))
(else (loop (cdr cli-opts))))))
(define (get-option-default name cli-opts)
(let loop ((cli-opts cli-opts))
(cond
((null-list? cli-opts)
(error (format "Invalid option name ~a ~%" name)))
((cli-option-name-match? name (car cli-opts))
(cli-option-default (car cli-opts)))
(else (loop (cdr cli-opts))))))
(define (get-option-value name cli-opts-hash cli-opts)
(hash-table-ref/default cli-opts-hash name (get-option-default name cli-opts)))
(define (parse-cli cli cli-opts)
(let ((cli-opt-hash (make-hash-table)))
(let loop ((cli (cdr cli)))
(cond
((null-list? cli)
cli-opt-hash)
((and (is-option? (car cli)) (option-exists? (car cli) cli-opts))
(let ((opt-name (get-options-value cli-option-name (car cli) cli-opts))
(opt-type (get-options-value cli-option-type (car cli) cli-opts)))
(cond
((eq? 'toggle opt-type)
(hash-table-set! cli-opt-hash opt-name #t)
(loop (cdr cli)))
(else
(hash-table-set! cli-opt-hash opt-name
(coerce-option-value (cadr cli) opt-type))
(loop (cddr cli))))))
((and (is-option? (car cli)) (not (option-exists? (car cli) cli-opts)))
(error (format "Invalid option ~a ~%" (car cli))))
(else (error (format "Error parsing option ~a ~%" (car cli))))))))