1 files changed, 121 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/time/day.lux b/stdlib/source/library/lux/time/day.lux
new file mode 100644
index 000000000..157dd6c1f
--- /dev/null
+++ b/stdlib/source/library/lux/time/day.lux
@@ -0,0 +1,121 @@
+(.module:
+  [library
+   [lux (#- nat)
+    [abstract
+     [equivalence (#+ Equivalence)]
+     [order (#+ Order)]
+     [enum (#+ Enum)]
+     [codec (#+ Codec)]]
+    [control
+     ["." try]
+     ["." exception (#+ exception:)]]
+    [data
+     ["." text]]
+    [macro
+     ["." template]]
+    [math
+     [number
+      ["n" nat]]]]])
+
+(type: #export Day
+  #Sunday
+  #Monday
+  #Tuesday
+  #Wednesday
+  #Thursday
+  #Friday
+  #Saturday)
+
+(implementation: #export equivalence
+  (Equivalence Day)
+  
+  (def: (= reference sample)
+    (case [reference sample]
+      (^template [<tag>]
+        [[<tag> <tag>]
+         #1])
+      ([#Sunday]
+       [#Monday]
+       [#Tuesday]
+       [#Wednesday]
+       [#Thursday]
+       [#Friday]
+       [#Saturday])
+
+      _
+      #0)))
+
+(def: (nat day)
+  (-> Day Nat)
+  (case day
+    #Sunday    0
+    #Monday    1
+    #Tuesday   2
+    #Wednesday 3
+    #Thursday  4
+    #Friday    5
+    #Saturday  6))
+
+(implementation: #export order
+  (Order Day)
+  
+  (def: &equivalence ..equivalence)
+  
+  (def: (< reference sample)
+    (n.< (..nat reference) (..nat sample))))
+
+(implementation: #export enum
+  (Enum Day)
+  
+  (def: &order ..order)
+  
+  (def: (succ day)
+    (case day
+      #Sunday    #Monday
+      #Monday    #Tuesday
+      #Tuesday   #Wednesday
+      #Wednesday #Thursday
+      #Thursday  #Friday
+      #Friday    #Saturday
+      #Saturday  #Sunday))
+  
+  (def: (pred day)
+    (case day
+      #Monday    #Sunday
+      #Tuesday   #Monday
+      #Wednesday #Tuesday
+      #Thursday  #Wednesday
+      #Friday    #Thursday
+      #Saturday  #Friday
+      #Sunday    #Saturday)))
+
+(exception: #export (not_a_day_of_the_week {value Text})
+  (exception.report
+   ["Value" (text.format value)]))
+
+(implementation: #export codec
+  (Codec Text Day)
+  
+  (def: (encode value)
+    (case value
+      (^template [<tag>]
+        [<tag> (template.text [<tag>])])
+      ([#..Monday]
+       [#..Tuesday]
+       [#..Wednesday]
+       [#..Thursday]
+       [#..Friday]
+       [#..Saturday]
+       [#..Sunday])))
+  (def: (decode value)
+    (case value
+      (^template [<tag>]
+        [(^ (template.text [<tag>])) (#try.Success <tag>)])
+      ([#..Monday]
+       [#..Tuesday]
+       [#..Wednesday]
+       [#..Thursday]
+       [#..Friday]
+       [#..Saturday]
+       [#..Sunday])
+      _ (exception.throw ..not_a_day_of_the_week [value]))))