From f502efa593f22c82d2ae4cee70be90b5e3c96fe8 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 29 Jul 2017 18:38:09 -0400
Subject: - Added more structures for instants and dates.

---
 stdlib/source/lux/time/date.lux    | 157 ++++++++++++++++++++++++++++++++++++-
 stdlib/source/lux/time/instant.lux |  39 +++++----
 2 files changed, 179 insertions(+), 17 deletions(-)

(limited to 'stdlib/source')

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
-- 
cgit v1.2.3