blob: 1edd4bc04dabf58813f136b1bce640b1f935927e (
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
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
|
(.module:
{#.doc "Pure-Lux exception-handling functionality."}
[library
[lux #*
["." macro]
["." meta]
[abstract
[monad (#+ do)]]
[control
["<>" parser ("#\." monad)
["<.>" code (#+ Parser)]]]
[data
["." maybe]
["." product]
["." text ("#\." monoid)]
[collection
["." list ("#\." functor fold)]]]
[macro
["." code]
[syntax (#+ syntax:)
["|.|" input]
["." type #_
["|#_.|" variable]]]]
[math
[number
["n" nat ("#\." decimal)]]]]]
[//
["//" try (#+ Try)]])
(type: .public (Exception a)
{#.doc "An exception provides a way to decorate error messages."}
{#label Text
#constructor (-> a Text)})
(def: .public (match? exception error)
{#.doc (doc "Is this exception the cause of the error message?")}
(All [e] (-> (Exception e) Text Bit))
(text.starts_with? (get@ #label exception) error))
(def: .public (when exception then try)
{#.doc (doc "If a particular exception is detected on a possibly-erroneous value, handle it."
"If no exception was detected, or a different one from the one being checked, then pass along the original value.")}
(All [e a]
(-> (Exception e) (-> Text a) (Try a)
(Try a)))
(case try
(#//.Success output)
(#//.Success output)
(#//.Failure error)
(let [reference (get@ #label exception)]
(if (text.starts_with? reference error)
(#//.Success (|> error
(text.clip' (text.size reference))
maybe.assume
then))
(#//.Failure error)))))
(def: .public (otherwise else try)
{#.doc "If no handler could be found to catch the exception, then run a function as a last-resort measure."}
(All [a]
(-> (-> Text a) (Try a) a))
(case try
(#//.Success output)
output
(#//.Failure error)
(else error)))
(def: .public (error exception message)
{#.doc "Constructs an error message from an exception."}
(All [e] (-> (Exception e) e Text))
((get@ #..constructor exception) message))
(def: .public (except exception message)
{#.doc "Decorate an error message with an Exception and lift it into the error-handling context."}
(All [e a] (-> (Exception e) e (Try a)))
(#//.Failure (..error exception message)))
(def: .public (assertion exception message test)
(All [e] (-> (Exception e) e Bit (Try Any)))
(if test
(#//.Success [])
(..except exception message)))
(def: exception
(Parser [Code (List |type_variable|.Variable) [Text (List |input|.Input)] (Maybe Code)])
(let [private (: (Parser [(List |type_variable|.Variable) [Text (List |input|.Input)] (Maybe Code)])
($_ <>.and
(<>.else (list) (<code>.tuple (<>.some |type_variable|.parser)))
(<>.either (<code>.form (<>.and <code>.local_identifier (<>.some |input|.parser)))
(<>.and <code>.local_identifier (<>\in (list))))
(<>.maybe <code>.any)
))]
($_ <>.either
(<>.and <code>.any private)
(<>.and (<>\in (` .private)) private)
)))
(syntax: .public (exception: {[export_policy t_vars [name inputs] body] ..exception})
{#.doc (doc "Define a new exception type."
"It mostly just serves as a way to tag error messages for later catching."
""
"Simple case:"
(exception: .public some_exception)
""
"Complex case:"
(exception: .public [arbitrary type variables] (some_exception {optional Text} {arguments Int})
optional_body))}
(macro.with_gensyms [g!descriptor]
(do meta.monad
[current_module meta.current_module_name
.let [descriptor ($_ text\compose "{" current_module "." name "}" text.new_line)
g!self (code.local_identifier name)]]
(in (list (` (def: (~ export_policy)
(~ g!self)
(All [(~+ (list\map |type_variable|.format t_vars))]
(..Exception [(~+ (list\map (get@ #|input|.type) inputs))]))
(let [(~ g!descriptor) (~ (code.text descriptor))]
{#..label (~ g!descriptor)
#..constructor (function ((~ g!self) [(~+ (list\map (get@ #|input|.binding) inputs))])
((~! text\compose) (~ g!descriptor)
(~ (maybe.else (' "") body))))}))))))))
(def: (report' entries)
(-> (List [Text Text]) Text)
(let [header_separator ": "
largest_header_size (list\fold (function (_ [header _] max)
(n.max (text.size header) max))
0
entries)
on_new_line (|> " "
(list.repeated (n.+ (text.size header_separator)
largest_header_size))
(text.join_with "")
(text\compose text.new_line))
on_entry (: (-> [Text Text] Text)
(function (_ [header message])
(let [padding (|> " "
(list.repeated (n.- (text.size header)
largest_header_size))
(text.join_with ""))]
(|> message
(text.replaced text.new_line on_new_line)
($_ text\compose padding header header_separator)))))]
(case entries
#.End
""
(#.Item head tail)
(list\fold (function (_ post pre)
($_ text\compose pre text.new_line (on_entry post)))
(on_entry head)
tail))))
(syntax: .public (report {entries (<>.many (<code>.tuple (<>.and <code>.any <code>.any)))})
{#.doc (doc "An error report."
(: Text
(report ["Row 0" value/0]
["Row 1" value/1]
,,,
["Row N" value/N])))}
(in (list (` ((~! report') (list (~+ (|> entries
(list\map (function (_ [header message])
(` [(~ header) (~ message)])))))))))))
(def: .public (listing format entries)
{#.doc (doc "A numbered report of the entries on a list."
"NOTE: 0-based numbering.")}
(All [a]
(-> (-> a Text) (List a) Text))
(|> entries
(list\fold (function (_ entry [index next])
[(inc index)
(#.Item [(n\encode index) (format entry)]
next)])
[0 #.End])
product.right
list.reversed
..report'))
(def: separator
(let [gap ($_ "lux text concat" text.new_line text.new_line)
horizontal_line (|> "-" (list.repeated 64) (text.join_with ""))]
($_ "lux text concat"
gap
horizontal_line
gap)))
(def: (decorated prelude error)
(-> Text Text Text)
($_ "lux text concat"
prelude
..separator
error))
(def: .public (with exception message computation)
{#.doc (doc "If a computation fails, prepends the exception to the error.")}
(All [e a] (-> (Exception e) e (Try a) (Try a)))
(case computation
(#//.Failure error)
(#//.Failure (case error
""
(..error exception message)
_
(..decorated (..error exception message) error)))
success
success))
|
