blob: 632e970234bb44380f957627d4d6fb4f298e9bcb (
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
|
(.module:
[lux #*
data/text/format
[abstract/monad (#+ do)]
["r" math/random (#+ Random) ("#@." monad)]
["_" test (#+ Test)]
[data
["." error]
["." text
["l" lexer]]
[collection
["." list]
["." dictionary (#+ Dictionary)]]]
[macro
["." code]]]
{1
["." /]})
(def: default-cursor
Cursor
{#.module ""
#.line 0
#.column 0})
(def: name-part^
(Random Text)
(do r.monad
[#let [digits "0123456789"
delimiters (format "()[]{}#." /.text-delimiter)
space (format " " text.new-line)
invalid-range (format digits delimiters space)
char-gen (|> r.nat
(:: @ map (|>> (n/% 256) (n/max 1)))
(r.filter (function (_ sample)
(not (text.contains? (text.from-code sample)
invalid-range)))))]
size (|> r.nat (:: @ map (|>> (n/% 20) (n/max 1))))]
(r.text char-gen size)))
(def: name^
(Random Name)
(r.and name-part^ name-part^))
(def: code^
(Random Code)
(let [numeric^ (: (Random Code)
($_ r.either
(|> r.bit (r@map code.bit))
(|> r.nat (r@map code.nat))
(|> r.int (r@map code.int))
(|> r.rev (r@map code.rev))
(|> r.frac (r@map code.frac))))
textual^ (: (Random Code)
($_ r.either
(do r.monad
[size (|> r.nat (r@map (n/% 20)))]
(|> (r.unicode size) (r@map code.text)))
(|> name^ (r@map code.identifier))
(|> name^ (r@map code.tag))))
simple^ (: (Random Code)
($_ r.either
numeric^
textual^))]
(r.rec
(function (_ code^)
(let [multi^ (do r.monad
[size (|> r.nat (r@map (n/% 3)))]
(r.list size code^))
composite^ (: (Random Code)
($_ r.either
(|> multi^ (r@map code.form))
(|> multi^ (r@map code.tuple))
(do r.monad
[size (|> r.nat (r@map (n/% 3)))]
(|> (r.list size (r.and code^ code^))
(r@map code.record)))))]
($_ r.either
simple^
composite^))))))
(def: code
Test
(do r.monad
[sample code^]
($_ _.and
(_.test "Can parse Lux code."
(case (let [source-code (%code sample)]
(/.parse "" (dictionary.new text.hash) (text.size source-code)
[default-cursor 0 source-code]))
(#error.Failure error)
false
(#error.Success [_ parsed])
(:: code.equivalence = parsed sample)))
(do @
[other code^]
(_.test "Can parse Lux multiple code nodes."
(let [source-code (format (%code sample) " " (%code other))
source-code//size (text.size source-code)]
(case (/.parse "" (dictionary.new text.hash) source-code//size
[default-cursor 0 source-code])
(#error.Failure error)
false
(#error.Success [remaining =sample])
(case (/.parse "" (dictionary.new text.hash) source-code//size
remaining)
(#error.Failure error)
false
(#error.Success [_ =other])
(and (:: code.equivalence = sample =sample)
(:: code.equivalence = other =other)))))))
)))
(def: comment-text^
(Random Text)
(let [char-gen (|> r.nat (r.filter (|>> (n/= (`` (char (~~ (static text.new-line))))) not)))]
(do r.monad
[size (|> r.nat (r@map (n/% 20)))]
(r.text char-gen size))))
(def: comment^
(Random Text)
(do r.monad
[comment comment-text^]
(wrap (format "## " comment text.new-line))))
(def: comments
Test
(do r.monad
[sample code^
comment comment^]
($_ _.and
(_.test "Can handle comments."
(case (let [source-code (format comment (%code sample))
source-code//size (text.size source-code)]
(/.parse "" (dictionary.new text.hash) source-code//size
[default-cursor 0 source-code]))
(#error.Failure error)
false
(#error.Success [_ parsed])
(:: code.equivalence = parsed sample)))
)))
(def: #export test
Test
($_ _.and
..code
..comments
))
|
