1 files changed, 147 insertions, 0 deletions
diff --git a/stdlib/source/test/lux/time/date.lux b/stdlib/source/test/lux/time/date.lux
new file mode 100644
index 000000000..d89ccccc8
--- /dev/null
+++ b/stdlib/source/test/lux/time/date.lux
@@ -0,0 +1,147 @@
+(.module:
+  [lux #*
+   [control
+    [monad (#+ Monad do)]
+    pipe]
+   [data
+    ["." error]]
+   [math
+    ["r" random ("random/." monad)]]
+   [time
+    ["@." instant]
+    ["@" date]]]
+  lux/test
+  [//
+   ["_." instant]])
+
+(def: month
+  (r.Random @.Month)
+  (r.either (r.either (r.either (random/wrap #@.January)
+                                (r.either (random/wrap #@.February)
+                                          (random/wrap #@.March)))
+                      (r.either (random/wrap #@.April)
+                                (r.either (random/wrap #@.May)
+                                          (random/wrap #@.June))))
+            (r.either (r.either (random/wrap #@.July)
+                                (r.either (random/wrap #@.August)
+                                          (random/wrap #@.September)))
+                      (r.either (random/wrap #@.October)
+                                (r.either (random/wrap #@.November)
+                                          (random/wrap #@.December))))))
+
+(context: "(Month) Equivalence."
+  (<| (times 100)
+      (do @
+        [sample month
+         #let [(^open "@/.") @.equivalence]]
+        (test "Every value equals itself."
+              (@/= sample sample)))))
+
+(context: "(Month) Order."
+  (<| (times 100)
+      (do @
+        [reference month
+         sample month
+         #let [(^open "@/.") @.order]]
+        (test "Valid Order."
+              (and (or (@/< reference sample)
+                       (@/>= reference sample))
+                   (or (@/> reference sample)
+                       (@/<= reference sample)))))))
+
+(context: "(Month) Enum."
+  (<| (times 100)
+      (do @
+        [sample month
+         #let [(^open "@/.") @.enum]]
+        (test "Valid Enum."
+              (and (not (@/= (@/succ sample)
+                             sample))
+                   (not (@/= (@/pred sample)
+                             sample))
+                   (|> sample @/succ @/pred (@/= sample))
+                   (|> sample @/pred @/succ (@/= sample)))))))
+
+(def: day
+  (r.Random @.Day)
+  (r.either (r.either (r.either (random/wrap #@.Sunday)
+                                (random/wrap #@.Monday))
+                      (r.either (random/wrap #@.Tuesday)
+                                (random/wrap #@.Wednesday)))
+            (r.either (r.either (random/wrap #@.Thursday)
+                                (random/wrap #@.Friday))
+                      (random/wrap #@.Saturday))))
+
+(context: "(Day) Equivalence."
+  (<| (times 100)
+      (do @
+        [sample day
+         #let [(^open "@/.") @.equivalence]]
+        (test "Every value equals itself."
+              (@/= sample sample)))))
+
+(context: "(Day) Order."
+  (<| (times 100)
+      (do @
+        [reference day
+         sample day
+         #let [(^open "@/.") @.order]]
+        (test "Valid Order."
+              (and (or (@/< reference sample)
+                       (@/>= reference sample))
+                   (or (@/> reference sample)
+                       (@/<= reference sample)))))))
+
+(context: "(Day) Enum."
+  (<| (times 100)
+      (do @
+        [sample day
+         #let [(^open "@/.") @.enum]]
+        (test "Valid Enum."
+              (and (not (@/= (@/succ sample)
+                             sample))
+                   (not (@/= (@/pred sample)
+                             sample))
+                   (|> sample @/succ @/pred (@/= sample))
+                   (|> sample @/pred @/succ (@/= sample)))))))
+
+(def: #export date
+  (r.Random @.Date)
+  (|> _instant.instant (:: r.monad map @instant.date)))
+
+(context: "(Date) Equivalence."
+  (<| (times 100)
+      (do @
+        [sample date
+         #let [(^open "@/.") @.equivalence]]
+        (test "Every value equals itself."
+              (@/= sample sample)))))
+
+(context: "(Date) Order."
+  (<| (times 100)
+      (do @
+        [reference date
+         sample date
+         #let [(^open "@/.") @.order]]
+        (test "Valid Order."
+              (and (or (@/< reference sample)
+                       (@/>= reference sample))
+                   (or (@/> reference sample)
+                       (@/<= reference sample)))))))
+
+(context: "(Date) Codec"
+  (<| (seed 6623983470548808292)
+      ## (times 100)
+      (do @
+        [sample date
+         #let [(^open "@/.") @.equivalence
+               (^open "@/.") @.codec]]
+        (test "Can encode/decode dates."
+              (|> sample
+                  @/encode
+                  @/decode
+                  (case> (#error.Success decoded)
+                         (@/= sample decoded)
+
+                         (#error.Failure error)
+                         #0))))))