Constraining the year of the snapshot time in Aedifex.

5 files changed, 92 insertions, 51 deletions

diff --git a/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux b/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux
index ca59b11a6..f321e11c1 100644
--- a/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux
+++ b/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux
@@ -42,11 +42,6 @@
   (list (..time_format time)
         (//build.format build)))
 
-## (exception: #export (mismatch {expected Instant} {actual Instant})
-##   (exception.report
-##    ["Expected" (%.instant expected)]
-##    ["Actual" (%.instant actual)]))
-
 (def: time_parser
   (Parser Time)
   (do <>.monad
diff --git a/stdlib/source/program/aedifex/artifact/snapshot/time.lux b/stdlib/source/program/aedifex/artifact/snapshot/time.lux
index ea9bf3047..e0cb8c112 100644
--- a/stdlib/source/program/aedifex/artifact/snapshot/time.lux
+++ b/stdlib/source/program/aedifex/artifact/snapshot/time.lux
@@ -16,30 +16,30 @@
    [time
     ["." instant (#+ Instant)]]]
   ["." /// #_
-   [time
-    ["#." date]
-    ["#." time]]])
+   ["#." time
+    ["#/." date]
+    ["#/." time]]])
 
 (type: #export Time
-  Instant)
+  ///time.Time)
 
 (def: #export equivalence
   (Equivalence Time)
-  instant.equivalence)
+  ///time.equivalence)
 
 (def: separator
   ".")
 
-(def: #export (format value)
+(def: #export (format [date time])
   (%.Format Time)
-  (%.format (///date.format (instant.date value))
+  (%.format (///time/date.format date)
             ..separator
-            (///time.format (instant.time value))))
+            (///time/time.format time)))
 
 (def: #export parser
   (<text>.Parser Time)
   (do <>.monad
-    [date ///date.parser
+    [date ///time/date.parser
      _ (<text>.this ..separator)
-     time ///time.parser]
-    (wrap (instant.from_date_time date time))))
+     time ///time/time.parser]
+    (wrap [date time])))
diff --git a/stdlib/source/program/aedifex/artifact/time.lux b/stdlib/source/program/aedifex/artifact/time.lux
index 19eb417a5..59367c37d 100644
--- a/stdlib/source/program/aedifex/artifact/time.lux
+++ b/stdlib/source/program/aedifex/artifact/time.lux
@@ -1,5 +1,6 @@
 (.module:
   [lux #*
+   ["." time]
    [abstract
     [equivalence (#+ Equivalence)]
     [monad (#+ do)]]
@@ -7,29 +8,33 @@
     ["<>" parser
      ["<.>" text (#+ Parser)]]]
    [data
+    ["." product]
     [text
-     ["%" format (#+ Format)]]]
-   [time
-    ["." instant (#+ Instant)]]]
+     ["%" format (#+ Format)]]]]
   ["." / #_
    ["#." date]
    ["#." time]])
 
 (type: #export Time
-  Instant)
+  [/date.Date /time.Time])
+
+(def: #export epoch
+  Time
+  [/date.epoch time.midnight])
 
 (def: #export equivalence
   (Equivalence Time)
-  instant.equivalence)
+  (product.equivalence /date.equivalence
+                       time.equivalence))
 
-(def: #export (format value)
+(def: #export (format [date time])
   (Format Time)
-  (%.format (/date.format (instant.date value))
-            (/time.format (instant.time value))))
+  (%.format (/date.format date)
+            (/time.format time)))
 
 (def: #export parser
   (Parser Time)
   (do <>.monad
     [date /date.parser
      time /time.parser]
-    (wrap (instant.from_date_time date time))))
+    (wrap [date time])))
diff --git a/stdlib/source/program/aedifex/artifact/time/date.lux b/stdlib/source/program/aedifex/artifact/time/date.lux
index 18df2900b..989abb5fc 100644
--- a/stdlib/source/program/aedifex/artifact/time/date.lux
+++ b/stdlib/source/program/aedifex/artifact/time/date.lux
@@ -1,8 +1,11 @@
 (.module:
   [lux #*
    [abstract
-    [monad (#+ do)]]
+    [monad (#+ do)]
+    [equivalence (#+ Equivalence)]]
    [control
+    ["." try (#+ Try)]
+    ["." exception (#+ exception:)]
     ["<>" parser
      ["<.>" text (#+ Parser)]]]
    [data
@@ -10,11 +13,14 @@
      ["%" format]]]
    [math
     [number
-     ["n" nat]]]
+     ["n" nat]
+     ["i" int]]]
    [time
-    ["." date (#+ Date)]
+    ["." date ("#\." equivalence)]
     ["." year]
-    ["." month]]])
+    ["." month]]
+   [type
+    abstract]])
 
 (def: #export (pad value)
   (-> Nat Text)
@@ -22,18 +28,54 @@
     (%.format "0" (%.nat value))
     (%.nat value)))
 
-(def: #export (format value)
-  (%.Format Date)
-  (%.format (|> value date.year year.value .nat %.nat)
-            (|> value date.month month.number ..pad)
-            (|> value date.day_of_month ..pad)))
-
-(def: #export parser
-  (Parser Date)
-  (do <>.monad
-    [year (<>.codec n.decimal (<text>.exactly 4 <text>.decimal))
-     year (<>.lift (year.year (.int year)))
-     month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))
-     month (<>.lift (month.by_number month))
-     day_of_month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))]
-    (<>.lift (date.date year month day_of_month))))
+(def: min_year +1,000)
+(def: max_year +9,999)
+
+(exception: #export (year_is_out_of_range {year year.Year})
+  (exception.report
+   ["Minimum" (%.int ..min_year)]
+   ["Maximum" (%.int ..max_year)]
+   ["Year" (%.int (year.value year))]))
+
+(abstract: #export Date
+  date.Date
+
+  (def: #export epoch
+    Date
+    (:abstraction date.epoch))
+
+  (def: #export (date raw)
+    (-> date.Date (Try Date))
+    (let [year (|> raw date.year year.value)]
+      (if (and (i.>= ..min_year year)
+               (i.<= ..max_year year))
+        (#try.Success (:abstraction raw))
+        (exception.throw ..year_is_out_of_range [(date.year raw)]))))
+
+  (def: #export value
+    (-> Date date.Date)
+    (|>> :representation))
+
+  (structure: #export equivalence
+    (Equivalence Date)
+
+    (def: (= reference subject)
+      (date\= (:representation reference)
+              (:representation subject))))
+
+  (def: #export (format value)
+    (%.Format Date)
+    (%.format (|> value :representation date.year year.value .nat %.nat)
+              (|> value :representation date.month month.number ..pad)
+              (|> value :representation date.day_of_month ..pad)))
+
+  (def: #export parser
+    (Parser Date)
+    (do <>.monad
+      [year (<>.codec n.decimal (<text>.exactly 4 <text>.decimal))
+       year (<>.lift (year.year (.int year)))
+       month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))
+       month (<>.lift (month.by_number month))
+       day_of_month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))
+       date (<>.lift (date.date year month day_of_month))]
+      (wrap (:abstraction date)))))
diff --git a/stdlib/source/program/aedifex/artifact/versioning.lux b/stdlib/source/program/aedifex/artifact/versioning.lux
index dab943145..a16d92796 100644
--- a/stdlib/source/program/aedifex/artifact/versioning.lux
+++ b/stdlib/source/program/aedifex/artifact/versioning.lux
@@ -21,7 +21,6 @@
     [number
      ["n" nat]]]
    ["." time (#+ Time)
-    ["." instant (#+ Instant)]
     ["." date (#+ Date)]
     ["." year]
     ["." month]]]
@@ -32,19 +31,19 @@
 
 (type: #export Versioning
   {#snapshot Snapshot
-   #last_updated Instant
+   #last_updated //time.Time
    #versions (List Version)})
 
 (def: #export init
   {#snapshot #//snapshot.Local
-   #last_updated instant.epoch
+   #last_updated //time.epoch
    #versions (list)})
 
 (def: #export equivalence
   (Equivalence Versioning)
   ($_ product.equivalence
       //snapshot.equivalence
-      instant.equivalence
+      //time.equivalence
       (list.equivalence //snapshot/version.equivalence)
       ))
 
@@ -58,7 +57,7 @@
   )
 
 (def: format_last_updated
-  (-> Instant XML)
+  (-> //time.Time XML)
   (|>> //time.format #xml.Text list (#xml.Node ..<last_updated> xml.attributes)))
 
 (def: #export (format (^slots [#snapshot #last_updated #versions]))
@@ -81,7 +80,7 @@
   (..sub tag <xml>.text))
 
 (def: last_updated_parser
-  (Parser Instant)
+  (Parser //time.Time)
   (<text>.embed //time.parser
                 (..text ..<last_updated>)))
 
@@ -90,7 +89,7 @@
   (<| (..sub ..<versioning>)
       ($_ <>.and
           (<>.default #//snapshot.Local (<xml>.somewhere //snapshot.parser))
-          (<>.default instant.epoch (<xml>.somewhere ..last_updated_parser))
+          (<>.default //time.epoch (<xml>.somewhere ..last_updated_parser))
           (<| (<>.default (list))
               <xml>.somewhere
               (..sub ..<snapshot_versions>)