blob: a82ae6bed18bd83b63f0eee986e6aaed8adecf4c (
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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
(.module:
[lux #*
[abstract
equivalence
[order (#+ Order)]
codec
[monoid (#+ Monoid)]
[monad (#+ do)]]
[control
["e" try]
["p" parser
["l" text]]]
[data
[number
["." nat ("#@." decimal)]
["." int]]
["." text ("#@." monoid)]]
[type
abstract]])
(abstract: #export Duration
{#.doc "Durations have a resolution of milli-seconds."}
Int
(def: #export from-millis
(-> Int Duration)
(|>> :abstraction))
(def: #export to-millis
(-> Duration Int)
(|>> :representation))
(template [<name> <op>]
[(def: #export (<name> param subject)
(-> Duration Duration Duration)
(:abstraction (<op> (:representation param) (:representation subject))))]
[merge i/+]
[frame i/%]
)
(template [<name> <op>]
[(def: #export (<name> scalar)
(-> Nat Duration Duration)
(|>> :representation (<op> (.int scalar)) :abstraction))]
[scale-up i/*]
[scale-down i//]
)
(def: #export inverse
(-> Duration Duration)
(|>> :representation (i/* -1) :abstraction))
(def: #export (difference from to)
(-> Duration Duration Duration)
(|> from inverse (merge to)))
(def: #export (query param subject)
(-> Duration Duration Int)
(i// (:representation param) (:representation subject)))
(structure: #export equivalence (Equivalence Duration)
(def: (= param subject)
(i/= (:representation param) (:representation subject))))
(structure: #export order (Order Duration)
(def: &equivalence ..equivalence)
(def: (< param subject)
(i/< (:representation param) (:representation subject))))
(template [<name> <op>]
[(def: #export <name>
(-> Duration Bit)
(|>> :representation (<op> +0)))]
[positive? i/>]
[negative? i/<]
[neutral? i/=]
)
)
(def: #export empty (from-millis +0))
(def: #export milli-second (from-millis +1))
(template [<name> <scale> <base>]
[(def: #export <name> (scale-up <scale> <base>))]
[second 1,000 milli-second]
[minute 60 second]
[hour 60 minute]
[day 24 hour]
[week 7 day]
[normal-year 365 day]
)
(def: #export leap-year (merge day normal-year))
(structure: #export monoid (Monoid Duration)
(def: identity ..empty)
(def: compose ..merge))
(def: #export (encode duration)
(if (:: ..equivalence = empty duration)
"+0ms"
(let [signed? (negative? duration)
[days time-left] [(query day duration) (frame day duration)]
days (if signed?
(int.abs days)
days)
time-left (if signed?
(..inverse time-left)
time-left)
[hours time-left] [(query hour time-left) (frame hour time-left)]
[minutes time-left] [(query minute time-left) (frame minute time-left)]
[seconds time-left] [(query second time-left) (frame second time-left)]
millis (to-millis time-left)]
($_ text@compose
(if signed? "-" "+")
(if (i/= +0 days) "" (text@compose (nat@encode (.nat days)) "D"))
(if (i/= +0 hours) "" (text@compose (nat@encode (.nat hours)) "h"))
(if (i/= +0 minutes) "" (text@compose (nat@encode (.nat minutes)) "m"))
(if (i/= +0 seconds) "" (text@compose (nat@encode (.nat seconds)) "s"))
(if (i/= +0 millis) "" (text@compose (nat@encode (.nat millis)) "ms"))
))))
|
