diff options
| -rw-r--r-- | stdlib/source/lux/time/date.lux | 32 | ||||
| -rw-r--r-- | stdlib/source/lux/time/instant.lux | 131 | ||||
| -rw-r--r-- | stdlib/test/test/lux/time/instant.lux | 4 |
3 files changed, 121 insertions, 46 deletions
diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux new file mode 100644 index 000000000..2da6980ac --- /dev/null +++ b/stdlib/source/lux/time/date.lux @@ -0,0 +1,32 @@ +(;module: + lux) + +(type: #export Year Int) + +(type: #export Month + #January + #February + #March + #April + #May + #June + #July + #August + #September + #October + #November + #December) + +(type: #export Day + #Sunday + #Monday + #Tuesday + #Wednesday + #Thursday + #Friday + #Saturday) + +(type: #export Date + {#year Year + #month Month + #day Nat}) diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index 0e9fc22f6..1fed74b24 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -14,7 +14,8 @@ (coll [list "L/" Fold<List> Functor<List>] ["v" vector "v/" Functor<Vector> Fold<Vector>])) (type model)) - (.. ["../d" duration "../d/" ;Order<Duration>])) + (.. [duration "duration/" ;Order<Duration>] + [date])) (model: #export Instant {#;doc "Instant is defined as milliseconds since the epoch."} @@ -29,8 +30,8 @@ (|>. @repr)) (def: #export (span param subject) - (-> Instant Instant ../d;Duration) - (../d;from-millis (i.- (@repr param) (@repr subject)))) + (-> Instant Instant duration;Duration) + (duration;from-millis (i.- (@repr param) (@repr subject)))) (struct: #export _ (Eq Instant) (def: (= param subject) @@ -49,16 +50,16 @@ )) (def: #export (shift duration instant) - (-> ../d;Duration Instant Instant) - (@model (i.+ (../d;to-millis duration) (@repr instant)))) + (-> duration;Duration Instant Instant) + (@model (i.+ (duration;to-millis duration) (@repr instant)))) (def: #export (relative instant) - (-> Instant ../d;Duration) - (|> instant @repr ../d;from-millis)) + (-> Instant duration;Duration) + (|> instant @repr duration;from-millis)) (def: #export (absolute offset) - (-> ../d;Duration Instant) - (|> offset ../d;to-millis @model)) + (-> duration;Duration Instant) + (|> offset duration;to-millis @model)) ) (def: #export epoch @@ -80,17 +81,17 @@ (def: epoch-year Int 1970) (def: (find-year now) - (-> Instant [Int ../d;Duration]) + (-> Instant [Int duration;Duration]) (loop [reference epoch-year time-left (relative now)] (let [year (if (leap-year? reference) - ../d;leap-year - ../d;normal-year)] - (if (i.= 0 (../d;query year time-left)) + duration;leap-year + duration;normal-year)] + (if (i.= 0 (duration;query year time-left)) [reference time-left] - (if (../d/>= ../d;empty time-left) - (recur (i.inc reference) (../d;merge (../d;scale -1 year) time-left)) - (recur (i.dec reference) (../d;merge year time-left))) + (if (duration/>= duration;empty time-left) + (recur (i.inc reference) (duration;merge (duration;scale -1 year) time-left)) + (recur (i.dec reference) (duration;merge year time-left))) )))) (def: normal-months @@ -105,20 +106,20 @@ (v;update [+1] n.inc normal-months)) (def: (find-month months time) - (-> (v;Vector Nat) ../d;Duration [Nat ../d;Duration]) - (if (../d/>= ../d;empty time) + (-> (v;Vector Nat) duration;Duration [Nat duration;Duration]) + (if (duration/>= duration;empty time) (v/fold (function [month-days [current-month time-left]] - (let [month-duration (../d;scale (nat-to-int month-days) ../d;day)] - (if (i.= 0 (../d;query month-duration time-left)) + (let [month-duration (duration;scale (nat-to-int month-days) duration;day)] + (if (i.= 0 (duration;query month-duration time-left)) [current-month time-left] - [(n.inc current-month) (../d;merge (../d;scale -1 month-duration) time-left)]))) + [(n.inc current-month) (duration;merge (duration;scale -1 month-duration) time-left)]))) [+0 time] months) (v/fold (function [month-days [current-month time-left]] - (let [month-duration (../d;scale (nat-to-int month-days) ../d;day)] - (if (i.= 0 (../d;query month-duration time-left)) + (let [month-duration (duration;scale (nat-to-int month-days) duration;day)] + (if (i.= 0 (duration;query month-duration time-left)) [current-month time-left] - [(n.dec current-month) (../d;merge month-duration time-left)]))) + [(n.dec current-month) (duration;merge month-duration time-left)]))) [+11 time] (v;reverse months)))) @@ -129,9 +130,9 @@ (%i value))) (def: (adjust-negative space duration) - (-> ../d;Duration ../d;Duration ../d;Duration) - (if (../d;negative? duration) - (../d;merge space duration) + (-> duration;Duration duration;Duration duration;Duration) + (if (duration;negative? duration) + (duration;merge space duration) duration)) (def: (encode-millis millis) @@ -142,13 +143,13 @@ ## (i.< 1_000 millis) (format "." (%i millis)))) -(def: seconds-per-day Int (../d;query ../d;second ../d;day)) +(def: seconds-per-day Int (duration;query duration;second duration;day)) (def: days-up-to-epoch Int 719468) (def: (extract-date instant) - (-> Instant [[Int Int Int] ../d;Duration]) + (-> Instant [[Int Int Int] duration;Duration]) (let [offset (relative instant) - seconds (../d;query ../d;second offset) + seconds (duration;query duration;second offset) z (|> seconds (i./ seconds-per-day) (i.+ days-up-to-epoch)) era (i./ 146097 (if (i.>= 0 z) @@ -165,8 +166,8 @@ (i.- (|> (i.* 365 years-of-era) (i.+ (i./ 4 years-of-era)) (i.- (i./ 100 years-of-era))))) - day-time (../d;frame ../d;day offset) - days-of-year (if (../d/>= ../d;empty day-time) + day-time (duration;frame duration;day offset) + days-of-year (if (duration/>= duration;empty day-time) days-of-year (i.dec days-of-year)) mp (|> days-of-year (i.* 5) (i.+ 2) (i./ 153)) @@ -187,18 +188,18 @@ (def: (encode instant) (-> Instant Text) (let [[[year month day] day-time] (extract-date instant) - day-time (if (../d/>= ../d;empty day-time) + day-time (if (duration/>= duration;empty day-time) day-time - (../d;merge ../d;day day-time)) - [hours day-time] [(../d;query ../d;hour day-time) (../d;frame ../d;hour day-time)] - [minutes day-time] [(../d;query ../d;minute day-time) (../d;frame ../d;minute day-time)] - [seconds millis] [(../d;query ../d;second day-time) (../d;frame ../d;second day-time)] + (duration;merge duration;day day-time)) + [hours day-time] [(duration;query duration;hour day-time) (duration;frame duration;hour day-time)] + [minutes day-time] [(duration;query duration;minute day-time) (duration;frame duration;minute day-time)] + [seconds millis] [(duration;query duration;second day-time) (duration;frame duration;second day-time)] ] (format (%i year) "-" (pad month) "-" (pad day) "T" (pad hours) ":" (pad minutes) ":" (pad seconds) (|> millis - (adjust-negative ../d;second) - ../d;to-millis + (adjust-negative duration;second) + duration;to-millis encode-millis) "Z"))) @@ -281,11 +282,11 @@ (i.+ (nat-to-int month-days-so-far)) (i.+ (i.dec utc-day)))]] (wrap (|> epoch - (shift (../d;scale total-days ../d;day)) - (shift (../d;scale utc-hour ../d;hour)) - (shift (../d;scale utc-minute ../d;minute)) - (shift (../d;scale utc-second ../d;second)) - (shift (../d;scale utc-millis ../d;milli)))))) + (shift (duration;scale total-days duration;day)) + (shift (duration;scale utc-hour duration;hour)) + (shift (duration;scale utc-minute duration;minute)) + (shift (duration;scale utc-second duration;second)) + (shift (duration;scale utc-millis duration;milli)))))) (def: (decode input) (-> Text (R;Result Instant)) @@ -302,3 +303,45 @@ (def: #export now (IO Instant) (io (from-millis (_lux_proc ["io" "current-time"] [])))) + +(def: #export (date instant) + (-> Instant date;Date) + (let [[[year month day] _] (extract-date instant)] + {#date;year year + #date;month (case month + 0 #date;January + 1 #date;February + 2 #date;March + 3 #date;April + 4 #date;May + 5 #date;June + 6 #date;July + 7 #date;August + 8 #date;September + 9 #date;October + 10 #date;November + 11 #date;December + _ (undefined)) + #date;day (int-to-nat day)})) + +(def: #export (day instant) + (-> Instant date;Day) + (let [offset (relative instant) + days (duration;query duration;day offset) + days (if (i.>= 0 days) + days + (i.dec days)) + ## 1970/01/01 was a Thursday + y1970m0d0 4] + (case (|> y1970m0d0 + (i.+ days) (i.% 7) + ## This is down to turn negative days into positive days. + (i.+ 7) (i.% 7)) + 0 #date;Sunday + 1 #date;Monday + 2 #date;Tuesday + 3 #date;Wednesday + 4 #date;Thursday + 5 #date;Friday + 6 #date;Saturday + _ (undefined)))) diff --git a/stdlib/test/test/lux/time/instant.lux b/stdlib/test/test/lux/time/instant.lux index eda4e4ebe..2baeff7a7 100644 --- a/stdlib/test/test/lux/time/instant.lux +++ b/stdlib/test/test/lux/time/instant.lux @@ -9,7 +9,8 @@ [number "Int/" Number<Int>]) (math ["r" random]) (time ["@" instant] - ["@d" duration])) + ["@d" duration] + ["@date" date])) lux/test) (def: boundary Int 99_999_999_999_999) @@ -59,7 +60,6 @@ (|> @;epoch (@;shift (@;relative sample)) (@/= sample))))) (context: "Codec" - #seed +4428624921609897635 [sample instant #let [(^open "@/") @;Eq<Instant> (^open "@/") @;Codec<Text,Instant>]] |