aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/time/date.lux157
-rw-r--r--stdlib/source/lux/time/instant.lux39
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