- Added dates, and the capacity to calculate week-days.

3 files changed, 121 insertions, 46 deletions

diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux
new file mode 100644
index 000000000..2da6980ac
--- /dev/null
+++ b/stdlib/source/lux/time/date.lux
@@ -0,0 +1,32 @@
+(;module:
+  lux)
+
+(type: #export Year Int)
+
+(type: #export Month
+  #January
+  #February
+  #March
+  #April
+  #May
+  #June
+  #July
+  #August
+  #September
+  #October
+  #November
+  #December)
+
+(type: #export Day
+  #Sunday
+  #Monday
+  #Tuesday
+  #Wednesday
+  #Thursday
+  #Friday
+  #Saturday)
+
+(type: #export Date
+  {#year Year
+   #month Month
+   #day Nat})
diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux
index 0e9fc22f6..1fed74b24 100644
--- a/stdlib/source/lux/time/instant.lux
+++ b/stdlib/source/lux/time/instant.lux
@@ -14,7 +14,8 @@
              (coll [list "L/" Fold<List> Functor<List>]
                    ["v" vector "v/" Functor<Vector> Fold<Vector>]))
        (type model))
-  (.. ["../d" duration "../d/" ;Order<Duration>]))
+  (.. [duration "duration/" ;Order<Duration>]
+      [date]))
 
 (model: #export Instant
   {#;doc "Instant is defined as milliseconds since the epoch."}
@@ -29,8 +30,8 @@
     (|>. @repr))
 
   (def: #export (span param subject)
-    (-> Instant Instant ../d;Duration)
-    (../d;from-millis (i.- (@repr param) (@repr subject))))
+    (-> Instant Instant duration;Duration)
+    (duration;from-millis (i.- (@repr param) (@repr subject))))
 
   (struct: #export _ (Eq Instant)
     (def: (= param subject)
@@ -49,16 +50,16 @@
       ))
 
   (def: #export (shift duration instant)
-    (-> ../d;Duration Instant Instant)
-    (@model (i.+ (../d;to-millis duration) (@repr instant))))
+    (-> duration;Duration Instant Instant)
+    (@model (i.+ (duration;to-millis duration) (@repr instant))))
 
   (def: #export (relative instant)
-    (-> Instant ../d;Duration)
-    (|> instant @repr ../d;from-millis))
+    (-> Instant duration;Duration)
+    (|> instant @repr duration;from-millis))
 
   (def: #export (absolute offset)
-    (-> ../d;Duration Instant)
-    (|> offset ../d;to-millis @model))
+    (-> duration;Duration Instant)
+    (|> offset duration;to-millis @model))
   )
 
 (def: #export epoch
@@ -80,17 +81,17 @@
 (def: epoch-year Int 1970)
 
 (def: (find-year now)
-  (-> Instant [Int ../d;Duration])
+  (-> Instant [Int duration;Duration])
   (loop [reference epoch-year
          time-left (relative now)]
     (let [year (if (leap-year? reference)
-                 ../d;leap-year
-                 ../d;normal-year)]
-      (if (i.= 0 (../d;query year time-left))
+                 duration;leap-year
+                 duration;normal-year)]
+      (if (i.= 0 (duration;query year time-left))
         [reference time-left]
-        (if (../d/>= ../d;empty time-left)
-          (recur (i.inc reference) (../d;merge (../d;scale -1 year) time-left))
-          (recur (i.dec reference) (../d;merge year time-left)))
+        (if (duration/>= duration;empty time-left)
+          (recur (i.inc reference) (duration;merge (duration;scale -1 year) time-left))
+          (recur (i.dec reference) (duration;merge year time-left)))
         ))))
 
 (def: normal-months
@@ -105,20 +106,20 @@
   (v;update [+1] n.inc normal-months))
 
 (def: (find-month months time)
-  (-> (v;Vector Nat) ../d;Duration [Nat ../d;Duration])
-  (if (../d/>= ../d;empty time)
+  (-> (v;Vector Nat) duration;Duration [Nat duration;Duration])
+  (if (duration/>= duration;empty time)
     (v/fold (function [month-days [current-month time-left]]
-              (let [month-duration (../d;scale (nat-to-int month-days) ../d;day)]
-                (if (i.= 0 (../d;query month-duration time-left))
+              (let [month-duration (duration;scale (nat-to-int month-days) duration;day)]
+                (if (i.= 0 (duration;query month-duration time-left))
                   [current-month         time-left]
-                  [(n.inc current-month) (../d;merge (../d;scale -1 month-duration) time-left)])))
+                  [(n.inc current-month) (duration;merge (duration;scale -1 month-duration) time-left)])))
             [+0 time]
             months)
     (v/fold (function [month-days [current-month time-left]]
-              (let [month-duration (../d;scale (nat-to-int month-days) ../d;day)]
-                (if (i.= 0 (../d;query month-duration time-left))
+              (let [month-duration (duration;scale (nat-to-int month-days) duration;day)]
+                (if (i.= 0 (duration;query month-duration time-left))
                   [current-month         time-left]
-                  [(n.dec current-month) (../d;merge month-duration time-left)])))
+                  [(n.dec current-month) (duration;merge month-duration time-left)])))
             [+11 time]
             (v;reverse months))))
 
@@ -129,9 +130,9 @@
     (%i value)))
 
 (def: (adjust-negative space duration)
-  (-> ../d;Duration ../d;Duration ../d;Duration)
-  (if (../d;negative? duration)
-    (../d;merge space duration)
+  (-> duration;Duration duration;Duration duration;Duration)
+  (if (duration;negative? duration)
+    (duration;merge space duration)
     duration))
 
 (def: (encode-millis millis)
@@ -142,13 +143,13 @@
         ## (i.< 1_000 millis)
         (format "." (%i millis))))
 
-(def: seconds-per-day Int (../d;query ../d;second ../d;day))
+(def: seconds-per-day Int (duration;query duration;second duration;day))
 (def: days-up-to-epoch Int 719468)
 
 (def: (extract-date instant)
-  (-> Instant [[Int Int Int] ../d;Duration])
+  (-> Instant [[Int Int Int] duration;Duration])
   (let [offset (relative instant)
-        seconds (../d;query ../d;second offset)
+        seconds (duration;query duration;second offset)
         z (|> seconds (i./ seconds-per-day) (i.+ days-up-to-epoch))
         era (i./ 146097
                  (if (i.>= 0 z)
@@ -165,8 +166,8 @@
                          (i.- (|> (i.* 365 years-of-era)
                                   (i.+ (i./ 4 years-of-era))
                                   (i.- (i./ 100 years-of-era)))))
-        day-time (../d;frame ../d;day offset)
-        days-of-year (if (../d/>= ../d;empty day-time)
+        day-time (duration;frame duration;day offset)
+        days-of-year (if (duration/>= duration;empty day-time)
                        days-of-year
                        (i.dec days-of-year))
         mp (|> days-of-year (i.* 5) (i.+ 2) (i./ 153))
@@ -187,18 +188,18 @@
 (def: (encode instant)
   (-> Instant Text)
   (let [[[year month day] day-time] (extract-date instant)
-        day-time (if (../d/>= ../d;empty day-time)
+        day-time (if (duration/>= duration;empty day-time)
                    day-time
-                   (../d;merge ../d;day day-time))
-        [hours day-time] [(../d;query ../d;hour day-time) (../d;frame ../d;hour day-time)]
-        [minutes day-time] [(../d;query ../d;minute day-time) (../d;frame ../d;minute day-time)]
-        [seconds millis] [(../d;query ../d;second day-time) (../d;frame ../d;second day-time)]
+                   (duration;merge duration;day day-time))
+        [hours day-time] [(duration;query duration;hour day-time) (duration;frame duration;hour day-time)]
+        [minutes day-time] [(duration;query duration;minute day-time) (duration;frame duration;minute day-time)]
+        [seconds millis] [(duration;query duration;second day-time) (duration;frame duration;second day-time)]
         ]
     (format (%i year) "-" (pad month) "-" (pad day) "T"
             (pad hours) ":" (pad minutes) ":" (pad seconds)
             (|> millis
-                (adjust-negative ../d;second)
-                ../d;to-millis
+                (adjust-negative duration;second)
+                duration;to-millis
                 encode-millis)
             "Z")))
 
@@ -281,11 +282,11 @@
                           (i.+ (nat-to-int month-days-so-far))
                           (i.+ (i.dec utc-day)))]]
     (wrap (|> epoch
-              (shift (../d;scale total-days ../d;day))
-              (shift (../d;scale utc-hour ../d;hour))
-              (shift (../d;scale utc-minute ../d;minute))
-              (shift (../d;scale utc-second ../d;second))
-              (shift (../d;scale utc-millis ../d;milli))))))
+              (shift (duration;scale total-days duration;day))
+              (shift (duration;scale utc-hour duration;hour))
+              (shift (duration;scale utc-minute duration;minute))
+              (shift (duration;scale utc-second duration;second))
+              (shift (duration;scale utc-millis duration;milli))))))
 
 (def: (decode input)
   (-> Text (R;Result Instant))
@@ -302,3 +303,45 @@
 (def: #export now
   (IO Instant)
   (io (from-millis (_lux_proc ["io" "current-time"] []))))
+
+(def: #export (date instant)
+  (-> Instant date;Date)
+  (let [[[year month day] _] (extract-date instant)]
+    {#date;year year
+     #date;month (case month
+                   0 #date;January
+                   1 #date;February
+                   2 #date;March
+                   3 #date;April
+                   4 #date;May
+                   5 #date;June
+                   6 #date;July
+                   7 #date;August
+                   8 #date;September
+                   9 #date;October
+                   10 #date;November
+                   11 #date;December
+                   _ (undefined))
+     #date;day (int-to-nat day)}))
+
+(def: #export (day instant)
+  (-> Instant date;Day)
+  (let [offset (relative instant)
+        days (duration;query duration;day offset)
+        days (if (i.>= 0 days)
+               days
+               (i.dec days))
+        ## 1970/01/01 was a Thursday
+        y1970m0d0 4]
+    (case (|> y1970m0d0
+              (i.+ days) (i.% 7)
+              ## This is down to turn negative days into positive days.
+              (i.+ 7) (i.% 7))
+      0 #date;Sunday
+      1 #date;Monday
+      2 #date;Tuesday
+      3 #date;Wednesday
+      4 #date;Thursday
+      5 #date;Friday
+      6 #date;Saturday
+      _ (undefined))))
diff --git a/stdlib/test/test/lux/time/instant.lux b/stdlib/test/test/lux/time/instant.lux
index eda4e4ebe..2baeff7a7 100644
--- a/stdlib/test/test/lux/time/instant.lux
+++ b/stdlib/test/test/lux/time/instant.lux
@@ -9,7 +9,8 @@
              [number "Int/" Number<Int>])
        (math ["r" random])
        (time ["@" instant]
-             ["@d" duration]))
+             ["@d" duration]
+             ["@date" date]))
   lux/test)
 
 (def: boundary Int 99_999_999_999_999)
@@ -59,7 +60,6 @@
             (|> @;epoch (@;shift (@;relative sample)) (@/= sample)))))
 
 (context: "Codec"
-  #seed +4428624921609897635
   [sample instant
    #let [(^open "@/") @;Eq<Instant>
          (^open "@/") @;Codec<Text,Instant>]]