From b86a223c911edf2580b46d9892f344531616695d Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 24 Jul 2017 20:04:59 -0400
Subject: - Refactored Time into Instant and Duration.

---
 stdlib/source/lux/test.lux          |  16 +-
 stdlib/source/lux/time.lux          | 297 -----------------------------------
 stdlib/source/lux/time/duration.lux |  70 +++++++++
 stdlib/source/lux/time/instant.lux  | 304 ++++++++++++++++++++++++++++++++++++
 4 files changed, 382 insertions(+), 305 deletions(-)
 delete mode 100644 stdlib/source/lux/time.lux
 create mode 100644 stdlib/source/lux/time/duration.lux
 create mode 100644 stdlib/source/lux/time/instant.lux

(limited to 'stdlib/source')

diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux
index eabfe9811..5d95e2f6b 100644
--- a/stdlib/source/lux/test.lux
+++ b/stdlib/source/lux/test.lux
@@ -14,13 +14,11 @@
              text/format
              ["E" result])
        [io #- run]
+       (time [instant]
+             [duration])
        ["R" math/random]))
 
 ## [Host]
-(def: now
-  (IO Int)
-  (io (_lux_proc ["io" "current-time"] [])))
-
 (do-template [<name> <signal>]
   [(def: #hidden <name> (IO Bottom)
      (io (_lux_proc ["io" "exit"] [<signal>])))]
@@ -63,10 +61,12 @@
                    (L/map (: (-> [Text (IO Test) Text] (Promise Counters))
                              (function [[module test description]]
                                (do @
-                                 [#let [pre (io;run now)]
+                                 [#let [pre (io;run instant;now)]
                                   [counters documentation] (io;run test)
-                                  #let [post (io;run now)
-                                        _ (log! (format "@ " module " (" (%i (i.- pre post)) "ms" ") " "\n"
+                                  #let [post (io;run instant;now)
+                                        _ (log! (format "@ " module " "
+                                                        "(" (%i (duration;to-millis (instant;span pre post))) "ms" ")"
+                                                        "\n"
                                                         description "\n"
                                                         "\n" documentation "\n"))]]
                                  (wrap counters)))))
@@ -112,7 +112,7 @@
 
 (def: #hidden (repeat ?seed times random-test)
   (-> (Maybe Nat) Nat (R;Random Test) Test)
-  (repeat' (default (int-to-nat (io;run now))
+  (repeat' (default (|> (io;run instant;now) instant;to-millis int-to-nat)
              ?seed)
            (case ?seed
              #;None times
diff --git a/stdlib/source/lux/time.lux b/stdlib/source/lux/time.lux
deleted file mode 100644
index d910287f7..000000000
--- a/stdlib/source/lux/time.lux
+++ /dev/null
@@ -1,297 +0,0 @@
-(;module:
-  lux
-  (lux (control enum
-                eq
-                order
-                codec
-                [monad #+ do Monad]
-                ["p" parser])
-       (data [text "text/" Monoid<Text>]
-             (text ["l" lexer]
-                   format)
-             [number]
-             ["R" result]
-             (coll [list "L/" Fold<List> Functor<List>]
-                   ["v" vector "v/" Functor<Vector> Fold<Vector>]))))
-
-(type: #export Time
-  {#;doc "Time is defined as milliseconds since the epoch."}
-  Int)
-
-(def: #export epoch
-  {#;doc "The time corresponding to 1970-01-01T00:00:00Z"}
-  Time
-  0)
-
-(def: #export second Time 1_000)
-(def: #export minute Time (i.* 60 second))
-(def: #export hour Time (i.* 60 minute))
-(def: #export day Time (i.* 24 hour))
-(def: #export week Time (i.* 7 day))
-(def: #export normal-year Time (i.* 365 day))
-(def: #export leap-year Time (i.+ day normal-year))
-
-(do-template [<name> <op> <output>]
-  [(def: #export (<name> param subject)
-     (-> Time Time <output>)
-     (<op> param subject))]
-
-  [t.+  i.+  Time]
-  [t.-  i.-  Time]
-  [t.=  i.=  Bool]
-  [t.<  i.<  Bool]
-  [t.<= i.<= Bool]
-  [t.>  i.>  Bool]
-  [t.>= i.>= Bool]
-  )
-
-(struct: #export _ (Eq Time)
-  (def: = t.=))
-
-(struct: #export _ (Order Time)
-  (def: eq Eq<Time>)
-  (def: < t.<)
-  (def: <= t.<=)
-  (def: > t.>)
-  (def: >= t.>=))
-
-## Codec::encode
-(def: (divisible? factor input)
-  (-> Int Int Bool)
-  (|> input (i.% factor) (i.= 0)))
-
-(def: (leap-year? year)
-  (-> Int Bool)
-  (and (divisible? 4 year)
-       (or (not (divisible? 100 year))
-           (divisible? 400 year))))
-
-(def: epoch-year Int 1970)
-
-(def: (positive? time)
-  (-> Time Bool)
-  (i.>= 0 time))
-
-(def: (find-year now)
-  (-> Time [Int Time])
-  (loop [reference epoch-year
-         time-left now]
-    (let [year (if (leap-year? reference)
-                 leap-year
-                 normal-year)
-          within-year-time-frame? (|> time-left (i.% year) (i.= time-left))]
-      (if within-year-time-frame?
-        [reference time-left]
-        (if (positive? time-left)
-          (recur (i.inc reference) (i.- year time-left))
-          (recur (i.dec reference) (i.+ year time-left)))
-        ))))
-
-(def: normal-months
-  (v;Vector Time)
-  (v/map (i.* day)
-         (v;vector 31 28 31
-                   30 31 30
-                   31 31 30
-                   31 30 31)))
-
-(def: leap-year-months
-  (v;Vector Time)
-  (v;update [+1] (i.+ day) normal-months))
-
-(def: (find-month months time)
-  (-> (v;Vector Time) Time [Int Time])
-  (if (positive? time)
-    (v/fold (function [month-time [current-month time-left]]
-              (if (|> time-left (i.% month-time) (i.= time-left))
-                [current-month         time-left]
-                [(i.inc current-month) (i.- month-time time-left)]))
-            [0 time]
-            months)
-    (v/fold (function [month-time [current-month time-left]]
-              (if (|> time-left (i.% month-time) (i.= time-left))
-                [current-month         time-left]
-                [(i.dec current-month) (i.+ month-time time-left)]))
-            [11 time]
-            (v;reverse months))))
-
-(def: (pad value)
-  (-> Int Text)
-  (if (i.< 10 value)
-    (text/append "0" (%i value))
-    (%i value)))
-
-(def: (segment frame time)
-  (-> Time Time [Int Time])
-  [(i./ frame time)
-   (i.% frame time)])
-
-(def: (adjust-negative space value)
-  (-> Int Int Int)
-  (if (i.>= 0 value)
-    value
-    (i.+ space value)))
-
-(def: (encode-millis millis)
-  (-> Time Text)
-  (cond (i.= 0 millis)   ""
-        (i.< 10 millis)  (format ".00" (%i millis))
-        (i.< 100 millis) (format ".0" (%i millis))
-        ## (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./ seconds-per-day) (i.+ days-up-to-epoch))
-        era (i./ 146097
-                 (if (i.>= 0 z)
-                   z
-                   (i.- 146096 z)))
-        days-of-era (|> z (i.- (i.* 146097 era)))
-        years-of-era (|> days-of-era
-                         (i.- (i./ 1460 days-of-era))
-                         (i.+ (i./ 36524 days-of-era))
-                         (i.- (i./ 146096 days-of-era))
-                         (i./ 365))
-        year (|> years-of-era (i.+ (i.* 400 era)))
-        days-of-year (|> days-of-era
-                         (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)))
-                (i.+ 1))
-        month (|> mp
-                  (i.+ (if (i.< 10 mp)
-                         3
-                         -9)))
-        year (if (i.<= 2 month)
-               (i.inc year)
-               year)]
-    [[year month day]
-     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)]]
-    (format (%i year) "-" (pad month) "-" (pad day) "T"
-            (pad hours) ":" (pad minutes) ":" (pad seconds)
-            (|> millis
-                (adjust-negative second)
-                encode-millis)
-            "Z")))
-
-## Codec::decode
-(def: lex-year
-  (l;Lexer Int)
-  (do p;Monad<Parser>
-    [sign? (p;opt (l;this "-"))
-     raw-year (l;codec number;Codec<Text,Int> (l;many l;decimal))
-     #let [signum (case sign?
-                    #;None      1
-                    (#;Some _) -1)]]
-    (wrap (i.* signum raw-year))))
-
-(def: lex-section
-  (l;Lexer Int)
-  (l;codec number;Codec<Text,Int> (l;exactly +2 l;decimal)))
-
-(def: lex-millis
-  (l;Lexer Int)
-  (p;either (|> (l;at-most +3 l;decimal)
-                (l;codec number;Codec<Text,Int>)
-                (p;after (l;this ".")))
-            (:: p;Monad<Parser> wrap 0)))
-
-(def: (leap-years year)
-  (-> Int Int)
-  (|> (i./ 4 year)
-      (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
-     _ (l;this "-")
-     utc-month lex-section
-     _ (p;assert "Invalid month."
-                 (and (i.>= 1 utc-month)
-                      (i.<= 12 utc-month)))
-     #let [months (if (leap-year? utc-year)
-                    leap-year-months
-                    normal-months)
-           month-days (|> months
-                          (v;nth (int-to-nat (i.dec utc-month)))
-                          assume
-                          (i./ day))]
-     _ (l;this "-")
-     utc-day lex-section
-     _ (p;assert "Invalid day."
-                 (and (i.>= 1 utc-day)
-                      (i.<= month-days utc-day)))
-     _ (l;this "T")
-     utc-hour lex-section
-     _ (p;assert "Invalid hour."
-                 (and (i.>= 0 utc-hour)
-                      (i.<= 23 utc-hour)))
-     _ (l;this ":")
-     utc-minute lex-section
-     _ (p;assert "Invalid minute."
-                 (and (i.>= 0 utc-minute)
-                      (i.<= 59 utc-minute)))
-     _ (l;this ":")
-     utc-second lex-section
-     _ (p;assert "Invalid second."
-                 (and (i.>= 0 utc-second)
-                      (i.<= 59 utc-second)))
-     utc-millis lex-millis
-     _ (l;this "Z")
-     #let [years-since-epoch (i.- epoch-year utc-year)
-           previous-leap-days (i.- (leap-years epoch-year)
-                                   (leap-years (i.dec utc-year)))
-           year-days-so-far (|> (i.* 365 years-since-epoch)
-                                (i.+ previous-leap-days))
-           month-days-so-far (|> months
-                                 v;to-list
-                                 (list;take (int-to-nat (i.dec utc-month)))
-                                 (L/fold i.+ 0)
-                                 (i./ day))
-           total-days (|> year-days-so-far
-                          (i.+ month-days-so-far)
-                          (i.+ (i.dec utc-day)))]]
-    (wrap ($_ t.+
-              (i.* day total-days)
-              (i.* hour utc-hour)
-              (i.* minute utc-minute)
-              (i.* second utc-second)
-              utc-millis))))
-
-(def: (decode input)
-  (-> Text (R;Result Time))
-  (l;run input lex-time))
-
-(struct: #export _
-  {#;doc "Based on ISO 8601.
-
-          For example: 2017-01-15T21:14:51.827Z"}
-  (Codec Text Time)
-  (def: encode encode)
-  (def: decode decode))
diff --git a/stdlib/source/lux/time/duration.lux b/stdlib/source/lux/time/duration.lux
new file mode 100644
index 000000000..3deefa944
--- /dev/null
+++ b/stdlib/source/lux/time/duration.lux
@@ -0,0 +1,70 @@
+(;module:
+  lux
+  (lux (control eq
+                order)
+       (type model)))
+
+(model: #export Duration
+  {#;doc "Durations have a resolution of milliseconds."}
+  Int
+
+  (def: #export from-millis
+    (-> Int Duration)
+    (|>. @model))
+
+  (def: #export to-millis
+    (-> Duration Int)
+    (|>. @repr))
+
+  (do-template [<name> <op>]
+    [(def: #export (<name> param subject)
+       (-> Duration Duration Duration)
+       (@model (<op> (@repr param) (@repr subject))))]
+
+    [merge i.+]
+    [frame i.%]
+    )
+
+  (def: #export (scale scalar duration)
+    (-> Int Duration Duration)
+    (@model (i.* scalar (@repr duration))))
+
+  (def: #export (query param subject)
+    (-> Duration Duration Int)
+    (i./ (@repr param) (@repr subject)))
+
+  (struct: #export _ (Eq Duration)
+    (def: (= param subject)
+      (i.= (@repr param) (@repr subject))))
+
+  (struct: #export _ (Order Duration)
+    (def: eq Eq<Duration>)
+    (do-template [<name> <op>]
+      [(def: (<name> param subject)
+         (<op> (@repr param) (@repr subject)))]
+
+      [<  i.<]
+      [<= i.<=]
+      [>  i.>]
+      [>= i.>=]
+      ))
+
+  (do-template [<name> <op>]
+    [(def: #export (<name> duration)
+       (-> Duration Bool)
+       (<op> 0 (@repr duration)))]
+
+    [positive? i.>]
+    [negative? i.<]
+    [neutral?  i.=])
+  )
+
+(def: #export empty Duration (from-millis 0))
+(def: #export milli Duration (from-millis 1))
+(def: #export second Duration (from-millis 1_000))
+(def: #export minute Duration (scale 60 second))
+(def: #export hour Duration (scale 60 minute))
+(def: #export day Duration (scale 24 hour))
+(def: #export week Duration (scale 7 day))
+(def: #export normal-year Duration (scale 365 day))
+(def: #export leap-year Duration (merge day normal-year))
diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux
new file mode 100644
index 000000000..0e9fc22f6
--- /dev/null
+++ b/stdlib/source/lux/time/instant.lux
@@ -0,0 +1,304 @@
+(;module:
+  lux
+  (lux [io #- run]
+       (control eq
+                order
+                codec
+                [monad #+ do Monad]
+                ["p" parser])
+       (data [text "text/" Monoid<Text>]
+             (text ["l" lexer]
+                   format)
+             [number]
+             ["R" result]
+             (coll [list "L/" Fold<List> Functor<List>]
+                   ["v" vector "v/" Functor<Vector> Fold<Vector>]))
+       (type model))
+  (.. ["../d" duration "../d/" ;Order<Duration>]))
+
+(model: #export Instant
+  {#;doc "Instant is defined as milliseconds since the epoch."}
+  Int
+
+  (def: #export from-millis
+    (-> Int Instant)
+    (|>. @model))
+
+  (def: #export to-millis
+    (-> Instant Int)
+    (|>. @repr))
+
+  (def: #export (span param subject)
+    (-> Instant Instant ../d;Duration)
+    (../d;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)
+    (-> ../d;Duration Instant Instant)
+    (@model (i.+ (../d;to-millis duration) (@repr instant))))
+
+  (def: #export (relative instant)
+    (-> Instant ../d;Duration)
+    (|> instant @repr ../d;from-millis))
+
+  (def: #export (absolute offset)
+    (-> ../d;Duration Instant)
+    (|> offset ../d;to-millis @model))
+  )
+
+(def: #export epoch
+  {#;doc "The instant corresponding to 1970-01-01T00:00:00Z"}
+  Instant
+  (from-millis 0))
+
+## Codec::encode
+(def: (divisible? factor input)
+  (-> Int Int Bool)
+  (|> input (i.% factor) (i.= 0)))
+
+(def: (leap-year? year)
+  (-> Int Bool)
+  (and (divisible? 4 year)
+       (or (not (divisible? 100 year))
+           (divisible? 400 year))))
+
+(def: epoch-year Int 1970)
+
+(def: (find-year now)
+  (-> Instant [Int ../d;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))
+        [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)))
+        ))))
+
+(def: normal-months
+  (v;Vector Nat)
+  (v;vector +31 +28 +31
+            +30 +31 +30
+            +31 +31 +30
+            +31 +30 +31))
+
+(def: leap-year-months
+  (v;Vector Nat)
+  (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/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))
+                  [current-month         time-left]
+                  [(n.inc current-month) (../d;merge (../d;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))
+                  [current-month         time-left]
+                  [(n.dec current-month) (../d;merge month-duration time-left)])))
+            [+11 time]
+            (v;reverse months))))
+
+(def: (pad value)
+  (-> Int Text)
+  (if (i.< 10 value)
+    (text/append "0" (%i value))
+    (%i value)))
+
+(def: (adjust-negative space duration)
+  (-> ../d;Duration ../d;Duration ../d;Duration)
+  (if (../d;negative? duration)
+    (../d;merge space duration)
+    duration))
+
+(def: (encode-millis millis)
+  (-> Int Text)
+  (cond (i.= 0 millis)   ""
+        (i.< 10 millis)  (format ".00" (%i millis))
+        (i.< 100 millis) (format ".0" (%i millis))
+        ## (i.< 1_000 millis)
+        (format "." (%i millis))))
+
+(def: seconds-per-day Int (../d;query ../d;second ../d;day))
+(def: days-up-to-epoch Int 719468)
+
+(def: (extract-date instant)
+  (-> Instant [[Int Int Int] ../d;Duration])
+  (let [offset (relative instant)
+        seconds (../d;query ../d;second offset)
+        z (|> seconds (i./ seconds-per-day) (i.+ days-up-to-epoch))
+        era (i./ 146097
+                 (if (i.>= 0 z)
+                   z
+                   (i.- 146096 z)))
+        days-of-era (|> z (i.- (i.* 146097 era)))
+        years-of-era (|> days-of-era
+                         (i.- (i./ 1460 days-of-era))
+                         (i.+ (i./ 36524 days-of-era))
+                         (i.- (i./ 146096 days-of-era))
+                         (i./ 365))
+        year (|> years-of-era (i.+ (i.* 400 era)))
+        days-of-year (|> days-of-era
+                         (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)
+                       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)))
+                (i.+ 1))
+        month (|> mp
+                  (i.+ (if (i.< 10 mp)
+                         3
+                         -9)))
+        year (if (i.<= 2 month)
+               (i.inc year)
+               year)]
+    [[year month day]
+     day-time]))
+
+## Based on this: https://stackoverflow.com/a/42936293/6823464
+(def: (encode instant)
+  (-> Instant Text)
+  (let [[[year month day] day-time] (extract-date instant)
+        day-time (if (../d/>= ../d;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)]
+        ]
+    (format (%i year) "-" (pad month) "-" (pad day) "T"
+            (pad hours) ":" (pad minutes) ":" (pad seconds)
+            (|> millis
+                (adjust-negative ../d;second)
+                ../d;to-millis
+                encode-millis)
+            "Z")))
+
+## Codec::decode
+(def: lex-year
+  (l;Lexer Int)
+  (do p;Monad<Parser>
+    [sign? (p;opt (l;this "-"))
+     raw-year (l;codec number;Codec<Text,Int> (l;many l;decimal))
+     #let [signum (case sign?
+                    #;None      1
+                    (#;Some _) -1)]]
+    (wrap (i.* signum raw-year))))
+
+(def: lex-section
+  (l;Lexer Int)
+  (l;codec number;Codec<Text,Int> (l;exactly +2 l;decimal)))
+
+(def: lex-millis
+  (l;Lexer Int)
+  (p;either (|> (l;at-most +3 l;decimal)
+                (l;codec number;Codec<Text,Int>)
+                (p;after (l;this ".")))
+            (:: p;Monad<Parser> wrap 0)))
+
+(def: (leap-years year)
+  (-> Int Int)
+  (|> (i./ 4 year)
+      (i.- (i./ 100 year))
+      (i.+ (i./ 400 year))))
+
+## Based on: https://stackoverflow.com/a/3309340/6823464
+(def: lex-instant
+  (l;Lexer Instant)
+  (do p;Monad<Parser>
+    [utc-year lex-year
+     _ (l;this "-")
+     utc-month lex-section
+     _ (p;assert "Invalid month."
+                 (and (i.>= 1 utc-month)
+                      (i.<= 12 utc-month)))
+     #let [months (if (leap-year? utc-year)
+                    leap-year-months
+                    normal-months)
+           month-days (|> months
+                          (v;nth (int-to-nat (i.dec utc-month)))
+                          assume)]
+     _ (l;this "-")
+     utc-day lex-section
+     _ (p;assert "Invalid day."
+                 (and (i.>= 1 utc-day)
+                      (i.<= (nat-to-int month-days) utc-day)))
+     _ (l;this "T")
+     utc-hour lex-section
+     _ (p;assert "Invalid hour."
+                 (and (i.>= 0 utc-hour)
+                      (i.<= 23 utc-hour)))
+     _ (l;this ":")
+     utc-minute lex-section
+     _ (p;assert "Invalid minute."
+                 (and (i.>= 0 utc-minute)
+                      (i.<= 59 utc-minute)))
+     _ (l;this ":")
+     utc-second lex-section
+     _ (p;assert "Invalid second."
+                 (and (i.>= 0 utc-second)
+                      (i.<= 59 utc-second)))
+     utc-millis lex-millis
+     _ (l;this "Z")
+     #let [years-since-epoch (i.- epoch-year utc-year)
+           previous-leap-days (i.- (leap-years epoch-year)
+                                   (leap-years (i.dec utc-year)))
+           year-days-so-far (|> (i.* 365 years-since-epoch)
+                                (i.+ previous-leap-days))
+           month-days-so-far (|> months
+                                 v;to-list
+                                 (list;take (int-to-nat (i.dec utc-month)))
+                                 (L/fold n.+ +0))
+           total-days (|> year-days-so-far
+                          (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))))))
+
+(def: (decode input)
+  (-> Text (R;Result Instant))
+  (l;run input lex-instant))
+
+(struct: #export _
+  {#;doc "Based on ISO 8601.
+
+          For example: 2017-01-15T21:14:51.827Z"}
+  (Codec Text Instant)
+  (def: encode encode)
+  (def: decode decode))
+
+(def: #export now
+  (IO Instant)
+  (io (from-millis (_lux_proc ["io" "current-time"] []))))
-- 
cgit v1.2.3