diff options
Diffstat (limited to 'stdlib/source/lux/time/year.lux')
-rw-r--r-- | stdlib/source/lux/time/year.lux | 97 |
1 files changed, 88 insertions, 9 deletions
diff --git a/stdlib/source/lux/time/year.lux b/stdlib/source/lux/time/year.lux index 0ba2025c6..43e2181ab 100644 --- a/stdlib/source/lux/time/year.lux +++ b/stdlib/source/lux/time/year.lux @@ -1,19 +1,57 @@ (.module: [lux #* + [abstract + [monad (#+ do)] + [codec (#+ Codec)] + [equivalence (#+ Equivalence)] + [order (#+ Order)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)] + ["<>" parser + ["<t>" text (#+ Parser)]]] [data + ["." text ("#@." monoid)] [number - ["n" nat] - ["i" int]]]]) + ["n" nat ("#@." decimal)] + ["i" int ("#@." decimal)]]] + [type + abstract]]) -(type: #export Year - Int) +(def: (internal year) + (-> Int Int) + (if (i.< +0 year) + (inc year) + year)) + +(def: (external year) + (-> Int Int) + (if (i.> +0 year) + year + (dec year))) + +(exception: #export there-is-no-year-0) + +(abstract: #export Year + Int + + (def: #export (year value) + (-> Int (Try Year)) + (case value + +0 (exception.throw ..there-is-no-year-0 []) + _ (#try.Success (:abstraction (..internal value))))) + + (def: #export value + (-> Year Int) + (|>> :representation ..external)) + ) (def: #export days 365) (def: #export epoch Year - +1970) + (try.assume (..year +1970))) (type: #export Period Nat) @@ -35,9 +73,10 @@ ## https://en.wikipedia.org/wiki/Leap_year#Algorithm (def: #export (leap? year) (-> Year Bit) - (and (..divisible? (.int ..leap) year) - (or (not (..divisible? (.int ..century) year)) - (..divisible? (.int ..era) year)))) + (let [year (|> year ..value ..internal)] + (and (..divisible? (.int ..leap) year) + (or (not (..divisible? (.int ..century) year)) + (..divisible? (.int ..era) year))))) (def: (with-year-0-leap year days) (let [after-year-0? (i.> +0 year)] @@ -47,7 +86,8 @@ (def: #export (leaps year) (-> Year Int) - (let [limit (if (i.> +0 year) + (let [year (|> year ..value ..internal) + limit (if (i.> +0 year) (dec year) (inc year))] (`` (|> +0 @@ -59,3 +99,42 @@ [i.+ ..era] )) (..with-year-0-leap year))))) + +(def: (encode year) + (-> Year Text) + (let [year (..value year)] + (if (i.< +0 year) + (i@encode year) + (n@encode (.nat year))))) + +(def: #export parser + (Parser Year) + (do {@ <>.monad} + [sign (<>.or (<t>.this "-") (wrap [])) + digits (<t>.many <t>.decimal) + raw-year (<>.codec i.decimal (wrap (text@compose "+" digits)))] + (<>.lift (..year (case sign + (#.Left _) (i.* -1 raw-year) + (#.Right _) raw-year))))) + +(structure: #export codec + {#.doc (doc "Based on ISO 8601." + "For example: 2017")} + (Codec Text Year) + + (def: encode ..encode) + (def: decode (<t>.run ..parser))) + +(structure: #export equivalence + (Equivalence Year) + + (def: (= reference subject) + (i.= (..value reference) (..value subject)))) + +(structure: #export order + (Order Year) + + (def: &equivalence ..equivalence) + + (def: (< reference subject) + (i.< (..value reference) (..value subject)))) |