diff options
Diffstat (limited to 'stdlib/source/lux/time/instant.lux')
-rw-r--r-- | stdlib/source/lux/time/instant.lux | 124 |
1 files changed, 62 insertions, 62 deletions
diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index b26707173..892b8df5b 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -14,7 +14,7 @@ [data ["." maybe] [number - ["." int ("#@." decimal)]] + ["i" int ("#@." decimal)]] ["." text ("#@." monoid)] [collection ["." list ("#@." fold)] @@ -41,11 +41,11 @@ (def: #export (span from to) (-> Instant Instant duration.Duration) - (duration.from-millis (i/- (:representation from) (:representation to)))) + (duration.from-millis (i.- (:representation from) (:representation to)))) (def: #export (shift duration instant) (-> duration.Duration Instant Instant) - (:abstraction (i/+ (duration.to-millis duration) (:representation instant)))) + (:abstraction (i.+ (duration.to-millis duration) (:representation instant)))) (def: #export (relative instant) (-> Instant duration.Duration) @@ -57,18 +57,18 @@ (structure: #export equivalence (Equivalence Instant) (def: (= param subject) - (:: int.equivalence = (:representation param) (:representation subject)))) + (:: i.equivalence = (:representation param) (:representation subject)))) (structure: #export order (Order Instant) (def: &equivalence ..equivalence) (def: (< param subject) - (:: int.order < (:representation param) (:representation subject)))) + (:: i.order < (:representation param) (:representation subject)))) (`` (structure: #export enum (Enum Instant) (def: &order ..order) (~~ (template [<name>] [(def: <name> - (|>> :representation (:: int.enum <name>) :abstraction))] + (|>> :representation (:: i.enum <name>) :abstraction))] [succ] [pred] )))) @@ -82,7 +82,7 @@ ## Codec::encode (def: (divisible? factor input) (-> Int Int Bit) - (|> input (i/% factor) (i/= +0))) + (|> input (i.% factor) (i.= +0))) (def: (leap-year? year) (-> Int Bit) @@ -99,7 +99,7 @@ (let [year (if (leap-year? reference) duration.leap-year duration.normal-year)] - (if (i/= +0 (duration.query year time-left)) + (if (i.= +0 (duration.query year time-left)) [reference time-left] (if (order.>= duration.order duration.empty time-left) (recur (inc reference) (duration.merge (duration.inverse year) time-left)) @@ -122,14 +122,14 @@ (if (order.>= duration.order duration.empty time) (row@fold (function (_ month-days [current-month time-left]) (let [month-duration (duration.scale-up month-days duration.day)] - (if (i/= +0 (duration.query month-duration time-left)) + (if (i.= +0 (duration.query month-duration time-left)) [current-month time-left] [(inc current-month) (duration.merge (duration.inverse month-duration) time-left)]))) [0 time] months) (row@fold (function (_ month-days [current-month time-left]) (let [month-duration (duration.scale-up month-days duration.day)] - (if (i/= +0 (duration.query month-duration time-left)) + (if (i.= +0 (duration.query month-duration time-left)) [current-month time-left] [(dec current-month) (duration.merge month-duration time-left)]))) [11 time] @@ -137,9 +137,9 @@ (def: (pad value) (-> Int Text) - (if (i/< +10 value) - (text@compose "0" (int@encode value)) - (int@encode value))) + (if (i.< +10 value) + (text@compose "0" (i@encode value)) + (i@encode value))) (def: (adjust-negative space duration) (-> duration.Duration duration.Duration duration.Duration) @@ -149,11 +149,11 @@ (def: (encode-millis millis) (-> Int Text) - (cond (i/= +0 millis) "" - (i/< +10 millis) ($_ text@compose ".00" (int@encode millis)) - (i/< +100 millis) ($_ text@compose ".0" (int@encode millis)) - ## (i/< +1,000 millis) - ($_ text@compose "." (int@encode millis)))) + (cond (i.= +0 millis) "" + (i.< +10 millis) ($_ text@compose ".00" (i@encode millis)) + (i.< +100 millis) ($_ text@compose ".0" (i@encode millis)) + ## (i.< +1,000 millis) + ($_ text@compose "." (i@encode millis)))) (def: seconds-per-day Int (duration.query duration.second duration.day)) (def: days-up-to-epoch Int +719468) @@ -162,35 +162,35 @@ (-> Instant [[Int Int Int] duration.Duration]) (let [offset (relative instant) seconds (duration.query duration.second offset) - z (|> seconds (i// seconds-per-day) (i/+ days-up-to-epoch)) - era (i// +146097 - (if (i/>= +0 z) + z (|> seconds (i./ seconds-per-day) (i.+ days-up-to-epoch)) + era (i./ +146097 + (if (i.>= +0 z) z - (i/- +146096 z))) - days-of-era (|> z (i/- (i/* +146097 era))) + (i.- +146096 z))) + days-of-era (|> z (i.- (i.* +146097 era))) years-of-era (|> days-of-era - (i/- (i// +1460 days-of-era)) - (i/+ (i// +36524 days-of-era)) - (i/- (i// +146096 days-of-era)) - (i// +365)) - year (|> years-of-era (i/+ (i/* +400 era))) + (i.- (i./ +1460 days-of-era)) + (i.+ (i./ +36524 days-of-era)) + (i.- (i./ +146096 days-of-era)) + (i./ +365)) + year (|> years-of-era (i.+ (i.* +400 era))) days-of-year (|> days-of-era - (i/- (|> (i/* +365 years-of-era) - (i/+ (i// +4 years-of-era)) - (i/- (i// +100 years-of-era))))) + (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 (order.>= duration.order duration.empty day-time) days-of-year (dec days-of-year)) - mp (|> days-of-year (i/* +5) (i/+ +2) (i// +153)) + mp (|> days-of-year (i.* +5) (i.+ +2) (i./ +153)) day (|> days-of-year - (i/- (|> mp (i/* +153) (i/+ +2) (i// +5))) - (i/+ +1)) + (i.- (|> mp (i.* +153) (i.+ +2) (i./ +5))) + (i.+ +1)) month (|> mp - (i/+ (if (i/< +10 mp) + (i.+ (if (i.< +10 mp) +3 -9))) - year (if (i/<= +2 month) + year (if (i.<= +2 month) (inc year) year)] [[year month day] @@ -206,7 +206,7 @@ [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" + ($_ text@compose (i@encode year) "-" (pad month) "-" (pad day) "T" (pad hours) ":" (pad minutes) ":" (pad seconds) (|> millis (adjust-negative duration.second) @@ -219,28 +219,28 @@ (Parser Int) (do p.monad [sign (p.or (l.this "-") (l.this "+")) - raw-year (p.codec int.decimal (l.many l.decimal)) + raw-year (p.codec i.decimal (l.many l.decimal)) #let [signum (case sign (#.Left _) -1 (#.Right _) +1)]] - (wrap (i/* signum raw-year)))) + (wrap (i.* signum raw-year)))) (def: lex-section (Parser Int) - (p.codec int.decimal (l.exactly 2 l.decimal))) + (p.codec i.decimal (l.exactly 2 l.decimal))) (def: lex-millis (Parser Int) (p.either (|> (l.at-most 3 l.decimal) - (p.codec int.decimal) + (p.codec i.decimal) (p.after (l.this "."))) (:: p.monad wrap +0))) (def: (leap-years year) (-> Int Int) - (|> (i// +4 year) - (i/- (i// +100 year)) - (i/+ (i// +400 year)))) + (|> (i./ +4 year) + (i.- (i./ +100 year)) + (i.+ (i./ +400 year)))) ## Based on: https://stackoverflow.com/a/3309340/6823464 ## (def: lex-instant @@ -250,8 +250,8 @@ ## _ (l.this "-") ## utc-month lex-section ## _ (p.assert "Invalid month." -## (and (i/>= +1 utc-month) -## (i/<= +12 utc-month))) +## (and (i.>= +1 utc-month) +## (i.<= +12 utc-month))) ## #let [months (if (leap-year? utc-year) ## leap-year-months ## normal-months) @@ -261,37 +261,37 @@ ## _ (l.this "-") ## utc-day lex-section ## _ (p.assert "Invalid day." -## (and (i/>= +1 utc-day) -## (i/<= (.int month-days) utc-day))) +## (and (i.>= +1 utc-day) +## (i.<= (.int month-days) utc-day))) ## _ (l.this "T") ## utc-hour lex-section ## _ (p.assert "Invalid hour." -## (and (i/>= +0 utc-hour) -## (i/<= +23 utc-hour))) +## (and (i.>= +0 utc-hour) +## (i.<= +23 utc-hour))) ## _ (l.this ":") ## utc-minute lex-section ## _ (p.assert "Invalid minute." -## (and (i/>= +0 utc-minute) -## (i/<= +59 utc-minute))) +## (and (i.>= +0 utc-minute) +## (i.<= +59 utc-minute))) ## _ (l.this ":") ## utc-second lex-section ## _ (p.assert "Invalid second." -## (and (i/>= +0 utc-second) -## (i/<= +59 utc-second))) +## (and (i.>= +0 utc-second) +## (i.<= +59 utc-second))) ## utc-millis lex-millis ## _ (l.this "Z") -## #let [years-since-epoch (i/- epoch-year utc-year) -## previous-leap-days (i/- (leap-years epoch-year) +## #let [years-since-epoch (i.- epoch-year utc-year) +## previous-leap-days (i.- (leap-years epoch-year) ## (leap-years (dec utc-year))) -## year-days-so-far (|> (i/* +365 years-since-epoch) -## (i/+ previous-leap-days)) +## year-days-so-far (|> (i.* +365 years-since-epoch) +## (i.+ previous-leap-days)) ## month-days-so-far (|> months ## row.to-list ## (list.take (.nat (dec utc-month))) ## (list@fold n/+ 0)) ## total-days (|> year-days-so-far -## (i/+ (.int month-days-so-far)) -## (i/+ (dec utc-day)))]] +## (i.+ (.int month-days-so-far)) +## (i.+ (dec utc-day)))]] ## (wrap (|> epoch ## (shift (duration.scale-up total-days duration.day)) ## (shift (duration.scale-up utc-hour duration.hour)) @@ -351,9 +351,9 @@ ## 1970/01/01 was a Thursday y1970m0d0 +4] (case (|> y1970m0d0 - (i/+ days) (i/% +7) + (i.+ days) (i.% +7) ## This is done to turn negative days into positive days. - (i/+ +7) (i/% +7)) + (i.+ +7) (i.% +7)) +0 #day.Sunday +1 #day.Monday +2 #day.Tuesday |