blob: abb1d0c38806c912e012686bd4a7e2aa4c5d8216 (
plain)
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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
|
(.module:
[lux #*
[control
monad
["p" parser]]
[data
[collection
[list ("list/." Monoid<List> Monad<List>)]]
["." text ("text/." Equivalence<Text>)
format]
["E" error]]
[macro (#+ with-gensyms)
["." code]
["s" syntax (#+ syntax: Syntax)]]
[compiler
["." host]]
["." io]
[concurrency
["." process]]])
## [Types]
(type: #export (CLI a)
{#.doc "A command-line interface parser."}
(p.Parser (List Text) a))
## [Combinators]
(def: #export (run inputs parser)
(All [a] (-> (List Text) (CLI a) (E.Error a)))
(case (p.run inputs parser)
(#E.Success [remaining output])
(case remaining
#.Nil
(#E.Success output)
_
(#E.Error (format "Remaining CLI inputs: " (text.join-with " " remaining))))
(#E.Error error)
(#E.Error error)))
(def: #export any
{#.doc "Just returns the next input without applying any logic."}
(CLI Text)
(function (_ inputs)
(case inputs
(#.Cons arg inputs')
(#E.Success [inputs' arg])
_
(#E.Error "Cannot parse empty arguments."))))
(def: #export (parse parser)
{#.doc "Parses the next input with a parsing function."}
(All [a] (-> (-> Text (E.Error a)) (CLI a)))
(function (_ inputs)
(do E.Monad<Error>
[[remaining raw] (any inputs)
output (parser raw)]
(wrap [remaining output]))))
(def: #export (this reference)
{#.doc "Checks that a token is in the inputs."}
(-> Text (CLI Any))
(function (_ inputs)
(do E.Monad<Error>
[[remaining raw] (any inputs)]
(if (text/= reference raw)
(wrap [remaining []])
(E.fail (format "Missing token: \"" reference "\""))))))
(def: #export (somewhere cli)
{#.doc "Given a parser, tries to parse it somewhere in the inputs (i.e. not necessarily parsing the immediate inputs)."}
(All [a] (-> (CLI a) (CLI a)))
(function (_ inputs)
(loop [immediate inputs]
(case (p.run immediate cli)
(#E.Success [remaining output])
(#E.Success [remaining output])
(#E.Error error)
(case immediate
#.Nil
(#E.Error error)
(#.Cons to-omit immediate')
(do E.Monad<Error>
[[remaining output] (recur immediate')]
(wrap [(#.Cons to-omit remaining)
output])))))))
(def: #export end
{#.doc "Ensures there are no more inputs."}
(CLI Any)
(function (_ inputs)
(case inputs
#.Nil (#E.Success [inputs []])
_ (#E.Error (format "Unknown parameters: " (text.join-with " " inputs))))))
(def: #export (parameter [short long])
(-> [Text Text] (CLI Text))
(|> ..any
(p.after (p.either (..this short) (..this long)))
..somewhere))
## [Syntax]
(type: Program-Args
(#Raw Text)
(#Parsed (List [Code Code])))
(def: program-args^
(Syntax Program-Args)
(p.or s.local-identifier
(s.tuple (p.some (p.either (do p.Monad<Parser>
[name s.local-identifier]
(wrap [(code.identifier ["" name]) (` any)]))
(s.record (p.and s.any s.any)))))))
(syntax: #export (program:
{args program-args^}
body)
{#.doc (doc "Defines the entry-point to a program (similar to the \"main\" function/method in other programming languages)."
"Can take a list of all the input parameters to the program, or can destructure them using CLI-option combinators from the lux/cli module."
(program: all-args
(do Monad<IO>
[foo init-program
bar (do-something all-args)]
(wrap [])))
(program: [name]
(io (log! (text/compose "Hello, " name))))
(program: [{config config^}]
(do Monad<IO>
[data (init-program config)]
(do-something data))))}
(with-gensyms [g!program]
(case args
(#Raw args)
(wrap (list (` ("lux program"
(.function ((~ g!program) (~ (code.identifier ["" args])))
((~! do) (~! io.Monad<IO>)
[]
(~ body)))))))
(#Parsed args)
(with-gensyms [g!args g!_ g!output g!message]
(wrap (list (` ("lux program"
(.function ((~ g!program) (~ g!args))
(case ((: (~! (..CLI (io.IO .Any)))
((~! do) (~! p.Monad<Parser>)
[(~+ (|> args
(list/map (function (_ [binding parser])
(list binding parser)))
list/join))
(~ g!_) ..end]
((~' wrap) ((~! do) (~! io.Monad<IO>)
[(~ g!output) (~ body)
(~+ (`` (for {(~~ (static host.jvm))
(list)}
(list g!_
(` process.run!)))))]
((~' wrap) (~ g!output))))))
(~ g!args))
(#E.Success [(~ g!_) (~ g!output)])
(~ g!output)
(#E.Error (~ g!message))
(.error! (~ g!message))
))))
)))
)))
|
