diff options
Diffstat (limited to 'stdlib/source/library/lux/world/time.lux')
| -rw-r--r-- | stdlib/source/library/lux/world/time.lux | 215 |
1 files changed, 215 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/world/time.lux b/stdlib/source/library/lux/world/time.lux new file mode 100644 index 000000000..d24e87497 --- /dev/null +++ b/stdlib/source/library/lux/world/time.lux @@ -0,0 +1,215 @@ +(.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 .public (time_exceeds_a_day [time 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 .public (<exception> [value 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.case + 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)))) |