- Some improvements/refactoring for durations.

2 files changed, 16 insertions, 22 deletions

diff --git a/stdlib/source/lux/time/duration.lux b/stdlib/source/lux/time/duration.lux
index 2adc023a2..800a2536a 100644
--- a/stdlib/source/lux/time/duration.lux
+++ b/stdlib/source/lux/time/duration.lux
@@ -68,7 +68,7 @@
 
 (def: #export empty Duration (from-millis 0))
 (def: #export milli Duration (from-millis 1))
-(def: #export second Duration (from-millis 1_000))
+(def: #export second Duration (scale 1_000 milli))
 (def: #export minute Duration (scale 60 second))
 (def: #export hour Duration (scale 60 minute))
 (def: #export day Duration (scale 24 hour))
@@ -81,18 +81,20 @@
   (if (:: Eq<Duration> = empty duration)
     "0ms"
     (let [signed? (negative? duration)
-          [hours time-left] [(query hour duration) (frame hour duration)]
-          hours (if signed?
-                  (int/abs hours)
-                  hours)
+          [days time-left] [(query day duration) (frame day duration)]
+          days (if signed?
+                 (int/abs days)
+                 days)
           time-left (if signed?
                       (scale -1 time-left)
                       time-left)
+          [hours time-left] [(query hour time-left) (frame hour time-left)]
           [minutes time-left] [(query minute time-left) (frame minute time-left)]
           [seconds time-left] [(query second time-left) (frame second time-left)]
           millis (to-millis time-left)]
       ($_ text/append
           (if signed? "-" "")
+          (if (i.= 0 days) "" (text/append (int/encode days) "D"))
           (if (i.= 0 hours) "" (text/append (int/encode hours) "h"))
           (if (i.= 0 minutes) "" (text/append (int/encode minutes) "m"))
           (if (i.= 0 seconds) "" (text/append (int/encode seconds) "s"))
@@ -110,6 +112,7 @@
   (do p;Monad<Parser>
     [signed? (l;this? "-")
      #let [sign (function [raw] (if signed? (i.* -1 raw) raw))]
+     utc-day (lex-section "D")
      utc-hour (lex-section "h")
      utc-minute (lex-section "m")
      _ (p;assert "Invalid minute."
@@ -124,6 +127,7 @@
                  (and (i.>= 0 utc-millis)
                       (i.<= 999 utc-millis)))]
     (wrap (|> empty
+              (merge (scale (sign utc-day) day))
               (merge (scale (sign utc-hour) hour))
               (merge (scale (sign utc-minute) minute))
               (merge (scale (sign utc-second) second))
@@ -134,9 +138,7 @@
   (l;run input lex-duration))
 
 (struct: #export _
-  {#;doc "Based on ISO 8601.
-
-          For example: 21h14m51s827ms"}
+  {#;doc "For example: 15D21h14m51s827ms"}
   (Codec Text Duration)
   (def: encode encode)
   (def: decode decode))
diff --git a/stdlib/test/test/lux/time/duration.lux b/stdlib/test/test/lux/time/duration.lux
index d10b9b57c..4a674420e 100644
--- a/stdlib/test/test/lux/time/duration.lux
+++ b/stdlib/test/test/lux/time/duration.lux
@@ -1,8 +1,7 @@
 (;module:
   lux
   (lux [io]
-       (control [monad #+ do Monad]
-                [pipe])
+       (control [monad #+ do Monad])
        (data ["R" result])
        (math ["r" random])
        (time ["@" duration]))
@@ -34,7 +33,6 @@
                  (@/<= reference sample)))))
 
 (context: "Arithmetic."
-  #seed +16674263968423793
   [sample (|> duration (:: @ map (@;frame @;day)))
    frame duration
    factor (|> r;int (:: @ map (|>. (i.% 10) (i.max 1))))
@@ -64,17 +62,11 @@
                                  frame))))))))
 
 (context: "Codec"
-  #seed +9664448049824422386
   [sample duration
    #let [(^open "@/") @;Eq<Duration>
          (^open "@/") @;Codec<Text,Duration>]]
-  (exec
-    (test "Can encode/decode durations."
-          (|> sample
-              @/encode
-              @/decode
-              (pipe;case> (#R;Success decoded)
-                          (@/= sample decoded)
-
-                          (#R;Error error)
-                          false)))))
+  (test "Can encode/decode durations."
+        (R;default false
+          (do R;Monad<Result>
+            [decoded (|> sample @/encode @/decode)]
+            (wrap (@/= sample decoded))))))