aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/data/collection/tree/finger.lux
blob: 7d9faf5952cfb04827ee825085453c90e05a6a3c (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
(.require
 [library
  [lux (.except)
   ["_" test (.only Test)]
   [abstract
    [monad (.only do)]]
   [control
    ["[0]" maybe (.use "[1]#[0]" functor)]]
   [data
    ["[0]" text (.use "[1]#[0]" equivalence monoid)]
    [collection
     ["[0]" list (.use "[1]#[0]" mix)]]]
   [math
    ["[0]" random]
    [number
     ["n" nat]]]
   [meta
    [type (.only by_example)]]]]
 [\\library
  ["[0]" /]])

(def builder
  (/.builder text.monoid))

(def :@:
  (by_example [@]
    (is (/.Builder @ Text)
        ..builder)
    @))

(def .public test
  Test
  (<| (_.covering /._)
      (_.for [/.Tree])
      (do [! random.monad]
        [tag_left (random.alpha_numeric 1)
         tag_right (random.only (|>> (text#= tag_left) not)
                                (random.alpha_numeric 1))
         expected_left random.nat
         expected_right random.nat]
        (all _.and
             (_.coverage [/.Builder /.builder]
               (exec (/.builder text.monoid)
                 true))
             (_.coverage [/.tag]
               (and (text#= tag_left
                            (/.tag (at ..builder leaf tag_left expected_left)))
                    (text#= (text#composite tag_left tag_right)
                            (/.tag (at ..builder branch
                                       (at ..builder leaf tag_left expected_left)
                                       (at ..builder leaf tag_right expected_right))))))
             (_.coverage [/.root]
               (and (case (/.root (at ..builder leaf tag_left expected_left))
                      {.#Left actual}
                      (n.= expected_left actual)
                      
                      {.#Right _}
                      false)
                    (case (/.root (at ..builder branch
                                      (at ..builder leaf tag_left expected_left)
                                      (at ..builder leaf tag_right expected_right)))
                      {.#Left _}
                      false
                      
                      {.#Right [left right]}
                      (case [(/.root left)
                             (/.root right)]
                        [{.#Left actual_left} {.#Left actual_right}]
                        (and (n.= expected_left actual_left)
                             (n.= expected_right actual_right))
                        
                        _
                        false))))
             (_.coverage [/.value]
               (and (n.= expected_left
                         (/.value (at ..builder leaf tag_left expected_left)))
                    (n.= expected_left
                         (/.value (at ..builder branch
                                      (at ..builder leaf tag_left expected_left)
                                      (at ..builder leaf tag_right expected_right))))))
             (do random.monad
               [.let [tags_equivalence (list.equivalence text.equivalence)
                      values_equivalence (list.equivalence n.equivalence)]
                tags/H (random.alpha_numeric 1)
                tags/T (random.list 5 (random.alpha_numeric 1))
                values/H random.nat
                values/T (random.list 5 random.nat)]
               (_.coverage [/.tags /.values]
                 (let [tree (list#mix (function (_ [tag value] tree)
                                        (at builder branch tree (at builder leaf tag value)))
                                      (at builder leaf tags/H values/H)
                                      (list.zipped_2 tags/T values/T))]
                   (and (at tags_equivalence = (list.partial tags/H tags/T) (/.tags tree))
                        (at values_equivalence = (list.partial values/H values/T) (/.values tree))))))
             (_.coverage [/.one]
               (let [can_find_correct_one!
                     (|> (at ..builder leaf tag_left expected_left)
                         (/.one (text.contains? tag_left))
                         (maybe#each (n.= expected_left))
                         (maybe.else false))

                     cannot_find_incorrect_one!
                     (|> (at ..builder leaf tag_right expected_right)
                         (/.one (text.contains? tag_left))
                         (maybe#each (n.= expected_left))
                         (maybe.else false)
                         not)

                     can_find_left!
                     (|> (at ..builder branch
                             (at ..builder leaf tag_left expected_left)
                             (at ..builder leaf tag_right expected_right))
                         (/.one (text.contains? tag_left))
                         (maybe#each (n.= expected_left))
                         (maybe.else false))

                     can_find_right!
                     (|> (at ..builder branch
                             (at ..builder leaf tag_left expected_left)
                             (at ..builder leaf tag_right expected_right))
                         (/.one (text.contains? tag_right))
                         (maybe#each (n.= expected_right))
                         (maybe.else false))]
                 (and can_find_correct_one!
                      cannot_find_incorrect_one!
                      can_find_left!
                      can_find_right!)))
             (_.coverage [/.exists?]
               (let [can_find_correct_one!
                     (/.exists? (text.contains? tag_left)
                                (at ..builder leaf tag_left expected_left))

                     cannot_find_incorrect_one!
                     (not (/.exists? (text.contains? tag_left)
                                     (at ..builder leaf tag_right expected_right)))

                     can_find_left!
                     (/.exists? (text.contains? tag_left)
                                (at ..builder branch
                                    (at ..builder leaf tag_left expected_left)
                                    (at ..builder leaf tag_right expected_right)))

                     can_find_right!
                     (/.exists? (text.contains? tag_right)
                                (at ..builder branch
                                    (at ..builder leaf tag_left expected_left)
                                    (at ..builder leaf tag_right expected_right)))]
                 (and can_find_correct_one!
                      cannot_find_incorrect_one!
                      can_find_left!
                      can_find_right!)))
             ))))