From b3e2657c901e42dc14544821a68ded03a4c925ab Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 23 Jul 2017 03:04:37 -0400
Subject: - Codec now works on negative times (with respect to the epoch). -
 There are still some corner cases where decoding fails. MUST FIX.

---
 stdlib/source/lux/time.lux    | 26 ++++++++++++++------------
 stdlib/test/test/lux/time.lux | 28 +++++-----------------------
 2 files changed, 19 insertions(+), 35 deletions(-)

(limited to 'stdlib')

diff --git a/stdlib/source/lux/time.lux b/stdlib/source/lux/time.lux
index 89c01b0ea..d910287f7 100644
--- a/stdlib/source/lux/time.lux
+++ b/stdlib/source/lux/time.lux
@@ -140,10 +140,13 @@
         ## (i.< 1_000 millis)
         (format "." (%i millis))))
 
+(def: seconds-per-day Int (i./ second day))
+(def: days-up-to-epoch Int 719468)
+
 (def: (extract-date time)
   (-> Time [[Int Int Int] Time])
   (let [seconds (i./ second time)
-        z (|> seconds (i./ 86400) (i.+ 719468))
+        z (|> seconds (i./ seconds-per-day) (i.+ days-up-to-epoch))
         era (i./ 146097
                  (if (i.>= 0 z)
                    z
@@ -159,6 +162,10 @@
                          (i.- (|> (i.* 365 years-of-era)
                                   (i.+ (i./ 4 years-of-era))
                                   (i.- (i./ 100 years-of-era)))))
+        day-time (i.% ;;day time)
+        days-of-year (if (positive? day-time)
+                       days-of-year
+                       (i.dec days-of-year))
         mp (|> days-of-year (i.* 5) (i.+ 2) (i./ 153))
         day (|> days-of-year
                 (i.- (|> mp (i.* 153) (i.+ 2) (i./ 5)))
@@ -171,12 +178,15 @@
                (i.inc year)
                year)]
     [[year month day]
-     (i.% ;;day time)]))
+     day-time]))
 
 ## Based on this: https://stackoverflow.com/a/42936293/6823464
 (def: (encode time)
   (-> Time Text)
   (let [[[year month day] time] (extract-date time)
+        time (if (positive? time)
+               time
+               (i.+ time ;;day))
         [hours time] [(i./ hour time) (i.% hour time)]
         [minutes time] [(i./ minute time) (i.% minute time)]
         [seconds millis] [(i./ second time) (i.% second time)]]
@@ -215,17 +225,16 @@
       (i.- (i./ 100 year))
       (i.+ (i./ 400 year))))
 
+## Based on: https://stackoverflow.com/a/3309340/6823464
 (def: lex-time
   (l;Lexer Time)
   (do p;Monad<Parser>
     [utc-year lex-year
-     ## #let [_ (log! (format "  utc-year = " (%i utc-year)))]
      _ (l;this "-")
      utc-month lex-section
      _ (p;assert "Invalid month."
                  (and (i.>= 1 utc-month)
                       (i.<= 12 utc-month)))
-     ## #let [_ (log! (format " utc-month = " (%i utc-month)))]
      #let [months (if (leap-year? utc-year)
                     leap-year-months
                     normal-months)
@@ -238,27 +247,22 @@
      _ (p;assert "Invalid day."
                  (and (i.>= 1 utc-day)
                       (i.<= month-days utc-day)))
-     ## #let [_ (log! (format "   utc-day = " (%i utc-day)))]
      _ (l;this "T")
      utc-hour lex-section
      _ (p;assert "Invalid hour."
                  (and (i.>= 0 utc-hour)
                       (i.<= 23 utc-hour)))
-     ## #let [_ (log! (format "  utc-hour = " (%i utc-hour)))]
      _ (l;this ":")
      utc-minute lex-section
      _ (p;assert "Invalid minute."
                  (and (i.>= 0 utc-minute)
                       (i.<= 59 utc-minute)))
-     ## #let [_ (log! (format "utc-minute = " (%i utc-minute)))]
      _ (l;this ":")
      utc-second lex-section
      _ (p;assert "Invalid second."
                  (and (i.>= 0 utc-second)
                       (i.<= 59 utc-second)))
-     ## #let [_ (log! (format "utc-second = " (%i utc-second)))]
      utc-millis lex-millis
-     ## #let [_ (log! (format "utc-millis = " (%i utc-millis)))]
      _ (l;this "Z")
      #let [years-since-epoch (i.- epoch-year utc-year)
            previous-leap-days (i.- (leap-years epoch-year)
@@ -272,9 +276,7 @@
                                  (i./ day))
            total-days (|> year-days-so-far
                           (i.+ month-days-so-far)
-                          (i.+ (i.dec utc-day)))
-           ## _ (log! (format "total-days = " (%i total-days)))
-           ]]
+                          (i.+ (i.dec utc-day)))]]
     (wrap ($_ t.+
               (i.* day total-days)
               (i.* hour utc-hour)
diff --git a/stdlib/test/test/lux/time.lux b/stdlib/test/test/lux/time.lux
index becdfc068..3d477f4ea 100644
--- a/stdlib/test/test/lux/time.lux
+++ b/stdlib/test/test/lux/time.lux
@@ -20,23 +20,10 @@
               (i.% (nat-to-int size))
               (i.* (Int/signum sample))))))
 
-(def: (pow exp base)
-  (-> Nat Int Int)
-  (case exp
-    +0 1
-    _ (loop [exp exp
-             result base]
-        (case exp
-          +1 result
-          _ (recur (n.dec exp)
-                   (i.* base result))))))
-(def: boundary Int (|> 2 (pow +31) (i.* @;second)))
+(def: boundary Int 99_999_999_999_999)
 
 (def: time (r;Random @;Time)
-  (|> r;int
-      (r;filter (i.>= 0))
-      ## (:: r;Monad<Random> map (i.% boundary))
-      ))
+  (|> r;int (:: r;Monad<Random> map (i.% boundary))))
 
 (context: "Equality"
   [sample time
@@ -64,15 +51,11 @@
         (and (or (< reference sample)
                  (>= reference sample))
              (or (> reference sample)
-                 (<= reference sample))))
-  )
+                 (<= reference sample)))))
 
 (context: "Codec"
-  ## #seed +1484609979608
-  ## #seed +1484654273059
+  #seed +16366082068080165840
   [sample time
-   ## #let [sample 1095292800_000]
-   ## #let [_ (log! (format "sample = " (%i sample)))]
    #let [(^open "&/") @;Codec<Text,Time>]]
   (test "Can encode/decode times."
         (|> sample
@@ -82,5 +65,4 @@
                    (@;t.= sample decoded)
 
                    (#R;Error error)
-                   false)))
-  )
+                   false))))
-- 
cgit v1.2.3