blob: 853b0429fe686871e31339ffb956185bf24ae862 (
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
217
|
(.require
[library
[lux (.except)
[abstract
[equivalence (.only Equivalence)]
[order (.only Order)]
[enum (.only Enum)]
[codec (.only Codec)]
[monad (.only Monad do)]]
[control
["<>" parser (.only)]
["[0]" pipe]
["[0]" try (.only Try)]
["[0]" exception (.only Exception)]]
[data
["[0]" text (.use "[1]#[0]" monoid)
["<[1]>" \\parser (.only Parser)]]]
[math
[number
["n" nat (.use "[1]#[0]" decimal)]]]
[meta
[type
[primitive (.except)]]]]]
[/
["[0]" duration (.only Duration)]])
(with_template [<name> <singular> <plural>]
[(def .public <name>
Nat
(.nat (duration.ticks <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.millis duration.day)))
(exception.def .public (time_exceeds_a_day time)
(Exception Nat)
(exception.report
(list ["Time (in milli-seconds)" (n#encoded time)]
["Maximum (in milli-seconds)" (n#encoded (-- limit))])))
(def separator ":")
(def section_parser
(Parser Nat)
(<>.codec n.decimal (<text>.exactly 2 <text>.decimal)))
(def millis_parser
(Parser Nat)
(<>.either (|> (<text>.at_most 3 <text>.decimal)
(<>.codec n.decimal)
(<>.after (<text>.this ".")))
(at <>.monad in 0)))
(with_template [<maximum> <parser> <exception> <sub_parser>]
[(exception.def .public (<exception> value)
(Exception Nat)
(exception.report
(list ["Value" (n#encoded value)]
["Minimum" (n#encoded 0)]
["Maximum" (n#encoded (-- <maximum>))])))
(def <parser>
(Parser Nat)
(do <>.monad
[value <sub_parser>]
(if (n.< <maximum> value)
(in value)
(<>.lifted (exception.except <exception> [value])))))]
[..hours hour_parser invalid_hour ..section_parser]
[..minutes minute_parser invalid_minute ..section_parser]
[..seconds second_parser invalid_second ..section_parser]
)
(primitive .public Time
Nat
(def .public midnight
Time
(abstraction 0))
(def .public (of_millis milli_seconds)
(-> Nat (Try Time))
(if (n.< ..limit milli_seconds)
{try.#Success (abstraction milli_seconds)}
(exception.except ..time_exceeds_a_day [milli_seconds])))
(def .public millis
(-> Time Nat)
(|>> representation))
(def .public equivalence
(Equivalence Time)
(implementation
(def (= param subject)
(n.= (representation param) (representation subject)))))
(def .public order
(Order Time)
(implementation
(def equivalence ..equivalence)
(def (< param subject)
(n.< (representation param) (representation subject)))))
(`` (def .public enum
(Enum Time)
(implementation
(def order ..order)
(def succ
(|>> representation ++ (n.% ..limit) abstraction))
(def pred
(|>> representation
(pipe.when
0 ..limit
millis millis)
--
abstraction)))))
(def .public parser
(Parser Time)
(let [millis (is (-> Duration Nat)
(|>> duration.millis .nat))
hour (millis duration.hour)
minute (millis duration.minute)
second (millis duration.second)
millis (millis duration.milli_second)]
(do [! <>.monad]
[utc_hour ..hour_parser
_ (<text>.this ..separator)
utc_minute ..minute_parser
_ (<text>.this ..separator)
utc_second ..second_parser
utc_millis ..millis_parser]
(in (abstraction
(all n.+
(n.* utc_hour hour)
(n.* utc_minute minute)
(n.* utc_second second)
(n.* utc_millis millis)))))))
)
(def (padded value)
(-> Nat Text)
(if (n.< 10 value)
(text#composite "0" (n#encoded value))
(n#encoded value)))
(def (positive space duration)
(-> Duration Duration Duration)
(if (duration.negative? duration)
(duration.composite space duration)
duration))
(def (millis_format millis)
(-> Nat Text)
(cond (n.= 0 millis) ""
(n.< 10 millis) (all text#composite ".00" (n#encoded millis))
(n.< 100 millis) (all text#composite ".0" (n#encoded millis))
... (n.< 1,000 millis)
(all text#composite "." (n#encoded millis))))
(type .public Clock
(Record
[#hour Nat
#minute Nat
#second Nat
#milli_second Nat]))
(def .public (clock time)
(-> Time Clock)
(let [time (|> time ..millis .int duration.of_millis)
[hours time] [(duration.ticks duration.hour time) (duration.framed duration.hour time)]
[minutes time] [(duration.ticks duration.minute time) (duration.framed duration.minute time)]
[seconds millis] [(duration.ticks duration.second time) (duration.framed duration.second time)]]
[#hour (.nat hours)
#minute (.nat minutes)
#second (.nat seconds)
#milli_second (|> millis
(..positive duration.second)
duration.millis
.nat)]))
(def .public (time clock)
(-> Clock (Try Time))
(|> (all duration.composite
(duration.up (the #hour clock) duration.hour)
(duration.up (the #minute clock) duration.minute)
(duration.up (the #second clock) duration.second)
(duration.of_millis (.int (the #milli_second clock))))
duration.millis
.nat
..of_millis))
(def (format time)
(-> Time Text)
(let [(open "_[0]") (..clock time)]
(all text#composite
(..padded _#hour)
..separator (..padded _#minute)
..separator (..padded _#second)
(..millis_format _#milli_second))))
(def .public codec
(Codec Text Time)
(implementation
(def encoded ..format)
(def decoded (<text>.result ..parser))))
|
