blob: abc729129d84862f1427868593019433df783dfe (
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
|
(;module: {#;doc "Exception-handling functionality built on top of the Error type."}
lux
(lux (control monad)
(data ["E" error]
[maybe]
[text "text/" Monoid<Text>])
[meta]
(meta [code]
["s" syntax #+ syntax: Syntax]
(syntax ["cs" common]
(common ["csr" reader]
["csw" writer])))))
## [Types]
(type: #export Exception
{#;doc "An exception provides a way to decorate error messages."}
(-> Text Text))
## [Values]
(def: #hidden _text/compose_
(-> Text Text Text)
text/compose)
(def: #export (match? exception error)
(-> Exception Text Bool)
(text;starts-with? (exception "") error))
(def: #export (catch exception then try)
{#;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 [a]
(-> Exception (-> Text a) (E;Error a)
(E;Error a)))
(case try
(#E;Success output)
(#E;Success output)
(#E;Error error)
(let [reference (exception "")]
(if (text;starts-with? reference error)
(#E;Success (|> error
(text;clip (text;size reference) (text;size error))
maybe;assume
then))
(#E;Error error)))))
(def: #export (otherwise to-do 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) (E;Error a) a))
(case try
(#E;Success output)
output
(#E;Error error)
(to-do error)))
(def: #export (return value)
{#;doc "A way to lift normal values into the error-handling context."}
(All [a] (-> a (E;Error a)))
(#E;Success value))
(def: #export (throw exception message)
{#;doc "Decorate an error message with an Exception and lift it into the error-handling context."}
(All [a] (-> Exception Text (E;Error a)))
(#E;Error (exception message)))
(syntax: #export (exception: [_ex-lev csr;export] [name s;local-symbol])
{#;doc (doc "Define a new exception type."
"It moslty just serves as a way to tag error messages for later catching."
(exception: #export Some-Exception))}
(do @
[current-module meta;current-module-name
#let [descriptor ($_ text/compose "{" current-module ";" name "}" "\n")
g!message (code;symbol ["" "message"])]]
(wrap (list (` (def: (~@ (csw;export _ex-lev)) ((~ (code;symbol ["" name])) (~ g!message))
Exception
(_text/compose_ (~ (code;text descriptor)) (~ g!message))))))))
|
