diff options
Diffstat (limited to 'stdlib/source/library/lux/world/time/month.lux')
| -rw-r--r-- | stdlib/source/library/lux/world/time/month.lux | 252 |
1 files changed, 252 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/world/time/month.lux b/stdlib/source/library/lux/world/time/month.lux new file mode 100644 index 000000000..c2e88c976 --- /dev/null +++ b/stdlib/source/library/lux/world/time/month.lux @@ -0,0 +1,252 @@ +(.require + [library + [lux (.except) + [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 Month + (Variant + {#January} + {#February} + {#March} + {#April} + {#May} + {#June} + {#July} + {#August} + {#September} + {#October} + {#November} + {#December})) + +(def .public equivalence + (Equivalence Month) + (implementation + (def (= reference sample) + (case [reference sample] + (^.with_template [<tag>] + [[{<tag>} {<tag>}] + true]) + ([#January] + [#February] + [#March] + [#April] + [#May] + [#June] + [#July] + [#August] + [#September] + [#October] + [#November] + [#December]) + + _ + false)))) + +(with_expansions [<pairs> (these [01 #January] + [02 #February] + [03 #March] + [04 #April] + [05 #May] + [06 #June] + [07 #July] + [08 #August] + [09 #September] + [10 #October] + [11 #November] + [12 #December])] + (def .public (number month) + (-> Month Nat) + (case month + (^.with_template [<number> <month>] + [{<month>} + <number>]) + (<pairs>))) + + (exception .public (invalid_month [number Nat]) + (exception.report + (list ["Number" (at n.decimal encoded number)] + ["Valid range" (all "lux text concat" + (at n.decimal encoded (..number {#January})) + " ~ " + (at n.decimal encoded (..number {#December})))]))) + + (def .public (by_number number) + (-> Nat (Try Month)) + (case number + (^.with_template [<number> <month>] + [<number> + {try.#Success {<month>}}]) + (<pairs>) + + _ + (exception.except ..invalid_month [number]))) + ) + +(def .public hash + (Hash Month) + (implementation + (def equivalence ..equivalence) + (def (hash month) + (case month + (^.with_template [<prime> <month>] + [{<month>} + <prime>]) + ([02 #January] + [03 #February] + [05 #March] + [07 #April] + [11 #May] + [13 #June] + [17 #July] + [19 #August] + [23 #September] + [29 #October] + [31 #November] + [37 #December]))))) + +(def .public order + (Order Month) + (implementation + (def equivalence ..equivalence) + + (def (< reference sample) + (n.< (..number reference) + (..number sample))))) + +(def .public enum + (Enum Month) + (implementation + (def order ..order) + + (def (succ month) + (case month + {#January} {#February} + {#February} {#March} + {#March} {#April} + {#April} {#May} + {#May} {#June} + {#June} {#July} + {#July} {#August} + {#August} {#September} + {#September} {#October} + {#October} {#November} + {#November} {#December} + {#December} {#January})) + + (def (pred month) + (case month + {#February} {#January} + {#March} {#February} + {#April} {#March} + {#May} {#April} + {#June} {#May} + {#July} {#June} + {#August} {#July} + {#September} {#August} + {#October} {#September} + {#November} {#October} + {#December} {#November} + {#January} {#December})))) + +(def .public (days month) + (-> Month Nat) + (case month + (^.with_template [<days> <month>] + [{<month>} + <days>]) + ([31 #January] + [28 #February] + [31 #March] + + [30 #April] + [31 #May] + [30 #June] + + [31 #July] + [31 #August] + [30 #September] + + [31 #October] + [30 #November] + [31 #December]))) + +(def .public (leap_year_days month) + (-> Month Nat) + (case month + {#February} (++ (..days month)) + _ (..days month))) + +(def .public year + (List Month) + (list {#January} + {#February} + {#March} + {#April} + {#May} + {#June} + {#July} + {#August} + {#September} + {#October} + {#November} + {#December})) + +(exception .public (not_a_month_of_the_year [value Text]) + (exception.report + (list ["Value" (text.format value)]))) + +(def .public codec + (Codec Text Month) + (implementation + (def (encoded value) + (case value + (^.with_template [<tag>] + [{<tag>} + (text.replaced "#" "" (template.text [<tag>]))]) + ([..#January] + [..#February] + [..#March] + [..#April] + [..#May] + [..#June] + [..#July] + [..#August] + [..#September] + [..#October] + [..#November] + [..#December]))) + (def (decoded value) + (case (text#composite "#" value) + (^.with_template [<tag>] + [(template.text [<tag>]) + {try.#Success {<tag>}}]) + ([..#January] + [..#February] + [..#March] + [..#April] + [..#May] + [..#June] + [..#July] + [..#August] + [..#September] + [..#October] + [..#November] + [..#December]) + _ (exception.except ..not_a_month_of_the_year [value]))))) |