aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/control/writer.lux
blob: 1a73c88c1d5fafd24395cc48a58ca0f923e90df9 (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
... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/.

(.require
 [library
  [lux (.except)
   [abstract
    [equivalence (.only Equivalence)]
    [monoid (.only Monoid)]
    ["[0]" monad (.only do)
     ["[1]T" \\test]]
    ["[0]" functor
     ["[1]T" \\test (.only Injection Comparison)]]
    ["[0]" apply
     ["[1]T" \\test]]]
   [control
    ["[0]" io]]
   [data
    ["[0]" text (.use "[1]#[0]" equivalence)]]
   [math
    ["[0]" random]
    [number
     ["n" nat]]]
   [test
    ["_" property (.only Test)]]]]
 [\\library
  ["[0]" / (.only Writer)]])

(def (injection monoid value)
  (All (_ w) (-> (Monoid w) (Injection (Writer w))))
  [(of monoid identity) value])

(def comparison
  (All (_ w) (Comparison (Writer w)))
  (function (_ == [_ left] [_ right])
    (== left right)))

(def .public test
  Test
  (do random.monad
    [log (random.ascii 1)
     left random.nat
     right random.nat]
    (<| (_.covering /._)
        (_.for [/.Writer
                /.#log /.#value])
        (all _.and
             (_.for [/.functor]
                    (functorT.spec (..injection text.monoid) ..comparison /.functor))
             (_.for [/.apply]
                    (applyT.spec (..injection text.monoid) ..comparison (/.apply text.monoid)))
             (_.for [/.monad]
                    (monadT.spec (..injection text.monoid) ..comparison (/.monad text.monoid)))

             (_.coverage [/.write]
               (text#= log
                       (the /.#log (/.write log))))
             (_.coverage [/.with /.lifted]
               (let [lifted (/.lifted text.monoid io.monad)
                     (open "io#[0]") io.monad]
                 (|> (do (/.with text.monoid io.monad)
                       [a (lifted (io#in left))
                        b (in right)]
                       (in (n.+ a b)))
                     io.run!
                     (the /.#value)
                     (n.= (n.+ left right)))))
             ))))