diff options
Diffstat (limited to 'stdlib/source/library/lux/time.lux')
| -rw-r--r-- | stdlib/source/library/lux/time.lux | 217 |
1 files changed, 217 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/time.lux b/stdlib/source/library/lux/time.lux new file mode 100644 index 000000000..5c043f696 --- /dev/null +++ b/stdlib/source/library/lux/time.lux @@ -0,0 +1,217 @@ +(.module: + [library + [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))) |