diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/time/instant.lux | 226 |
1 files changed, 113 insertions, 113 deletions
diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index 1175d4c75..1285e50e6 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux [io #- run] (control eq @@ -19,7 +19,7 @@ [date])) (opaque: #export Instant - {#;doc "Instant is defined as milliseconds since the epoch."} + {#.doc "Instant is defined as milliseconds since the epoch."} Int (def: #export from-millis @@ -31,30 +31,30 @@ (|>> @repr)) (def: #export (span from to) - (-> Instant Instant duration;Duration) - (duration;from-millis (i/- (@repr from) (@repr to)))) + (-> Instant Instant duration.Duration) + (duration.from-millis (i/- (@repr from) (@repr to)))) (def: #export (shift duration instant) - (-> duration;Duration Instant Instant) - (@opaque (i/+ (duration;to-millis duration) (@repr instant)))) + (-> duration.Duration Instant Instant) + (@opaque (i/+ (duration.to-millis duration) (@repr instant)))) (def: #export (relative instant) - (-> Instant duration;Duration) - (|> instant @repr duration;from-millis)) + (-> Instant duration.Duration) + (|> instant @repr duration.from-millis)) (def: #export (absolute offset) - (-> duration;Duration Instant) - (|> offset duration;to-millis @opaque)) + (-> duration.Duration Instant) + (|> offset duration.to-millis @opaque)) (struct: #export _ (Eq Instant) (def: (= param subject) - (:: number;Eq<Int> = (@repr param) (@repr subject)))) + (:: number.Eq<Int> = (@repr param) (@repr subject)))) (struct: #export _ (Order Instant) (def: eq Eq<Instant>) (do-template [<name>] [(def: (<name> param subject) - (:: number;Order<Int> <name> (@repr param) (@repr subject)))] + (:: number.Order<Int> <name> (@repr param) (@repr subject)))] [<] [<=] [>] [>=] )) @@ -63,14 +63,14 @@ (def: order Order<Instant>) (do-template [<name>] [(def: <name> - (|>> @repr (:: number;Enum<Int> <name>) @opaque))] + (|>> @repr (:: number.Enum<Int> <name>) @opaque))] [succ] [pred] )) ) (def: #export epoch - {#;doc "The instant corresponding to 1970-01-01T00:00:00Z"} + {#.doc "The instant corresponding to 1970-01-01T00:00:00Z"} Instant (from-millis 0)) @@ -88,17 +88,17 @@ (def: epoch-year Int 1970) (def: (find-year now) - (-> Instant [Int duration;Duration]) + (-> Instant [Int duration.Duration]) (loop [reference epoch-year time-left (relative now)] (let [year (if (leap-year? reference) - duration;leap-year - duration;normal-year)] - (if (i/= 0 (duration;query year time-left)) + duration.leap-year + duration.normal-year)] + (if (i/= 0 (duration.query year time-left)) [reference 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))) + (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 @@ -110,25 +110,25 @@ (def: leap-year-months (Sequence Nat) - (sequence;update [+1] n/inc normal-months)) + (sequence.update [+1] n/inc normal-months)) (def: (find-month months time) - (-> (Sequence Nat) duration;Duration [Nat duration;Duration]) - (if (duration/>= duration;empty time) + (-> (Sequence Nat) duration.Duration [Nat duration.Duration]) + (if (duration/>= duration.empty time) (sequence/fold (function [month-days [current-month time-left]] - (let [month-duration (duration;scale (nat-to-int month-days) duration;day)] - (if (i/= 0 (duration;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) (duration;merge (duration;scale -1 month-duration) time-left)]))) + [(n/inc current-month) (duration.merge (duration.scale -1 month-duration) time-left)]))) [+0 time] months) (sequence/fold (function [month-days [current-month time-left]] - (let [month-duration (duration;scale (nat-to-int month-days) duration;day)] - (if (i/= 0 (duration;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) (duration;merge month-duration time-left)]))) + [(n/dec current-month) (duration.merge month-duration time-left)]))) [+11 time] - (sequence;reverse months)))) + (sequence.reverse months)))) (def: (pad value) (-> Int Text) @@ -137,9 +137,9 @@ (int/encode value))) (def: (adjust-negative space duration) - (-> duration;Duration duration;Duration duration;Duration) - (if (duration;negative? duration) - (duration;merge space duration) + (-> duration.Duration duration.Duration duration.Duration) + (if (duration.negative? duration) + (duration.merge space duration) duration)) (def: (encode-millis millis) @@ -150,13 +150,13 @@ ## (i/< 1_000 millis) ($_ text/compose "." (int/encode millis)))) -(def: seconds-per-day Int (duration;query duration;second duration;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] duration;Duration]) + (-> Instant [[Int Int Int] duration.Duration]) (let [offset (relative instant) - seconds (duration;query duration;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) @@ -173,8 +173,8 @@ (i/- (|> (i/* 365 years-of-era) (i/+ (i// 4 years-of-era)) (i/- (i// 100 years-of-era))))) - day-time (duration;frame duration;day offset) - days-of-year (if (duration/>= duration;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)) @@ -195,42 +195,42 @@ (def: (encode instant) (-> Instant Text) (let [[[year month day] day-time] (extract-date instant) - day-time (if (duration/>= duration;empty day-time) + day-time (if (duration/>= duration.empty day-time) 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)] + (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)] ] ($_ text/compose (int/encode year) "-" (pad month) "-" (pad day) "T" (pad hours) ":" (pad minutes) ":" (pad seconds) (|> millis - (adjust-negative duration;second) - duration;to-millis + (adjust-negative duration.second) + duration.to-millis encode-millis) "Z"))) ## Codec::decode (def: lex-year - (l;Lexer Int) - (do p;Monad<Parser> - [sign? (p;maybe (l;this "-")) - raw-year (p;codec number;Codec<Text,Int> (l;many l;decimal)) + (l.Lexer Int) + (do p.Monad<Parser> + [sign? (p.maybe (l.this "-")) + raw-year (p.codec number.Codec<Text,Int> (l.many l.decimal)) #let [signum (case sign? - #;None 1 - (#;Some _) -1)]] + #.None 1 + (#.Some _) -1)]] (wrap (i/* signum raw-year)))) (def: lex-section - (l;Lexer Int) - (p;codec number;Codec<Text,Int> (l;exactly +2 l;decimal))) + (l.Lexer Int) + (p.codec number.Codec<Text,Int> (l.exactly +2 l.decimal))) (def: lex-millis - (l;Lexer Int) - (p;either (|> (l;at-most +3 l;decimal) - (p;codec number;Codec<Text,Int>) - (p;after (l;this "."))) - (:: p;Monad<Parser> wrap 0))) + (l.Lexer Int) + (p.either (|> (l.at-most +3 l.decimal) + (p.codec number.Codec<Text,Int>) + (p.after (l.this "."))) + (:: p.Monad<Parser> wrap 0))) (def: (leap-years year) (-> Int Int) @@ -240,67 +240,67 @@ ## Based on: https://stackoverflow.com/a/3309340/6823464 (def: lex-instant - (l;Lexer Instant) - (do p;Monad<Parser> + (l.Lexer Instant) + (do p.Monad<Parser> [utc-year lex-year - _ (l;this "-") + _ (l.this "-") utc-month lex-section - _ (p;assert "Invalid month." + _ (p.assert "Invalid month." (and (i/>= 1 utc-month) (i/<= 12 utc-month))) #let [months (if (leap-year? utc-year) leap-year-months normal-months) month-days (|> months - (sequence;nth (int-to-nat (i/dec utc-month))) - maybe;assume)] - _ (l;this "-") + (sequence.nth (int-to-nat (i/dec utc-month))) + maybe.assume)] + _ (l.this "-") utc-day lex-section - _ (p;assert "Invalid day." + _ (p.assert "Invalid day." (and (i/>= 1 utc-day) (i/<= (nat-to-int month-days) utc-day))) - _ (l;this "T") + _ (l.this "T") utc-hour lex-section - _ (p;assert "Invalid hour." + _ (p.assert "Invalid hour." (and (i/>= 0 utc-hour) (i/<= 23 utc-hour))) - _ (l;this ":") + _ (l.this ":") utc-minute lex-section - _ (p;assert "Invalid minute." + _ (p.assert "Invalid minute." (and (i/>= 0 utc-minute) (i/<= 59 utc-minute))) - _ (l;this ":") + _ (l.this ":") utc-second lex-section - _ (p;assert "Invalid second." + _ (p.assert "Invalid second." (and (i/>= 0 utc-second) (i/<= 59 utc-second))) utc-millis lex-millis - _ (l;this "Z") + _ (l.this "Z") #let [years-since-epoch (i/- epoch-year utc-year) previous-leap-days (i/- (leap-years epoch-year) (leap-years (i/dec utc-year))) year-days-so-far (|> (i/* 365 years-since-epoch) (i/+ previous-leap-days)) month-days-so-far (|> months - sequence;to-list - (list;take (int-to-nat (i/dec utc-month))) + sequence.to-list + (list.take (int-to-nat (i/dec utc-month))) (L/fold n/+ +0)) total-days (|> year-days-so-far (i/+ (nat-to-int month-days-so-far)) (i/+ (i/dec utc-day)))]] (wrap (|> epoch - (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)))))) + (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 (e;Error Instant)) - (l;run input lex-instant)) + (-> Text (e.Error Instant)) + (l.run input lex-instant)) (struct: #export _ - {#;doc "Based on ISO 8601. + {#.doc "Based on ISO 8601. For example: 2017-01-15T21:14:51.827Z"} (Codec Text Instant) @@ -312,37 +312,37 @@ (io (from-millis ("lux io current-time")))) (def: #export (date instant) - (-> Instant date;Date) + (-> Instant date.Date) (let [[[year month day] _] (extract-date instant)] - {#date;year year - #date;month (case (i/dec 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 + {#date.year year + #date.month (case (i/dec 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)})) + #date.day (int-to-nat day)})) (def: #export (month instant) - (-> Instant date;Month) + (-> Instant date.Month) (let [[year month day] (date instant)] month)) (def: #export (day instant) - (-> Instant date;Day) + (-> Instant date.Day) (let [offset (relative instant) - days (duration;query duration;day offset) - day-time (duration;frame duration;day offset) - days (if (and (duration;negative? offset) - (not (duration;neutral? day-time))) + days (duration.query duration.day offset) + day-time (duration.frame duration.day offset) + days (if (and (duration.negative? offset) + (not (duration.neutral? day-time))) (i/dec days) days) ## 1970/01/01 was a Thursday @@ -351,11 +351,11 @@ (i/+ days) (i/% 7) ## This is done 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 + 0 #date.Sunday + 1 #date.Monday + 2 #date.Tuesday + 3 #date.Wednesday + 4 #date.Thursday + 5 #date.Friday + 6 #date.Saturday _ (undefined)))) |