aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/type/quotient.lux
blob: a0f2fa4440ed2b18242d61a9d8424d6937d80e1f (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
(.using
 [library
  [lux (.except)
   ["_" test (.only Test)]
   [abstract
    ["[0]" monad (.only do)]
    [\\specification
     ["$[0]" equivalence]]]
   [data
    ["[0]" text ("[1]#[0]" equivalence)
     ["%" format (.only format)]]]
   [math
    ["[0]" random (.only Random)]
    [number
     ["n" nat ("[1]#[0]" equivalence)]]]]]
 [\\library
  ["[0]" /]])

(def: .public (random class super)
  (All (_ t c %) (-> (/.Class t c %) (Random t) (Random (/.Quotient t c %))))
  (# random.monad each (/.quotient class) super))

(def: mod_10_class
  (/.class (|>> (n.% 10) %.nat)))

(def: Mod_10
  (/.type ..mod_10_class))

(def: .public test
  Test
  (<| (_.covering /._)
      (do random.monad
        [modulus (random.only (n.> 0) random.nat)
         .let [class (is (-> Nat Text)
                         (|>> (n.% modulus) %.nat))]
         value random.nat]
        (all _.and
             (_.for [/.equivalence]
                    ($equivalence.spec (/.equivalence text.equivalence)
                                       (..random (/.class class) random.nat)))

             (_.for [/.Class]
                    (_.coverage [/.class]
                      (same? (is Any class)
                             (is Any (/.class class)))))
             (_.for [/.Quotient]
                    (all _.and
                         (_.coverage [/.quotient /.value /.label]
                           (let [quotient (/.quotient (/.class class) value)]
                             (and (same? value
                                         (/.value quotient))
                                  (text#= (class value)
                                          (/.label quotient)))))
                         (_.coverage [/.type]
                           (exec
                             (is ..Mod_10
                                 (/.quotient ..mod_10_class value))
                             true))
                         ))
             ))))