blob: c10d7a67eb234196576153f1734cfda4a234d5e8 (
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
|
(.module:
[lux #*
["%" data/text/format (#+ format)]
["_" test (#+ Test)]
[abstract
[monad (#+ do Monad)]
{[0 #test]
[/
["$." equivalence]
["$." order]]}]
[control
pipe]
[data
[number
["n" nat]]
[collection
["." list]]]
[math
["r" random]]]
{1
["." /]})
(def: bounded-size
(r.Random Nat)
(|> r.nat
(:: r.monad map (|>> (n.% 20) (n.+ 1)))))
(def: #export test
Test
(<| (_.context (%.name (name-of .Text)))
($_ _.and
($equivalence.spec /.equivalence (r.ascii 2))
($order.spec /.order (r.ascii 2))
(do {@ r.monad}
[size (:: @ map (n.% 10) r.nat)
sample (r.unicode size)]
($_ _.and
(_.test "Can get the size of text."
(n.= size (/.size sample)))
(_.test "Text with size 0 is considered 'empty'."
(or (not (n.= 0 size))
(/.empty? sample)))))
(do {@ r.monad}
[size bounded-size
idx (:: @ map (n.% size) r.nat)
sample (r.unicode size)]
(_.test "Character locations."
(|> sample
(/.nth idx)
(case> (^multi (#.Some char)
[(/.from-code char) char]
[[(/.index-of char sample)
(/.last-index-of char sample)
(/.index-of' char idx sample)
(/.last-index-of' char idx sample)]
[(#.Some io) (#.Some lio)
(#.Some io') (#.Some lio')]])
(and (n.<= idx io)
(n.>= idx lio)
(n.= idx io')
(n.>= idx lio')
(/.contains? char sample))
_
#0
))
))
(do r.monad
[sizeL bounded-size
sizeR bounded-size
sampleL (r.unicode sizeL)
sampleR (r.unicode sizeR)
#let [sample (/.concat (list sampleL sampleR))
(^open "/@.") /.equivalence]]
($_ _.and
(_.test "Can join text snippets."
(and (not (/@= sample
(/.join-with " " (list sampleL sampleR))))
(/@= sample
(/.join-with "" (list sampleL sampleR)))))
(_.test "Can check sub-texts at the borders."
(and (/.starts-with? sampleL sample)
(/.ends-with? sampleR sample)))
(_.test "Can enclose text in another texts."
(/@= (/.enclose [sampleR sampleR] sampleL)
(/.enclose' sampleR sampleL)))
(_.test "Can split text."
(|> (/.split sizeL sample)
(case> (#.Right [_l _r])
(and (/@= sampleL _l)
(/@= sampleR _r)
(/@= sample (/.concat (list _l _r))))
_
#0)))
(_.test "Can clip text."
(|> [(/.clip 0 sizeL sample)
(/.clip sizeL (/.size sample) sample)
(/.clip' sizeL sample)
(/.clip' 0 sample)]
(case> [(#.Right _l) (#.Right _r) (#.Right _r') (#.Right _f)]
(and (/@= sampleL _l)
(/@= sampleR _r)
(/@= _r _r')
(/@= sample _f))
_
#0)))
))
(do {@ r.monad}
[sizeP bounded-size
sizeL bounded-size
#let [## The wider unicode charset includes control characters that
## can make text replacement work improperly.
## Because of that, I restrict the charset.
normal-char-gen (|> r.nat (:: @ map (|>> (n.% 128) (n.max 1))))]
sep1 (r.text normal-char-gen 1)
sep2 (r.text normal-char-gen 1)
#let [part-gen (|> (r.text normal-char-gen sizeP)
(r.filter (|>> (/.contains? sep1) not)))]
parts (r.list sizeL part-gen)
#let [sample1 (/.concat (list.interpose sep1 parts))
sample2 (/.concat (list.interpose sep2 parts))
(^open "/@.") /.equivalence]]
($_ _.and
(_.test "Can split text multiple times through a separator."
(n.= (list.size parts)
(list.size (/.split-all-with sep1 sample1))))
(_.test "Can replace occurrences of a piece of text inside a larger text."
(/@= sample2
(/.replace-all sep1 sep2 sample1)))
))
)))
|
