aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/abstract/functor.lux
blob: 9cca3367b598a2d0aca74265d265f394508789eb (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
(.require
 [library
  [lux (.except)
   ["_" test (.only Test)]
   ["@" target]
   [abstract
    [monad (.only do)]]
   [control
    ["[0]" maybe]
    ["[0]" state]]
   [data
    ["[0]" identity]
    [collection
     ["[0]" list]]]
   [math
    ["[0]" random]
    [number
     ["n" nat]]]]]
 ["[0]" \\polytypic]
 [\\library
  ["[0]" / (.only Functor)]])

(for @.old (these)
     (these (def maybe_functor
              (Functor .Maybe)
              (\\polytypic.functor .Maybe))

            (def list_functor
              (Functor .List)
              (\\polytypic.functor .List))

            (def state_functor
              (All (_ s) (Functor (state.State s)))
              (\\polytypic.functor state.State))

            (def identity_functor
              (Functor identity.Identity)
              (\\polytypic.functor identity.Identity))))

(def \\polytypic
  Test
  (<| (_.covering \\polytypic._)
      (_.coverage [\\polytypic.functor]
        true)))

(def .public test
  Test
  (do random.monad
    [left random.nat
     right random.nat
     shift random.nat]
    (<| (_.covering /._)
        (all _.and
             (_.coverage [/.Or /.sum]
               (and (case (at (/.sum maybe.functor list.functor) each
                              (n.+ shift)
                              {.#Left {.#Some left}})
                      {.#Left {.#Some actual}}
                      (n.= (n.+ shift left) actual)

                      _
                      false)
                    (case (at (/.sum maybe.functor list.functor) each
                              (n.+ shift)
                              {.#Right (list right)})
                      (pattern {.#Right (list actual)})
                      (n.= (n.+ shift right) actual)

                      _
                      false)))
             (_.coverage [/.And /.product]
               (case (at (/.product maybe.functor list.functor) each
                         (n.+ shift)
                         [{.#Some left} (list right)])
                 (pattern [{.#Some actualL} (list actualR)])
                 (and (n.= (n.+ shift left) actualL)
                      (n.= (n.+ shift right) actualR))

                 _
                 false))
             (_.coverage [/.Then /.composite]
               (case (at (/.composite maybe.functor list.functor) each
                         (n.+ shift)
                         {.#Some (list left)})
                 (pattern {.#Some (list actual)})
                 (n.= (n.+ shift left) actual)

                 _
                 false))

             ..\\polytypic
             ))))