blob: fddea13d7f69b7de1d357bd7f2fd7c5f9a605378 (
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
172
173
174
175
176
177
178
|
(.module:
[lux #*
["@" target]
[abstract
[monad (#+ do)]]
[data
[collection
["." list ("#@." monoid monad)]]
["." text ("#@." equivalence)
["%" format (#+ format)]]
["." error (#+ Error)]]
[macro (#+ with-gensyms)
["." code]
[syntax (#+ syntax:)]]]
["." //
["s" code]
[//
["." io]
[concurrency
["." process]]]])
(type: #export (Parser a)
{#.doc "A command-line interface parser."}
(//.Parser (List Text) a))
(def: #export (run parser inputs)
(All [a] (-> (Parser a) (List Text) (Error a)))
(case (//.run parser inputs)
(#error.Success [remaining output])
(case remaining
#.Nil
(#error.Success output)
_
(#error.Failure (format "Remaining CLI inputs: " (text.join-with " " remaining))))
(#error.Failure error)
(#error.Failure error)))
(def: #export any
{#.doc "Just returns the next input without applying any logic."}
(Parser Text)
(function (_ inputs)
(case inputs
(#.Cons arg inputs')
(#error.Success [inputs' arg])
_
(#error.Failure "Cannot parse empty arguments."))))
(def: #export (parse parser)
{#.doc "Parses the next input with a parsing function."}
(All [a] (-> (-> Text (Error a)) (Parser a)))
(function (_ inputs)
(do error.monad
[[remaining raw] (any inputs)
output (parser raw)]
(wrap [remaining output]))))
(def: #export (this reference)
{#.doc "Checks that a token is in the inputs."}
(-> Text (Parser Any))
(function (_ inputs)
(do error.monad
[[remaining raw] (any inputs)]
(if (text@= reference raw)
(wrap [remaining []])
(error.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] (-> (Parser a) (Parser a)))
(function (_ inputs)
(loop [immediate inputs]
(case (//.run cli immediate)
(#error.Success [remaining output])
(#error.Success [remaining output])
(#error.Failure error)
(case immediate
#.Nil
(#error.Failure error)
(#.Cons to-omit immediate')
(do error.monad
[[remaining output] (recur immediate')]
(wrap [(#.Cons to-omit remaining)
output])))))))
(def: #export end
{#.doc "Ensures there are no more inputs."}
(Parser Any)
(function (_ inputs)
(case inputs
#.Nil (#error.Success [inputs []])
_ (#error.Failure (format "Unknown parameters: " (text.join-with " " inputs))))))
(def: #export (named name value)
(All [a] (-> Text (Parser a) (Parser a)))
(|> value
(//.after (..this name))
..somewhere))
(def: #export (parameter [short long] value)
(All [a] (-> [Text Text] (Parser a) (Parser a)))
(|> value
(//.after (//.either (..this short) (..this long)))
..somewhere))
(type: Program-Args
(#Raw Text)
(#Parsed (List [Code Code])))
(def: program-args^
(s.Parser Program-Args)
(//.or s.local-identifier
(s.tuple (//.some (//.either (do //.monad
[name s.local-identifier]
(wrap [(code.identifier ["" name]) (` any)]))
(s.record (//.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 io.monad
[foo init-program
bar (do-something all-args)]
(wrap [])))
(program: [name]
(io (log! (text@compose "Hello, " name))))
(program: [{config config^}]
(do io.monad
[data (init-program config)]
(do-something data))))}
(with-gensyms [g!program]
(case args
(#Raw args)
(wrap (list (` ("lux def program"
(.function ((~ g!program) (~ (code.identifier ["" args])))
((~! do) (~! io.monad)
[]
(~ body)))))))
(#Parsed args)
(with-gensyms [g!args g!_ g!output g!message]
(wrap (list (` ("lux def program"
(.function ((~ g!program) (~ g!args))
(case ((: (~! (..Parser (io.IO .Any)))
((~! do) (~! //.monad)
[(~+ (|> args
(list@map (function (_ [binding parser])
(list binding parser)))
list@join))
(~ g!_) ..end]
((~' wrap) ((~! do) (~! io.monad)
[(~ g!output) (~ body)
(~+ (`` (for {(~~ (static @.old))
(list)
(~~ (static @.jvm))
(list)}
(list g!_
(` process.run!)))))]
((~' wrap) (~ g!output))))))
(~ g!args))
(#error.Success [(~ g!_) (~ g!output)])
(~ g!output)
(#error.Failure (~ g!message))
(.error! (~ g!message))
))))
)))
)))
|
