aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/data/sum.lux
blob: bc1d9c70cf59f6d9b3ac85f468b57cba2caf56f2 (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
(.module:
  [library
   [lux "*"
    ["_" test {"+" [Test]}]
    [abstract
     [monad {"+" [do]}]
     [\\specification
      ["$[0]" equivalence]]]
    [control
     pipe]
    [data
     ["[0]" text]
     [collection
      ["[0]" list ("[1]\[0]" functor)]]]
    [math
     ["[0]" random]
     [number
      ["n" nat]
      ["i" int]]]]]
  [\\library
   ["[0]" /]])

(def: .public test
  Test
  (<| (_.covering /._)
      (_.for [.Union .Or])
      (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)
                         (: (Or Nat Nat))
                         (case> {0 #0 actual} (n.= expected actual)
                                _ false)))
            (_.cover [/.right]
                     (|> (/.right expected)
                         (: (Or Nat Nat))
                         (case> {0 #1 actual} (n.= expected actual)
                                _ false)))
            (_.cover [/.either]
                     (and (|> (/.left expected)
                              (: (Or Nat Nat))
                              (/.either (n.+ shift) (n.- shift))
                              (n.= (n.+ shift expected)))
                          (|> (/.right expected)
                              (: (Or Nat Nat))
                              (/.either (n.+ shift) (n.- shift))
                              (n.= (n.- shift expected)))))
            (_.cover [/.then]
                     (and (|> (/.left expected)
                              (: (Or Nat Nat))
                              (/.then (n.+ shift) (n.- shift))
                              (case> {0 #0 actual} (n.= (n.+ shift expected) actual) _ false))
                          (|> (/.right expected)
                              (: (Or Nat Nat))
                              (/.then (n.+ shift) (n.- shift))
                              (case> {0 #1 actual} (n.= (n.- shift expected) actual) _ false))))
            (do !
              [size (\ ! each (n.% 5) random.nat)
               expected (random.list size random.nat)]
              ($_ _.and
                  (_.cover [/.lefts]
                           (let [actual (: (List (Or Nat Nat))
                                           (list\each /.left expected))]
                             (and (\ (list.equivalence n.equivalence) =
                                     expected
                                     (/.lefts actual))
                                  (\ (list.equivalence n.equivalence) =
                                     (list)
                                     (/.rights actual)))))
                  (_.cover [/.rights]
                           (let [actual (: (List (Or Nat Nat))
                                           (list\each /.right expected))]
                             (and (\ (list.equivalence n.equivalence) =
                                     expected
                                     (/.rights actual))
                                  (\ (list.equivalence n.equivalence) =
                                     (list)
                                     (/.lefts actual)))))
                  (_.cover [/.partition]
                           (let [[lefts rights] (|> expected
                                                    (list\each (function (_ value)
                                                                 (if (n.even? value)
                                                                   (/.left value)
                                                                   (/.right value))))
                                                    (: (List (Or Nat Nat)))
                                                    /.partition)]
                             (and (\ (list.equivalence n.equivalence) =
                                     (list.only n.even? expected)
                                     lefts)
                                  (\ (list.equivalence n.equivalence) =
                                     (list.only (|>> n.even? not) expected)
                                     rights))))
                  ))
            ))))