diff options
Diffstat (limited to 'stdlib/source')
| -rw-r--r-- | stdlib/source/lux/time/date.lux | 157 | ||||
| -rw-r--r-- | stdlib/source/lux/time/instant.lux | 39 |
2 files changed, 179 insertions, 17 deletions
diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux index 2da6980ac..20f29e943 100644 --- a/stdlib/source/lux/time/date.lux +++ b/stdlib/source/lux/time/date.lux @@ -1,5 +1,8 @@ (;module: - lux) + lux + (lux (control eq + order + enum))) (type: #export Year Int) @@ -17,6 +20,87 @@ #November #December) +(struct: #export _ (Eq Month) + (def: (= reference sample) + (case [reference sample] + (^template [<tag>] + [<tag> <tag>] + true) + ([#January] + [#February] + [#March] + [#April] + [#May] + [#June] + [#July] + [#August] + [#September] + [#October] + [#November] + [#December]) + + _ + false))) + +(def: (month-to-nat month) + (-> Month Nat) + (case month + #January +0 + #February +1 + #March +2 + #April +3 + #May +4 + #June +5 + #July +6 + #August +7 + #September +8 + #October +9 + #November +10 + #December +11)) + +(struct: #export _ (Order Month) + (def: eq Eq<Month>) + (do-template [<name> <comp>] + [(def: (<name> reference sample) + (<comp> (month-to-nat reference) (month-to-nat sample)))] + + [< n.<] + [<= n.<=] + [> n.>] + [>= n.>=] + )) + +(struct: #export _ (Enum Month) + (def: order Order<Month>) + (def: (succ month) + (case month + #January #February + #February #March + #March #April + #April #May + #May #June + #June #July + #July #August + #August #September + #September #October + #October #November + #November #December + #December #January)) + (def: (pred month) + (case month + #February #January + #March #February + #April #March + #May #April + #June #May + #July #June + #August #July + #September #August + #October #September + #November #October + #December #November + #January #December))) + (type: #export Day #Sunday #Monday @@ -26,7 +110,78 @@ #Friday #Saturday) +(struct: #export _ (Eq Day) + (def: (= reference sample) + (case [reference sample] + (^template [<tag>] + [<tag> <tag>] + true) + ([#Sunday] + [#Monday] + [#Tuesday] + [#Wednesday] + [#Thursday] + [#Friday] + [#Saturday]) + + _ + false))) + +(def: (day-to-nat day) + (-> Day Nat) + (case day + #Sunday +0 + #Monday +1 + #Tuesday +2 + #Wednesday +3 + #Thursday +4 + #Friday +5 + #Saturday +6)) + +(struct: #export _ (Order Day) + (def: eq Eq<Day>) + (do-template [<name> <comp>] + [(def: (<name> reference sample) + (<comp> (day-to-nat reference) (day-to-nat sample)))] + + [< n.<] + [<= n.<=] + [> n.>] + [>= n.>=] + )) + +(struct: #export _ (Enum Day) + (def: order Order<Day>) + (def: (succ day) + (case day + #Sunday #Monday + #Monday #Tuesday + #Tuesday #Wednesday + #Wednesday #Thursday + #Thursday #Friday + #Friday #Saturday + #Saturday #Sunday)) + (def: (pred day) + (case day + #Monday #Sunday + #Tuesday #Monday + #Wednesday #Tuesday + #Thursday #Wednesday + #Friday #Thursday + #Saturday #Friday + #Sunday #Saturday))) + (type: #export Date {#year Year #month Month #day Nat}) + +(struct: #export _ (Eq Date) + (def: (= reference sample) + (and (i.= (get@ #year reference) + (get@ #year sample)) + (:: Eq<Month> = + (get@ #month reference) + (get@ #month sample)) + (n.= (get@ #day reference) + (get@ #day sample))))) diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index ebe637217..a05513374 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -3,6 +3,7 @@ (lux [io #- run] (control eq order + enum codec [monad #+ do Monad] ["p" parser]) @@ -33,22 +34,6 @@ (-> Instant Instant duration;Duration) (duration;from-millis (i.- (@repr param) (@repr subject)))) - (struct: #export _ (Eq Instant) - (def: (= param subject) - (i.= (@repr param) (@repr subject)))) - - (struct: #export _ (Order Instant) - (def: eq Eq<Instant>) - (do-template [<name> <op>] - [(def: (<name> param subject) - (<op> (@repr param) (@repr subject)))] - - [< i.<] - [<= i.<=] - [> i.>] - [>= i.>=] - )) - (def: #export (shift duration instant) (-> duration;Duration Instant Instant) (@model (i.+ (duration;to-millis duration) (@repr instant)))) @@ -60,6 +45,28 @@ (def: #export (absolute offset) (-> duration;Duration Instant) (|> offset duration;to-millis @model)) + + (struct: #export _ (Eq Instant) + (def: (= param 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)))] + + [<] [<=] [>] [>=] + )) + + (struct: #export _ (Enum Instant) + (def: order Order<Instant>) + (do-template [<name>] + [(def: <name> + (|>. @repr (:: number;Enum<Int> <name>) @model))] + + [succ] [pred] + )) ) (def: #export epoch |