stdlib/source/test/lux/data/sum.lux


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

(.module:
  [lux #*
   ["_" test (#+ Test)]
   [abstract
    [monad (#+ do)]
    [\spec
     ["$." equivalence]]]
   [control
    pipe]
   [data
    ["." text]
    [collection
     ["." list ("#\." functor)]]]
   [math
    ["." random]
    [number
     ["n" nat]
     ["i" int]]]]
  [\\
   ["." /]])

(def: #export test
  Test
  (<| (_.covering /._)
      (_.for [.|])
      (do {! random.monad}
        [expected random.nat
         shift random.nat]
        ($_ _.and
            (_.for [/.equivalence]
                   ($equivalence.spec (/.equivalence n.equivalence n.equivalence)
                                      (random.or random.nat random.nat)))
            (do random.monad
              [left random.int
               right random.nat]
              (_.cover [/.hash]
                       (let [hash (/.hash i.hash n.hash)]
                         (and (n.= (\ i.hash hash left)
                                   (\ hash hash (#.Left left)))
                              (n.= (\ n.hash hash right)
                                   (\ hash hash (#.Right right)))))))

            (_.cover [/.left]
                     (|> (/.left expected)
                         (: (| Nat Nat))
                         (case> (0 #0 actual) (n.= expected actual)
                                _ false)))
            (_.cover [/.right]
                     (|> (/.right expected)
                         (: (| Nat Nat))
                         (case> (0 #1 actual) (n.= expected actual)
                                _ false)))
            (_.cover [/.either]
                     (and (|> (/.left expected)
                              (: (| Nat Nat))
                              (/.either (n.+ shift) (n.- shift))
                              (n.= (n.+ shift expected)))
                          (|> (/.right expected)
                              (: (| Nat Nat))
                              (/.either (n.+ shift) (n.- shift))
                              (n.= (n.- shift expected)))))
            (_.cover [/.apply]
                     (and (|> (/.left expected)
                              (: (| Nat Nat))
                              (/.apply (n.+ shift) (n.- shift))
                              (case> (0 #0 actual) (n.= (n.+ shift expected) actual) _ false))
                          (|> (/.right expected)
                              (: (| Nat Nat))
                              (/.apply (n.+ shift) (n.- shift))
                              (case> (0 #1 actual) (n.= (n.- shift expected) actual) _ false))))
            (do !
              [size (\ ! map (n.% 5) random.nat)
               expected (random.list size random.nat)]
              ($_ _.and
                  (_.cover [/.lefts]
                           (let [actual (: (List (| Nat Nat))
                                           (list\map /.left expected))]
                             (and (\ (list.equivalence n.equivalence) =
                                     expected
                                     (/.lefts actual))
                                  (\ (list.equivalence n.equivalence) =
                                     (list)
                                     (/.rights actual)))))
                  (_.cover [/.rights]
                           (let [actual (: (List (| Nat Nat))
                                           (list\map /.right expected))]
                             (and (\ (list.equivalence n.equivalence) =
                                     expected
                                     (/.rights actual))
                                  (\ (list.equivalence n.equivalence) =
                                     (list)
                                     (/.lefts actual)))))
                  (_.cover [/.partition]
                           (let [[lefts rights] (|> expected
                                                    (list\map (function (_ value)
                                                                (if (n.even? value)
                                                                  (/.left value)
                                                                  (/.right value))))
                                                    (: (List (| Nat Nat)))
                                                    /.partition)]
                             (and (\ (list.equivalence n.equivalence) =
                                     (list.filter n.even? expected)
                                     lefts)
                                  (\ (list.equivalence n.equivalence) =
                                     (list.filter (|>> n.even? not) expected)
                                     rights))))
                  ))
            ))))