diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/program/aedifex/artifact/time.lux | 23 | ||||
-rw-r--r-- | stdlib/source/program/aedifex/artifact/time/date.lux | 80 |
2 files changed, 75 insertions, 28 deletions
diff --git a/stdlib/source/program/aedifex/artifact/time.lux b/stdlib/source/program/aedifex/artifact/time.lux index 19eb417a5..59367c37d 100644 --- a/stdlib/source/program/aedifex/artifact/time.lux +++ b/stdlib/source/program/aedifex/artifact/time.lux @@ -1,5 +1,6 @@ (.module: [lux #* + ["." time] [abstract [equivalence (#+ Equivalence)] [monad (#+ do)]] @@ -7,29 +8,33 @@ ["<>" parser ["<.>" text (#+ Parser)]]] [data + ["." product] [text - ["%" format (#+ Format)]]] - [time - ["." instant (#+ Instant)]]] + ["%" format (#+ Format)]]]] ["." / #_ ["#." date] ["#." time]]) (type: #export Time - Instant) + [/date.Date /time.Time]) + +(def: #export epoch + Time + [/date.epoch time.midnight]) (def: #export equivalence (Equivalence Time) - instant.equivalence) + (product.equivalence /date.equivalence + time.equivalence)) -(def: #export (format value) +(def: #export (format [date time]) (Format Time) - (%.format (/date.format (instant.date value)) - (/time.format (instant.time value)))) + (%.format (/date.format date) + (/time.format time))) (def: #export parser (Parser Time) (do <>.monad [date /date.parser time /time.parser] - (wrap (instant.from_date_time date time)))) + (wrap [date time]))) diff --git a/stdlib/source/program/aedifex/artifact/time/date.lux b/stdlib/source/program/aedifex/artifact/time/date.lux index 18df2900b..989abb5fc 100644 --- a/stdlib/source/program/aedifex/artifact/time/date.lux +++ b/stdlib/source/program/aedifex/artifact/time/date.lux @@ -1,8 +1,11 @@ (.module: [lux #* [abstract - [monad (#+ do)]] + [monad (#+ do)] + [equivalence (#+ Equivalence)]] [control + ["." try (#+ Try)] + ["." exception (#+ exception:)] ["<>" parser ["<.>" text (#+ Parser)]]] [data @@ -10,11 +13,14 @@ ["%" format]]] [math [number - ["n" nat]]] + ["n" nat] + ["i" int]]] [time - ["." date (#+ Date)] + ["." date ("#\." equivalence)] ["." year] - ["." month]]]) + ["." month]] + [type + abstract]]) (def: #export (pad value) (-> Nat Text) @@ -22,18 +28,54 @@ (%.format "0" (%.nat value)) (%.nat value))) -(def: #export (format value) - (%.Format Date) - (%.format (|> value date.year year.value .nat %.nat) - (|> value date.month month.number ..pad) - (|> value date.day_of_month ..pad))) - -(def: #export parser - (Parser Date) - (do <>.monad - [year (<>.codec n.decimal (<text>.exactly 4 <text>.decimal)) - year (<>.lift (year.year (.int year))) - month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal)) - month (<>.lift (month.by_number month)) - day_of_month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))] - (<>.lift (date.date year month day_of_month)))) +(def: min_year +1,000) +(def: max_year +9,999) + +(exception: #export (year_is_out_of_range {year year.Year}) + (exception.report + ["Minimum" (%.int ..min_year)] + ["Maximum" (%.int ..max_year)] + ["Year" (%.int (year.value year))])) + +(abstract: #export Date + date.Date + + (def: #export epoch + Date + (:abstraction date.epoch)) + + (def: #export (date raw) + (-> date.Date (Try Date)) + (let [year (|> raw date.year year.value)] + (if (and (i.>= ..min_year year) + (i.<= ..max_year year)) + (#try.Success (:abstraction raw)) + (exception.throw ..year_is_out_of_range [(date.year raw)])))) + + (def: #export value + (-> Date date.Date) + (|>> :representation)) + + (structure: #export equivalence + (Equivalence Date) + + (def: (= reference subject) + (date\= (:representation reference) + (:representation subject)))) + + (def: #export (format value) + (%.Format Date) + (%.format (|> value :representation date.year year.value .nat %.nat) + (|> value :representation date.month month.number ..pad) + (|> value :representation date.day_of_month ..pad))) + + (def: #export parser + (Parser Date) + (do <>.monad + [year (<>.codec n.decimal (<text>.exactly 4 <text>.decimal)) + year (<>.lift (year.year (.int year))) + month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal)) + month (<>.lift (month.by_number month)) + day_of_month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal)) + date (<>.lift (date.date year month day_of_month))] + (wrap (:abstraction date))))) |