aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/time/instant.lux
blob: 80a43472b586a274f6253485219310acb52bc172 (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
101
102
103
104
105
(.module:
  [lux #*
   ["_" test (#+ Test)]
   [abstract
    [monad (#+ do)]
    [\spec
     ["$." equivalence]
     ["$." order]
     ["$." enum]
     ["$." codec]]]
   [control
    ["." function]
    ["." try]
    ["." io]]
   [data
    [collection
     ["." list ("#\." fold)]]]
   [math
    ["." random]]
   [time
    ["." duration (#+ Duration)]
    ["." day (#+ Day) ("#\." enum)]]]
  [\\
   ["." /]])

(def: #export test
  Test
  (<| (_.covering /._)
      (_.for [/.Instant])
      ($_ _.and
          (_.for [/.equivalence]
                 ($equivalence.spec /.equivalence random.instant))
          (_.for [/.order]
                 ($order.spec /.order random.instant))
          (_.for [/.enum]
                 ($enum.spec /.enum random.instant))
          (_.for [/.codec]
                 ($codec.spec /.equivalence /.codec random.instant))

          (do random.monad
            [#let [(^open "\.") /.equivalence]
             expected random.instant]
            ($_ _.and
                (_.cover [/.to_millis /.from_millis]
                         (|> expected /.to_millis /.from_millis (\= expected)))
                (_.cover [/.relative /.absolute]
                         (|> expected /.relative /.absolute (\= expected)))
                (_.cover [/.date /.time /.from_date_time]
                         (\= expected
                             (/.from_date_time (/.date expected)
                                               (/.time expected))))
                ))
          (do random.monad
            [#let [(^open "\.") /.equivalence
                   (^open "duration\.") duration.equivalence]
             from random.instant
             to random.instant]
            ($_ _.and
                (_.cover [/.span]
                         (|> from (/.span from) (duration\= duration.empty)))
                (_.cover [/.shift]
                         (|> from (/.shift (/.span from to)) (\= to)))
                (_.cover [/.epoch]
                         (duration\= (/.relative to)
                                     (/.span /.epoch to)))
                ))
          (do random.monad
            [instant random.instant
             #let [d0 (/.day_of_week instant)]]
            (_.cover [/.day_of_week]
                     (let [apply (: (-> (-> Duration Duration) (-> Day Day) Nat Bit)
                                    (function (_ polarity move steps)
                                      (let [day_shift (list\fold (function.constant move)
                                                                 d0
                                                                 (list.repeat steps []))
                                            instant_shift (|> instant
                                                              (/.shift (polarity (duration.up steps duration.day)))
                                                              /.day_of_week)]
                                        (day\= day_shift
                                               instant_shift))))]
                       (and (apply function.identity day\succ 0)
                            (apply function.identity day\succ 1)
                            (apply function.identity day\succ 2)
                            (apply function.identity day\succ 3)
                            (apply function.identity day\succ 4)
                            (apply function.identity day\succ 5)
                            (apply function.identity day\succ 6)
                            (apply function.identity day\succ 7)

                            (apply duration.inverse day\pred 0)
                            (apply duration.inverse day\pred 1)
                            (apply duration.inverse day\pred 2)
                            (apply duration.inverse day\pred 3)
                            (apply duration.inverse day\pred 4)
                            (apply duration.inverse day\pred 5)
                            (apply duration.inverse day\pred 6)
                            (apply duration.inverse day\pred 7)))))
          (_.cover [/.now]
                   (case (try (io.run /.now))
                     (#try.Success _)
                     true
                     
                     (#try.Failure _)
                     false))
          )))