1 files changed, 189 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/world/time/day.lux b/stdlib/source/library/lux/world/time/day.lux
new file mode 100644
index 000000000..4f1570d43
--- /dev/null
+++ b/stdlib/source/library/lux/world/time/day.lux
@@ -0,0 +1,189 @@
+(.require
+ [library
+  [lux (.except nat)
+   [abstract
+    [equivalence (.only Equivalence)]
+    [hash (.only Hash)]
+    [order (.only Order)]
+    [enum (.only Enum)]
+    [codec (.only Codec)]]
+   [control
+    ["[0]" try (.only Try)]
+    ["[0]" exception (.only exception)]]
+   [data
+    ["[0]" text (.use "[1]#[0]" monoid)]]
+   [math
+    [number
+     ["n" nat]]]
+   [meta
+    [macro
+     ["^" pattern]
+     ["[0]" template]]]]])
+
+(type .public Day
+  (Variant
+   {#Sunday}
+   {#Monday}
+   {#Tuesday}
+   {#Wednesday}
+   {#Thursday}
+   {#Friday}
+   {#Saturday}))
+
+(def .public equivalence
+  (Equivalence Day)
+  (implementation
+   (def (= reference sample)
+     (case [reference sample]
+       (^.with_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))
+
+(def .public order
+  (Order Day)
+  (implementation
+   (def equivalence ..equivalence)
+   
+   (def (< reference sample)
+     (n.< (..nat reference) (..nat sample)))))
+
+(def .public enum
+  (Enum Day)
+  (implementation
+   (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 .public (not_a_day_of_the_week [value Text])
+  (exception.report
+   (list ["Value" (text.format value)])))
+
+(def .public codec
+  (Codec Text Day)
+  (implementation
+   (def (encoded value)
+     (case value
+       (^.with_template [<tag>]
+         [{<tag>}
+          (text.replaced "#" "" (template.text [<tag>]))])
+       ([..#Monday]
+        [..#Tuesday]
+        [..#Wednesday]
+        [..#Thursday]
+        [..#Friday]
+        [..#Saturday]
+        [..#Sunday])))
+   (def (decoded value)
+     (case (text#composite "#" value)
+       (^.with_template [<tag>]
+         [(template.text [<tag>])
+          {try.#Success {<tag>}}])
+       ([..#Monday]
+        [..#Tuesday]
+        [..#Wednesday]
+        [..#Thursday]
+        [..#Friday]
+        [..#Saturday]
+        [..#Sunday])
+       _ (exception.except ..not_a_day_of_the_week [value])))))
+
+(def .public week
+  (List Day)
+  (list {#Sunday}
+        {#Monday}
+        {#Tuesday}
+        {#Wednesday}
+        {#Thursday}
+        {#Friday}
+        {#Saturday}))
+
+(with_expansions [<pairs> (these [01 #Sunday]
+                                 [02 #Monday]
+                                 [03 #Tuesday]
+                                 [04 #Wednesday]
+                                 [05 #Thursday]
+                                 [06 #Friday]
+                                 [07 #Saturday])]
+  (def .public (number day)
+    (-> Day Nat)
+    (case day
+      (^.with_template [<number> <day>]
+        [{<day>}
+         <number>])
+      (<pairs>)))
+
+  (exception .public (invalid_day [number Nat])
+    (exception.report
+     (list ["Number" (at n.decimal encoded number)]
+           ["Valid range" (all "lux text concat"
+                               (at n.decimal encoded (..number {#Sunday}))
+                               " ~ "
+                               (at n.decimal encoded (..number {#Saturday})))])))
+
+  (def .public (by_number number)
+    (-> Nat (Try Day))
+    (case number
+      (^.with_template [<number> <day>]
+        [<number>
+         {try.#Success {<day>}}])
+      (<pairs>)
+      
+      _
+      (exception.except ..invalid_day [number])))
+  )
+
+(def .public hash
+  (Hash Day)
+  (implementation
+   (def equivalence ..equivalence)
+   (def (hash day)
+     (case day
+       (^.with_template [<prime> <day>]
+         [{<day>}
+          <prime>])
+       ([02 #Sunday]
+        [03 #Monday]
+        [05 #Tuesday]
+        [07 #Wednesday]
+        [11 #Thursday]
+        [13 #Friday]
+        [17 #Saturday])))))