aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/data/collection/row.lux
blob: 7afbafd59374054ab4a3a30653e941672da692c9 (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
(.module:
  [lux #*
   ["%" data/text/format (#+ format)]
   ["_" test (#+ Test)]
   [abstract
    [monad (#+ do)]
    {[0 #test]
     [/
      ["$." equivalence]
      ["$." monoid]
      ["$." fold]
      ["$." functor (#+ Injection)]
      ["$." apply]
      ["$." monad]]}]
   [data
    ["." maybe]
    [number
     ["." nat]]
    [collection
     ["." list ("#@." fold)]]]
   [math
    ["r" random]]]
  {1
   ["." / ("#@." monad)]})

(def: #export test
  Test
  (<| (_.context (%.name (name-of /._)))
      (do r.monad
        [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))]
        ($_ _.and
            ($equivalence.spec (/.equivalence nat.equivalence) (r.row size r.nat))
            ($monoid.spec (/.equivalence nat.equivalence) /.monoid (r.row size r.nat))
            ($fold.spec /@wrap /.equivalence /.fold)
            ($functor.spec /@wrap /.equivalence /.functor)
            ($apply.spec /@wrap /.equivalence /.apply)
            ($monad.spec /@wrap /.equivalence /.monad)

            (do @
              [idx (|> r.nat (:: @ map (n/% size)))
               sample (r.row size r.nat)
               other-sample (r.row size r.nat)
               non-member (|> r.nat (r.filter (|>> (/.member? nat.equivalence sample) not)))
               #let [(^open "/@.") (/.equivalence nat.equivalence)]]
              ($_ _.and
                  (_.test (format (%.name (name-of /.size))
                                  " " (%.name (name-of /.empty?)))
                          (if (/.empty? sample)
                            (and (n/= 0 size)
                                 (n/= 0 (/.size sample)))
                            (n/= size (/.size sample))))
                  (_.test (format (%.name (name-of /.add))
                                  " " (%.name (name-of /.pop)))
                          (and (n/= (inc size) (/.size (/.add non-member sample)))
                               (n/= (dec size) (/.size (/.pop sample)))))
                  (_.test (format (%.name (name-of /.put))
                                  " " (%.name (name-of /.nth)))
                          (|> sample
                              (/.put idx non-member)
                              (/.nth idx)
                              maybe.assume
                              (is? non-member)))
                  (_.test (%.name (name-of /.update))
                          (|> sample
                              (/.put idx non-member) (/.update idx inc)
                              (/.nth idx) maybe.assume
                              (n/= (inc non-member))))
                  (_.test (format (%.name (name-of /.to-list))
                                  " " (%.name (name-of /.from-list)))
                          (|> sample /.to-list /.from-list (/@= sample)))
                  (_.test (%.name (name-of /.member?))
                          (and (not (/.member? nat.equivalence sample non-member))
                               (/.member? nat.equivalence (/.add non-member sample) non-member)))
                  (_.test (%.name (name-of /.reverse))
                          (and (not (/@= sample
                                         (/.reverse sample)))
                               (/@= sample
                                    (/.reverse (/.reverse sample)))))
                  ))
            ))))