aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/time/duration.lux
blob: f522dc6130b154ab13ffdc8c7a08a51039b168a1 (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
(.module:
  [library
   [lux #*
    ["_" test (#+ Test)]
    [abstract
     [monad (#+ do)]
     [\\specification
      ["$." equivalence]
      ["$." order]
      ["$." enum]
      ["$." monoid]
      ["$." codec]]]
    [data
     ["." bit ("#\." equivalence)]]
    [math
     ["." random (#+ Random)]
     [number
      ["n" nat]
      ["i" int]]]]]
  [\\library
   ["." /]])

(def: .public test
  Test
  (<| (_.covering /._)
      (_.for [/.Duration])
      ($_ _.and
          (_.for [/.equivalence]
                 ($equivalence.spec /.equivalence random.duration))
          (_.for [/.order]
                 ($order.spec /.order random.duration))
          (_.for [/.enum]
                 ($enum.spec /.enum random.duration))
          (_.for [/.monoid]
                 ($monoid.spec /.equivalence /.monoid random.duration))
          (_.for [/.codec]
                 ($codec.spec /.equivalence /.codec random.duration))

          (do random.monad
            [duration random.duration]
            (_.cover [/.of_millis /.millis]
                     (|> duration /.millis /.of_millis (\ /.equivalence = duration))))
          (do random.monad
            [.let [(^open "\.") /.equivalence]
             expected random.duration
             parameter random.duration]
            ($_ _.and
                (_.cover [/.merged /.difference]
                         (|> expected (/.merged parameter) (/.difference parameter) (\= expected)))
                (_.cover [/.empty]
                         (|> expected (/.merged /.empty) (\= expected)))
                (_.cover [/.inverse]
                         (and (|> expected /.inverse /.inverse (\= expected))
                              (|> expected (/.merged (/.inverse expected)) (\= /.empty))))
                (_.cover [/.positive? /.negative? /.neutral?]
                         (or (bit\= (/.positive? expected)
                                    (/.negative? (/.inverse expected)))
                             (bit\= (/.neutral? expected)
                                    (/.neutral? (/.inverse expected)))))
                ))
          (do random.monad
            [.let [(^open "\.") /.equivalence]
             factor random.nat]
            (_.cover [/.up /.down]
                     (|> /.milli_second (/.up factor) (/.down factor) (\= /.milli_second))))
          (do {! random.monad}
            [.let [(^open "\.") /.order
                   positive (|> random.duration
                                (random.only (|>> (\= /.empty) not))
                                (\ ! map (function (_ duration)
                                           (if (/.positive? duration)
                                             duration
                                             (/.inverse duration)))))]
             sample positive
             frame positive]
            (`` ($_ _.and
                    (_.cover [/.framed]
                             (let [sample' (/.framed frame sample)]
                               (and (\< frame sample')
                                    (bit\= (\< frame sample)
                                           (\= sample sample')))))
                    (_.cover [/.ticks]
                             (i.= +1 (/.ticks sample sample)))
                    (_.cover [/.milli_second]
                             (\= /.empty (\ /.enum pred /.milli_second)))
                    (~~ (template [<factor> <big> <small>]
                          [(_.cover [<big>]
                                    (|> <big> (/.ticks <small>) (i.= <factor>)))]

                          [+1,000 /.second /.milli_second]
                          [+60 /.minute /.second]
                          [+60 /.hour /.minute]
                          [+24 /.day /.hour]

                          [+7 /.week /.day]
                          [+365 /.normal_year /.day]
                          [+366 /.leap_year /.day]
                          ))
                    )))
          )))