diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/time/date.lux | 157 | ||||
| -rw-r--r-- | stdlib/source/lux/time/instant.lux | 39 | ||||
| -rw-r--r-- | stdlib/test/test/lux/time/date.lux | 86 | ||||
| -rw-r--r-- | stdlib/test/test/lux/time/instant.lux | 11 | ||||
| -rw-r--r-- | stdlib/test/tests.lux | 3 |
5 files changed, 278 insertions, 18 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 diff --git a/stdlib/test/test/lux/time/date.lux b/stdlib/test/test/lux/time/date.lux new file mode 100644 index 000000000..e5b5fefc5 --- /dev/null +++ b/stdlib/test/test/lux/time/date.lux @@ -0,0 +1,86 @@ +(;module: + lux + (lux [io] + (control [monad #+ do Monad]) + (math ["r" random "r/" Monad<Random>]) + (time ["@" date])) + lux/test) + +(def: month + (r;Random @;Month) + (r;either (r;either (r;either (r/wrap #@;January) + (r;either (r/wrap #@;February) + (r/wrap #@;March))) + (r;either (r/wrap #@;April) + (r;either (r/wrap #@;May) + (r/wrap #@;June)))) + (r;either (r;either (r/wrap #@;July) + (r;either (r/wrap #@;August) + (r/wrap #@;September))) + (r;either (r/wrap #@;October) + (r;either (r/wrap #@;November) + (r/wrap #@;December)))))) + +(context: "(Month) Eq." + [sample month + #let [(^open "@/") @;Eq<Month>]] + (test "Every value equals itself." + (@/= sample sample))) + +(context: "(Month) Order." + [reference month + sample month + #let [(^open "@/") @;Order<Month>]] + (test "Valid Order." + (and (or (@/< reference sample) + (@/>= reference sample)) + (or (@/> reference sample) + (@/<= reference sample))))) + +(context: "(Month) Enum." + [sample month + #let [(^open "@/") @;Enum<Month>]] + (test "Valid Enum." + (and (not (@/= (@/succ sample) + sample)) + (not (@/= (@/pred sample) + sample)) + (|> sample @/succ @/pred (@/= sample)) + (|> sample @/pred @/succ (@/= sample))))) + +(def: day + (r;Random @;Day) + (r;either (r;either (r;either (r/wrap #@;Sunday) + (r/wrap #@;Monday)) + (r;either (r/wrap #@;Tuesday) + (r/wrap #@;Wednesday))) + (r;either (r;either (r/wrap #@;Thursday) + (r/wrap #@;Friday)) + (r/wrap #@;Saturday)))) + +(context: "(Day) Eq." + [sample day + #let [(^open "@/") @;Eq<Day>]] + (test "Every value equals itself." + (@/= sample sample))) + +(context: "(Day) Order." + [reference day + sample day + #let [(^open "@/") @;Order<Day>]] + (test "Valid Order." + (and (or (@/< reference sample) + (@/>= reference sample)) + (or (@/> reference sample) + (@/<= reference sample))))) + +(context: "(Day) Enum." + [sample day + #let [(^open "@/") @;Enum<Day>]] + (test "Valid Enum." + (and (not (@/= (@/succ sample) + sample)) + (not (@/= (@/pred sample) + sample)) + (|> sample @/succ @/pred (@/= sample)) + (|> sample @/pred @/succ (@/= sample))))) diff --git a/stdlib/test/test/lux/time/instant.lux b/stdlib/test/test/lux/time/instant.lux index 2baeff7a7..40ab587d7 100644 --- a/stdlib/test/test/lux/time/instant.lux +++ b/stdlib/test/test/lux/time/instant.lux @@ -44,6 +44,17 @@ (or (@/> reference sample) (@/<= reference sample))))) +(context: "Enum" + [sample instant + #let [(^open "@/") @;Enum<Instant>]] + (test "Valid Enum." + (and (not (@/= (@/succ sample) + sample)) + (not (@/= (@/pred sample) + sample)) + (|> sample @/succ @/pred (@/= sample)) + (|> sample @/pred @/succ (@/= sample))))) + (context: "Arithmetic" [sample instant span duration diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 6f593abff..b6dbdfcd2 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -10,7 +10,8 @@ ["_;" host] ["_;" io] (time ["_;" instant] - ["_;" duration]) + ["_;" duration] + ["_;" date]) (concurrency ["_;" actor] ["_;" atom] ["_;" frp] |