aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--stdlib/source/lux/time/date.lux157
-rw-r--r--stdlib/source/lux/time/instant.lux39
-rw-r--r--stdlib/test/test/lux/time/date.lux86
-rw-r--r--stdlib/test/test/lux/time/instant.lux11
-rw-r--r--stdlib/test/tests.lux3
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]
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 12:31:26 +0000