blob: 3a737f113f655dbcffded509038d4c98d259a48a (
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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
|
(.module:
[lux #*
[abstract
[equivalence (#+ Equivalence)]
[order (#+ Order)]
[enum (#+ Enum)]
[codec (#+ Codec)]
[monad (#+ Monad do)]]
[control
[pipe (#+ case>)]
["." try (#+ Try)]
["." exception (#+ exception:)]
["<>" parser
["<.>" text (#+ Parser)]]]
[data
["." text ("#\." monoid)]]
[math
[number
["n" nat ("#\." decimal)]]]
[type
abstract]]
[/
["." duration (#+ Duration)]])
(template [<name> <singular> <plural>]
[(def: #export <name>
Nat
(.nat (duration.query <singular> <plural>)))]
[milli_seconds duration.milli_second duration.second]
[seconds duration.second duration.minute]
[minutes duration.minute duration.hour]
[hours duration.hour duration.day]
)
(def: limit
Nat
(.nat (duration.to_millis duration.day)))
(exception: #export (time_exceeds_a_day {time Nat})
(exception.report
["Time (in milli-seconds)" (n\encode time)]
["Maximum (in milli-seconds)" (n\encode (dec limit))]))
(def: separator ":")
(def: parse_section
(Parser Nat)
(<>.codec n.decimal (<text>.exactly 2 <text>.decimal)))
(def: parse_millis
(Parser Nat)
(<>.either (|> (<text>.at_most 3 <text>.decimal)
(<>.codec n.decimal)
(<>.after (<text>.this ".")))
(\ <>.monad wrap 0)))
(template [<maximum> <parser> <exception> <sub_parser>]
[(exception: #export (<exception> {value Nat})
(exception.report
["Value" (n\encode value)]
["Minimum" (n\encode 0)]
["Maximum" (n\encode (dec <maximum>))]))
(def: <parser>
(Parser Nat)
(do <>.monad
[value <sub_parser>]
(if (n.< <maximum> value)
(wrap value)
(<>.lift (exception.throw <exception> [value])))))]
[..hours parse_hour invalid_hour ..parse_section]
[..minutes parse_minute invalid_minute ..parse_section]
[..seconds parse_second invalid_second ..parse_section]
)
(abstract: #export Time
Nat
{#.doc "Time is defined as milliseconds since the start of the day (00:00:00.000)."}
(def: #export midnight
{#.doc "The instant corresponding to the start of the day: 00:00:00.000"}
Time
(:abstraction 0))
(def: #export (from_millis milli_seconds)
(-> Nat (Try Time))
(if (n.< ..limit milli_seconds)
(#try.Success (:abstraction milli_seconds))
(exception.throw ..time_exceeds_a_day [milli_seconds])))
(def: #export to_millis
(-> Time Nat)
(|>> :representation))
(implementation: #export equivalence
(Equivalence Time)
(def: (= param subject)
(n.= (:representation param) (:representation subject))))
(implementation: #export order
(Order Time)
(def: &equivalence ..equivalence)
(def: (< param subject)
(n.< (:representation param) (:representation subject))))
(`` (implementation: #export enum
(Enum Time)
(def: &order ..order)
(def: succ
(|>> :representation inc (n.% ..limit) :abstraction))
(def: pred
(|>> :representation
(case> 0 ..limit
millis millis)
dec
:abstraction))))
(def: #export parser
(Parser Time)
(let [to_millis (: (-> Duration Nat)
(|>> duration.to_millis .nat))
hour (to_millis duration.hour)
minute (to_millis duration.minute)
second (to_millis duration.second)
millis (to_millis duration.milli_second)]
(do {! <>.monad}
[utc_hour ..parse_hour
_ (<text>.this ..separator)
utc_minute ..parse_minute
_ (<text>.this ..separator)
utc_second ..parse_second
utc_millis ..parse_millis]
(wrap (:abstraction
($_ n.+
(n.* utc_hour hour)
(n.* utc_minute minute)
(n.* utc_second second)
(n.* utc_millis millis)))))))
)
(def: (pad value)
(-> Nat Text)
(if (n.< 10 value)
(text\compose "0" (n\encode value))
(n\encode value)))
(def: (adjust_negative space duration)
(-> Duration Duration Duration)
(if (duration.negative? duration)
(duration.merge space duration)
duration))
(def: (encode_millis millis)
(-> Nat Text)
(cond (n.= 0 millis) ""
(n.< 10 millis) ($_ text\compose ".00" (n\encode millis))
(n.< 100 millis) ($_ text\compose ".0" (n\encode millis))
## (n.< 1,000 millis)
($_ text\compose "." (n\encode millis))))
(type: #export Clock
{#hour Nat
#minute Nat
#second Nat
#milli_second Nat})
(def: #export (clock time)
(-> Time Clock)
(let [time (|> time ..to_millis .int duration.from_millis)
[hours time] [(duration.query duration.hour time) (duration.frame duration.hour time)]
[minutes time] [(duration.query duration.minute time) (duration.frame duration.minute time)]
[seconds millis] [(duration.query duration.second time) (duration.frame duration.second time)]]
{#hour (.nat hours)
#minute (.nat minutes)
#second (.nat seconds)
#milli_second (|> millis
(..adjust_negative duration.second)
duration.to_millis
.nat)}))
(def: #export (time clock)
(-> Clock (Try Time))
(|> ($_ duration.merge
(duration.up (get@ #hour clock) duration.hour)
(duration.up (get@ #minute clock) duration.minute)
(duration.up (get@ #second clock) duration.second)
(duration.from_millis (.int (get@ #milli_second clock))))
duration.to_millis
.nat
..from_millis))
(def: (encode time)
(-> Time Text)
(let [(^slots [#hour #minute #second #milli_second]) (..clock time)]
($_ text\compose
(..pad hour)
..separator (..pad minute)
..separator (..pad second)
(..encode_millis milli_second))))
(implementation: #export codec
{#.doc (doc "Based on ISO 8601."
"For example: 21:14:51.827")}
(Codec Text Time)
(def: encode ..encode)
(def: decode (<text>.run ..parser)))
|
