From f7880ce83ba82ada2d04a0c587448446e677d458 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 6 Jul 2022 17:11:35 -0400 Subject: Moved "lux/time" to "lux/world/time". --- lux-scheme/source/program.lux | 6 +- stdlib/source/documentation/lux.lux | 2 - stdlib/source/documentation/lux/time.lux | 71 ----- stdlib/source/documentation/lux/time/date.lux | 38 --- stdlib/source/documentation/lux/time/day.lux | 30 -- stdlib/source/documentation/lux/time/duration.lux | 47 --- stdlib/source/documentation/lux/time/instant.lux | 56 ---- stdlib/source/documentation/lux/time/month.lux | 38 --- stdlib/source/documentation/lux/time/year.lux | 48 --- stdlib/source/documentation/lux/world.lux | 6 +- stdlib/source/documentation/lux/world/time.lux | 71 +++++ .../source/documentation/lux/world/time/date.lux | 38 +++ stdlib/source/documentation/lux/world/time/day.lux | 30 ++ .../documentation/lux/world/time/duration.lux | 47 +++ .../documentation/lux/world/time/instant.lux | 56 ++++ .../source/documentation/lux/world/time/month.lux | 38 +++ .../source/documentation/lux/world/time/year.lux | 48 +++ stdlib/source/format/lux/data/text.lux | 15 +- .../library/lux/control/concurrency/thread.lux | 5 +- stdlib/source/library/lux/control/remember.lux | 7 +- stdlib/source/library/lux/data/format/tar.lux | 8 +- stdlib/source/library/lux/debug.lux | 13 +- stdlib/source/library/lux/math/random.lux | 13 +- .../library/lux/meta/compiler/meta/export.lux | 6 +- .../lux/meta/compiler/meta/packager/scheme.lux | 6 +- stdlib/source/library/lux/meta/compiler/phase.lux | 7 +- stdlib/source/library/lux/test.lux | 8 +- stdlib/source/library/lux/time.lux | 215 ------------- stdlib/source/library/lux/time/date.lux | 353 --------------------- stdlib/source/library/lux/time/day.lux | 189 ----------- stdlib/source/library/lux/time/duration.lux | 202 ------------ stdlib/source/library/lux/time/instant.lux | 230 -------------- stdlib/source/library/lux/time/month.lux | 252 --------------- stdlib/source/library/lux/time/year.lux | 143 --------- stdlib/source/library/lux/world/db/jdbc/input.lux | 6 +- stdlib/source/library/lux/world/db/jdbc/output.lux | 6 +- stdlib/source/library/lux/world/file.lux | 9 +- stdlib/source/library/lux/world/file/watch.lux | 7 +- .../source/library/lux/world/net/http/cookie.lux | 5 +- stdlib/source/library/lux/world/time.lux | 215 +++++++++++++ stdlib/source/library/lux/world/time/date.lux | 353 +++++++++++++++++++++ stdlib/source/library/lux/world/time/day.lux | 189 +++++++++++ stdlib/source/library/lux/world/time/duration.lux | 202 ++++++++++++ stdlib/source/library/lux/world/time/instant.lux | 230 ++++++++++++++ stdlib/source/library/lux/world/time/month.lux | 252 +++++++++++++++ stdlib/source/library/lux/world/time/year.lux | 143 +++++++++ .../source/polytypic/lux/abstract/equivalence.lux | 13 +- stdlib/source/polytypic/lux/data/format/json.lux | 13 +- .../program/aedifex/artifact/snapshot/time.lux | 5 +- stdlib/source/program/aedifex/artifact/time.lux | 5 +- .../source/program/aedifex/artifact/time/date.lux | 14 +- .../source/program/aedifex/artifact/versioning.lux | 9 +- .../program/aedifex/dependency/deployment.lux | 5 +- .../source/program/aedifex/metadata/artifact.lux | 12 +- .../source/program/aedifex/metadata/snapshot.lux | 12 +- stdlib/source/program/compositor.lux | 6 +- stdlib/source/specification/lux/world/file.lux | 5 +- .../test/aedifex/artifact/snapshot/stamp.lux | 5 +- stdlib/source/test/aedifex/artifact/time.lux | 5 +- stdlib/source/test/aedifex/command/auto.lux | 6 +- stdlib/source/test/aedifex/metadata/artifact.lux | 14 +- stdlib/source/test/aedifex/metadata/snapshot.lux | 14 +- stdlib/source/test/lux.lux | 2 - .../source/test/lux/control/concurrency/async.lux | 7 +- .../source/test/lux/control/concurrency/thread.lux | 9 +- stdlib/source/test/lux/control/function/memo.lux | 7 +- stdlib/source/test/lux/control/remember.lux | 9 +- stdlib/source/test/lux/data/format/json.lux | 13 +- stdlib/source/test/lux/data/format/tar.lux | 7 +- stdlib/source/test/lux/data/text.lux | 13 +- stdlib/source/test/lux/debug.lux | 13 +- stdlib/source/test/lux/time.lux | 157 --------- stdlib/source/test/lux/time/date.lux | 95 ------ stdlib/source/test/lux/time/day.lux | 89 ------ stdlib/source/test/lux/time/duration.lux | 100 ------ stdlib/source/test/lux/time/instant.lux | 106 ------- stdlib/source/test/lux/time/month.lux | 101 ------ stdlib/source/test/lux/time/year.lux | 97 ------ stdlib/source/test/lux/world.lux | 4 +- stdlib/source/test/lux/world/file.lux | 5 +- stdlib/source/test/lux/world/time.lux | 157 +++++++++ stdlib/source/test/lux/world/time/date.lux | 95 ++++++ stdlib/source/test/lux/world/time/day.lux | 89 ++++++ stdlib/source/test/lux/world/time/duration.lux | 100 ++++++ stdlib/source/test/lux/world/time/instant.lux | 106 +++++++ stdlib/source/test/lux/world/time/month.lux | 101 ++++++ stdlib/source/test/lux/world/time/year.lux | 97 ++++++ 87 files changed, 2855 insertions(+), 2826 deletions(-) delete mode 100644 stdlib/source/documentation/lux/time.lux delete mode 100644 stdlib/source/documentation/lux/time/date.lux delete mode 100644 stdlib/source/documentation/lux/time/day.lux delete mode 100644 stdlib/source/documentation/lux/time/duration.lux delete mode 100644 stdlib/source/documentation/lux/time/instant.lux delete mode 100644 stdlib/source/documentation/lux/time/month.lux delete mode 100644 stdlib/source/documentation/lux/time/year.lux create mode 100644 stdlib/source/documentation/lux/world/time.lux create mode 100644 stdlib/source/documentation/lux/world/time/date.lux create mode 100644 stdlib/source/documentation/lux/world/time/day.lux create mode 100644 stdlib/source/documentation/lux/world/time/duration.lux create mode 100644 stdlib/source/documentation/lux/world/time/instant.lux create mode 100644 stdlib/source/documentation/lux/world/time/month.lux create mode 100644 stdlib/source/documentation/lux/world/time/year.lux delete mode 100644 stdlib/source/library/lux/time.lux delete mode 100644 stdlib/source/library/lux/time/date.lux delete mode 100644 stdlib/source/library/lux/time/day.lux delete mode 100644 stdlib/source/library/lux/time/duration.lux delete mode 100644 stdlib/source/library/lux/time/instant.lux delete mode 100644 stdlib/source/library/lux/time/month.lux delete mode 100644 stdlib/source/library/lux/time/year.lux create mode 100644 stdlib/source/library/lux/world/time.lux create mode 100644 stdlib/source/library/lux/world/time/date.lux create mode 100644 stdlib/source/library/lux/world/time/day.lux create mode 100644 stdlib/source/library/lux/world/time/duration.lux create mode 100644 stdlib/source/library/lux/world/time/instant.lux create mode 100644 stdlib/source/library/lux/world/time/month.lux create mode 100644 stdlib/source/library/lux/world/time/year.lux delete mode 100644 stdlib/source/test/lux/time.lux delete mode 100644 stdlib/source/test/lux/time/date.lux delete mode 100644 stdlib/source/test/lux/time/day.lux delete mode 100644 stdlib/source/test/lux/time/duration.lux delete mode 100644 stdlib/source/test/lux/time/instant.lux delete mode 100644 stdlib/source/test/lux/time/month.lux delete mode 100644 stdlib/source/test/lux/time/year.lux create mode 100644 stdlib/source/test/lux/world/time.lux create mode 100644 stdlib/source/test/lux/world/time/date.lux create mode 100644 stdlib/source/test/lux/world/time/day.lux create mode 100644 stdlib/source/test/lux/world/time/duration.lux create mode 100644 stdlib/source/test/lux/world/time/instant.lux create mode 100644 stdlib/source/test/lux/world/time/month.lux create mode 100644 stdlib/source/test/lux/world/time/year.lux diff --git a/lux-scheme/source/program.lux b/lux-scheme/source/program.lux index f979336ae..d4744ba40 100644 --- a/lux-scheme/source/program.lux +++ b/lux-scheme/source/program.lux @@ -25,11 +25,11 @@ [number (.only hex) ["n" nat] ["[0]" i64]]] - [time - ["[0]" instant]] ["[0]" world ["[0]" file] - ["[1]/[0]" program]] + ["[1]/[0]" program] + [time + ["[0]" instant]]] ["@" target ["_" scheme]] [meta diff --git a/stdlib/source/documentation/lux.lux b/stdlib/source/documentation/lux.lux index 578bee850..321aebffd 100644 --- a/stdlib/source/documentation/lux.lux +++ b/stdlib/source/documentation/lux.lux @@ -28,7 +28,6 @@ ["[1][0]" program] ["[1][0]" static] ["[1][0]" test] - ["[1][0]" time] ["[1][0]" world]]) (.`` (.def .public documentation @@ -898,7 +897,6 @@ /program.documentation /static.documentation /test.documentation - /time.documentation /world.documentation]))) (program: inputs diff --git a/stdlib/source/documentation/lux/time.lux b/stdlib/source/documentation/lux/time.lux deleted file mode 100644 index f327e942a..000000000 --- a/stdlib/source/documentation/lux/time.lux +++ /dev/null @@ -1,71 +0,0 @@ -(.require - [library - [lux (.except and) - ["$" documentation] - [data - ["[0]" text (.only \n) - ["%" \\format (.only format)]]]]] - [\\library - ["[0]" /]] - ["[0]" / - ["[1][0]" date] - ["[1][0]" day] - ["[1][0]" duration] - ["[1][0]" instant] - ["[1][0]" month] - ["[1][0]" year]]) - -(`` (.def .public documentation - (.List $.Module) - ($.module /._ - "" - [($.default /.time_exceeds_a_day) - ($.default /.invalid_hour) - ($.default /.invalid_minute) - ($.default /.invalid_second) - ($.default /.millis) - ($.default /.equivalence) - ($.default /.order) - ($.default /.enum) - ($.default /.parser) - - (,, (with_template [ ] - [($.documentation - )] - - [/.milli_seconds "Number of milli-seconds in a second."] - [/.seconds "Number of seconds in a minute."] - [/.minutes "Number of minutes in an hour."] - [/.hours "Number of hours in an day."] - )) - - ($.documentation /.Time - "Time is defined as milliseconds since the start of the day (00:00:00.000).") - - ($.documentation /.midnight - "The instant corresponding to the start of the day: 00:00:00.000") - - ($.documentation /.of_millis - "" - [(of_millis milli_seconds)]) - - ($.documentation /.Clock - "A clock marking the specific hour, minute, second, and milli-second in a day.") - - ($.documentation /.clock - "" - [(clock time)]) - - ($.documentation /.time - "" - [(time clock)]) - - ($.documentation /.codec - (format "Based on ISO 8601." - \n "For example: 21:14:51.827"))] - [/date.documentation - /day.documentation - /duration.documentation - /instant.documentation - /month.documentation - /year.documentation]))) diff --git a/stdlib/source/documentation/lux/time/date.lux b/stdlib/source/documentation/lux/time/date.lux deleted file mode 100644 index 17fd0143b..000000000 --- a/stdlib/source/documentation/lux/time/date.lux +++ /dev/null @@ -1,38 +0,0 @@ -(.require - [library - [lux (.except and) - ["$" documentation] - [data - ["[0]" text (.only \n) - ["%" \\format (.only format)]]]]] - [\\library - ["[0]" /]]) - -(.def .public documentation - (.List $.Module) - ($.module /._ - "" - [($.default /.invalid_day) - ($.default /.epoch) - ($.default /.year) - ($.default /.month) - ($.default /.day_of_month) - ($.default /.equivalence) - ($.default /.order) - ($.default /.invalid_month) - ($.default /.parser) - ($.default /.days) - ($.default /.of_days) - ($.default /.enum) - - ($.documentation /.Date - "A date specified as a year/month/day triplet.") - - ($.documentation /.date - "A date, within the allowed limits." - [(date year month day_of_month)]) - - ($.documentation /.codec - (format "Based on ISO 8601." - \n "For example: 2017-01-15"))] - [])) diff --git a/stdlib/source/documentation/lux/time/day.lux b/stdlib/source/documentation/lux/time/day.lux deleted file mode 100644 index e7923dfe0..000000000 --- a/stdlib/source/documentation/lux/time/day.lux +++ /dev/null @@ -1,30 +0,0 @@ -(.require - [library - [lux (.except and) - ["$" documentation] - [data - ["[0]" text (.only \n) - ["%" \\format (.only format)]]]]] - [\\library - ["[0]" /]]) - -(.def .public documentation - (.List $.Module) - ($.module /._ - "" - [($.default /.equivalence) - ($.default /.order) - ($.default /.enum) - ($.default /.not_a_day_of_the_week) - ($.default /.codec) - ($.default /.number) - ($.default /.invalid_day) - ($.default /.by_number) - ($.default /.hash) - - ($.documentation /.Day - "A day of the week.") - - ($.documentation /.week - "All the days, ordered by when they come in a week.")] - [])) diff --git a/stdlib/source/documentation/lux/time/duration.lux b/stdlib/source/documentation/lux/time/duration.lux deleted file mode 100644 index 0b9ddaa0b..000000000 --- a/stdlib/source/documentation/lux/time/duration.lux +++ /dev/null @@ -1,47 +0,0 @@ -(.require - [library - [lux (.except and) - ["$" documentation] - [data - ["[0]" text (.only \n) - ["%" \\format (.only format)]]]]] - [\\library - ["[0]" /]]) - -(.def .public documentation - (.List $.Module) - ($.module /._ - "" - [($.default /.of_millis) - ($.default /.millis) - ($.default /.composite) - ($.default /.framed) - ($.default /.up) - ($.default /.down) - ($.default /.inverse) - ($.default /.ticks) - ($.default /.equivalence) - ($.default /.order) - ($.default /.positive?) - ($.default /.negative?) - ($.default /.neutral?) - ($.default /.empty) - ($.default /.milli_second) - ($.default /.second) - ($.default /.minute) - ($.default /.hour) - ($.default /.day) - ($.default /.week) - ($.default /.normal_year) - ($.default /.leap_year) - ($.default /.monoid) - ($.default /.codec) - ($.default /.enum) - - ($.documentation /.Duration - "Durations have a resolution of milli-seconds.") - - ($.documentation /.difference - "" - [(difference from to)])] - [])) diff --git a/stdlib/source/documentation/lux/time/instant.lux b/stdlib/source/documentation/lux/time/instant.lux deleted file mode 100644 index c5fbe2b01..000000000 --- a/stdlib/source/documentation/lux/time/instant.lux +++ /dev/null @@ -1,56 +0,0 @@ -(.require - [library - [lux (.except and) - ["$" documentation] - [data - ["[0]" text (.only \n) - ["%" \\format (.only format)]]]]] - [\\library - ["[0]" /]]) - -(.def .public documentation - (.List $.Module) - ($.module /._ - "" - [($.default /.of_millis) - ($.default /.millis) - ($.default /.equivalence) - ($.default /.order) - ($.default /.enum) - ($.default /.date) - ($.default /.time) - ($.default /.day_of_week) - - ($.documentation /.Instant - "Instant is defined as milli-seconds since the epoch.") - - ($.documentation /.span - "" - [(span from to)]) - - ($.documentation /.after - "" - [(after duration instant)]) - - ($.documentation /.relative - "" - [(relative instant)]) - - ($.documentation /.absolute - "" - [(absolute offset)]) - - ($.documentation /.epoch - "The instant corresponding to 1970-01-01T00:00:00Z.") - - ($.documentation /.codec - (format "Based on ISO 8601." - \n "For example: 2017-01-15T21:14:51.827Z")) - - ($.documentation /.now - "Yields the current instant, as measured from the operating-system's clock.") - - ($.documentation /.of_date_time - "" - [(of_date_time date time)])] - [])) diff --git a/stdlib/source/documentation/lux/time/month.lux b/stdlib/source/documentation/lux/time/month.lux deleted file mode 100644 index 9e9d4dc28..000000000 --- a/stdlib/source/documentation/lux/time/month.lux +++ /dev/null @@ -1,38 +0,0 @@ -(.require - [library - [lux (.except and) - ["$" documentation] - [data - ["[0]" text (.only \n) - ["%" \\format (.only format)]]]]] - [\\library - ["[0]" /]]) - -(.def .public documentation - (.List $.Module) - ($.module /._ - "" - [($.default /.equivalence) - ($.default /.number) - ($.default /.invalid_month) - ($.default /.by_number) - ($.default /.hash) - ($.default /.order) - ($.default /.enum) - ($.default /.not_a_month_of_the_year) - ($.default /.codec) - - ($.documentation /.Month - "A month of the year.") - - ($.documentation /.days - "The amount of days of a month." - [(days month)]) - - ($.documentation /.leap_year_days - "The amount of days of a month (in a leap year)." - [(leap_year_days month)]) - - ($.documentation /.year - "All the months, ordered by when they come in a year.")] - [])) diff --git a/stdlib/source/documentation/lux/time/year.lux b/stdlib/source/documentation/lux/time/year.lux deleted file mode 100644 index 1ac6a11ca..000000000 --- a/stdlib/source/documentation/lux/time/year.lux +++ /dev/null @@ -1,48 +0,0 @@ -(.require - [library - [lux (.except and) - ["$" documentation] - [data - ["[0]" text (.only \n) - ["%" \\format (.only format)]]]]] - [\\library - ["[0]" /]]) - -(.def .public documentation - (.List $.Module) - ($.module /._ - "" - [($.default /.there_is_no_year_0) - ($.default /.value) - ($.default /.epoch) - ($.default /.leap) - ($.default /.century) - ($.default /.era) - ($.default /.leap?) - ($.default /.parser) - ($.default /.equivalence) - ($.default /.order) - - ($.documentation /.Year - (format "A year in the gregorian calendar." - \n "Both negative (< 0) and positive (> 0) values are valid, but not 0." - \n "This is because the first year of the gregorian calendar was year 1.")) - - ($.documentation /.year - "A valid year in the gregorian calendar, if possible." - [(year value)]) - - ($.documentation /.days - "The amount of days in a typical year.") - - ($.documentation /.Period - "An amount of years.") - - ($.documentation /.leaps - "The number of leap years in a period of years." - [(leaps year)]) - - ($.documentation /.codec - (format "Based on ISO 8601." - \n "For example: 2017"))] - [])) diff --git a/stdlib/source/documentation/lux/world.lux b/stdlib/source/documentation/lux/world.lux index 7376eb311..777b02678 100644 --- a/stdlib/source/documentation/lux/world.lux +++ b/stdlib/source/documentation/lux/world.lux @@ -19,7 +19,8 @@ ["[1]/[0]" video ["[1]/[0]" resolution]]] ["[1][0]" environment] - ["[1][0]" shell]]) + ["[1][0]" shell] + ["[1][0]" time]]) (.def .public documentation (.List $.Module) @@ -30,4 +31,5 @@ /net.documentation /output/video/resolution.documentation /environment.documentation - /shell.documentation)) + /shell.documentation + /time.documentation)) diff --git a/stdlib/source/documentation/lux/world/time.lux b/stdlib/source/documentation/lux/world/time.lux new file mode 100644 index 000000000..f327e942a --- /dev/null +++ b/stdlib/source/documentation/lux/world/time.lux @@ -0,0 +1,71 @@ +(.require + [library + [lux (.except and) + ["$" documentation] + [data + ["[0]" text (.only \n) + ["%" \\format (.only format)]]]]] + [\\library + ["[0]" /]] + ["[0]" / + ["[1][0]" date] + ["[1][0]" day] + ["[1][0]" duration] + ["[1][0]" instant] + ["[1][0]" month] + ["[1][0]" year]]) + +(`` (.def .public documentation + (.List $.Module) + ($.module /._ + "" + [($.default /.time_exceeds_a_day) + ($.default /.invalid_hour) + ($.default /.invalid_minute) + ($.default /.invalid_second) + ($.default /.millis) + ($.default /.equivalence) + ($.default /.order) + ($.default /.enum) + ($.default /.parser) + + (,, (with_template [ ] + [($.documentation + )] + + [/.milli_seconds "Number of milli-seconds in a second."] + [/.seconds "Number of seconds in a minute."] + [/.minutes "Number of minutes in an hour."] + [/.hours "Number of hours in an day."] + )) + + ($.documentation /.Time + "Time is defined as milliseconds since the start of the day (00:00:00.000).") + + ($.documentation /.midnight + "The instant corresponding to the start of the day: 00:00:00.000") + + ($.documentation /.of_millis + "" + [(of_millis milli_seconds)]) + + ($.documentation /.Clock + "A clock marking the specific hour, minute, second, and milli-second in a day.") + + ($.documentation /.clock + "" + [(clock time)]) + + ($.documentation /.time + "" + [(time clock)]) + + ($.documentation /.codec + (format "Based on ISO 8601." + \n "For example: 21:14:51.827"))] + [/date.documentation + /day.documentation + /duration.documentation + /instant.documentation + /month.documentation + /year.documentation]))) diff --git a/stdlib/source/documentation/lux/world/time/date.lux b/stdlib/source/documentation/lux/world/time/date.lux new file mode 100644 index 000000000..17fd0143b --- /dev/null +++ b/stdlib/source/documentation/lux/world/time/date.lux @@ -0,0 +1,38 @@ +(.require + [library + [lux (.except and) + ["$" documentation] + [data + ["[0]" text (.only \n) + ["%" \\format (.only format)]]]]] + [\\library + ["[0]" /]]) + +(.def .public documentation + (.List $.Module) + ($.module /._ + "" + [($.default /.invalid_day) + ($.default /.epoch) + ($.default /.year) + ($.default /.month) + ($.default /.day_of_month) + ($.default /.equivalence) + ($.default /.order) + ($.default /.invalid_month) + ($.default /.parser) + ($.default /.days) + ($.default /.of_days) + ($.default /.enum) + + ($.documentation /.Date + "A date specified as a year/month/day triplet.") + + ($.documentation /.date + "A date, within the allowed limits." + [(date year month day_of_month)]) + + ($.documentation /.codec + (format "Based on ISO 8601." + \n "For example: 2017-01-15"))] + [])) diff --git a/stdlib/source/documentation/lux/world/time/day.lux b/stdlib/source/documentation/lux/world/time/day.lux new file mode 100644 index 000000000..e7923dfe0 --- /dev/null +++ b/stdlib/source/documentation/lux/world/time/day.lux @@ -0,0 +1,30 @@ +(.require + [library + [lux (.except and) + ["$" documentation] + [data + ["[0]" text (.only \n) + ["%" \\format (.only format)]]]]] + [\\library + ["[0]" /]]) + +(.def .public documentation + (.List $.Module) + ($.module /._ + "" + [($.default /.equivalence) + ($.default /.order) + ($.default /.enum) + ($.default /.not_a_day_of_the_week) + ($.default /.codec) + ($.default /.number) + ($.default /.invalid_day) + ($.default /.by_number) + ($.default /.hash) + + ($.documentation /.Day + "A day of the week.") + + ($.documentation /.week + "All the days, ordered by when they come in a week.")] + [])) diff --git a/stdlib/source/documentation/lux/world/time/duration.lux b/stdlib/source/documentation/lux/world/time/duration.lux new file mode 100644 index 000000000..0b9ddaa0b --- /dev/null +++ b/stdlib/source/documentation/lux/world/time/duration.lux @@ -0,0 +1,47 @@ +(.require + [library + [lux (.except and) + ["$" documentation] + [data + ["[0]" text (.only \n) + ["%" \\format (.only format)]]]]] + [\\library + ["[0]" /]]) + +(.def .public documentation + (.List $.Module) + ($.module /._ + "" + [($.default /.of_millis) + ($.default /.millis) + ($.default /.composite) + ($.default /.framed) + ($.default /.up) + ($.default /.down) + ($.default /.inverse) + ($.default /.ticks) + ($.default /.equivalence) + ($.default /.order) + ($.default /.positive?) + ($.default /.negative?) + ($.default /.neutral?) + ($.default /.empty) + ($.default /.milli_second) + ($.default /.second) + ($.default /.minute) + ($.default /.hour) + ($.default /.day) + ($.default /.week) + ($.default /.normal_year) + ($.default /.leap_year) + ($.default /.monoid) + ($.default /.codec) + ($.default /.enum) + + ($.documentation /.Duration + "Durations have a resolution of milli-seconds.") + + ($.documentation /.difference + "" + [(difference from to)])] + [])) diff --git a/stdlib/source/documentation/lux/world/time/instant.lux b/stdlib/source/documentation/lux/world/time/instant.lux new file mode 100644 index 000000000..c5fbe2b01 --- /dev/null +++ b/stdlib/source/documentation/lux/world/time/instant.lux @@ -0,0 +1,56 @@ +(.require + [library + [lux (.except and) + ["$" documentation] + [data + ["[0]" text (.only \n) + ["%" \\format (.only format)]]]]] + [\\library + ["[0]" /]]) + +(.def .public documentation + (.List $.Module) + ($.module /._ + "" + [($.default /.of_millis) + ($.default /.millis) + ($.default /.equivalence) + ($.default /.order) + ($.default /.enum) + ($.default /.date) + ($.default /.time) + ($.default /.day_of_week) + + ($.documentation /.Instant + "Instant is defined as milli-seconds since the epoch.") + + ($.documentation /.span + "" + [(span from to)]) + + ($.documentation /.after + "" + [(after duration instant)]) + + ($.documentation /.relative + "" + [(relative instant)]) + + ($.documentation /.absolute + "" + [(absolute offset)]) + + ($.documentation /.epoch + "The instant corresponding to 1970-01-01T00:00:00Z.") + + ($.documentation /.codec + (format "Based on ISO 8601." + \n "For example: 2017-01-15T21:14:51.827Z")) + + ($.documentation /.now + "Yields the current instant, as measured from the operating-system's clock.") + + ($.documentation /.of_date_time + "" + [(of_date_time date time)])] + [])) diff --git a/stdlib/source/documentation/lux/world/time/month.lux b/stdlib/source/documentation/lux/world/time/month.lux new file mode 100644 index 000000000..9e9d4dc28 --- /dev/null +++ b/stdlib/source/documentation/lux/world/time/month.lux @@ -0,0 +1,38 @@ +(.require + [library + [lux (.except and) + ["$" documentation] + [data + ["[0]" text (.only \n) + ["%" \\format (.only format)]]]]] + [\\library + ["[0]" /]]) + +(.def .public documentation + (.List $.Module) + ($.module /._ + "" + [($.default /.equivalence) + ($.default /.number) + ($.default /.invalid_month) + ($.default /.by_number) + ($.default /.hash) + ($.default /.order) + ($.default /.enum) + ($.default /.not_a_month_of_the_year) + ($.default /.codec) + + ($.documentation /.Month + "A month of the year.") + + ($.documentation /.days + "The amount of days of a month." + [(days month)]) + + ($.documentation /.leap_year_days + "The amount of days of a month (in a leap year)." + [(leap_year_days month)]) + + ($.documentation /.year + "All the months, ordered by when they come in a year.")] + [])) diff --git a/stdlib/source/documentation/lux/world/time/year.lux b/stdlib/source/documentation/lux/world/time/year.lux new file mode 100644 index 000000000..1ac6a11ca --- /dev/null +++ b/stdlib/source/documentation/lux/world/time/year.lux @@ -0,0 +1,48 @@ +(.require + [library + [lux (.except and) + ["$" documentation] + [data + ["[0]" text (.only \n) + ["%" \\format (.only format)]]]]] + [\\library + ["[0]" /]]) + +(.def .public documentation + (.List $.Module) + ($.module /._ + "" + [($.default /.there_is_no_year_0) + ($.default /.value) + ($.default /.epoch) + ($.default /.leap) + ($.default /.century) + ($.default /.era) + ($.default /.leap?) + ($.default /.parser) + ($.default /.equivalence) + ($.default /.order) + + ($.documentation /.Year + (format "A year in the gregorian calendar." + \n "Both negative (< 0) and positive (> 0) values are valid, but not 0." + \n "This is because the first year of the gregorian calendar was year 1.")) + + ($.documentation /.year + "A valid year in the gregorian calendar, if possible." + [(year value)]) + + ($.documentation /.days + "The amount of days in a typical year.") + + ($.documentation /.Period + "An amount of years.") + + ($.documentation /.leaps + "The number of leap years in a period of years." + [(leaps year)]) + + ($.documentation /.codec + (format "Based on ISO 8601." + \n "For example: 2017"))] + [])) diff --git a/stdlib/source/format/lux/data/text.lux b/stdlib/source/format/lux/data/text.lux index 2cbf6d99c..f9d79c466 100644 --- a/stdlib/source/format/lux/data/text.lux +++ b/stdlib/source/format/lux/data/text.lux @@ -15,12 +15,6 @@ ["[0]" json]] [collection ["[0]" list (.use "[1]#[0]" monad)]]] - ["[0]" time (.only) - ["[0]" instant] - ["[0]" duration] - ["[0]" date] - ["[0]" day] - ["[0]" month]] [math ["[0]" modular] [number @@ -37,7 +31,14 @@ ["<[1]>" \\parser (.only Parser)]] [macro [syntax (.only syntax)] - ["[0]" template]]]]]) + ["[0]" template]]] + [world + ["[0]" time (.only) + ["[0]" instant] + ["[0]" duration] + ["[0]" date] + ["[0]" day] + ["[0]" month]]]]]) (.type .public (Format a) (-> a Text)) diff --git a/stdlib/source/library/lux/control/concurrency/thread.lux b/stdlib/source/library/lux/control/concurrency/thread.lux index 5fb0f883b..408b854f8 100644 --- a/stdlib/source/library/lux/control/concurrency/thread.lux +++ b/stdlib/source/library/lux/control/concurrency/thread.lux @@ -19,8 +19,9 @@ [meta ["@" target] ["[0]" configuration]] - [time - ["[0]" instant]]]] + [world + [time + ["[0]" instant]]]]] [// ["[0]" atom (.only Atom)]]) diff --git a/stdlib/source/library/lux/control/remember.lux b/stdlib/source/library/lux/control/remember.lux index 800dc3627..b7a91758f 100644 --- a/stdlib/source/library/lux/control/remember.lux +++ b/stdlib/source/library/lux/control/remember.lux @@ -17,9 +17,10 @@ [macro [syntax (.only syntax)] ["[0]" template]]] - [time - ["[0]" instant] - ["[0]" date (.only Date) (.use "[1]#[0]" order)]]]]) + [world + [time + ["[0]" instant] + ["[0]" date (.only Date) (.use "[1]#[0]" order)]]]]]) (exception .public (must_remember [deadline Date today Date diff --git a/stdlib/source/library/lux/data/format/tar.lux b/stdlib/source/library/lux/data/format/tar.lux index 41a582b07..aad8579af 100644 --- a/stdlib/source/library/lux/data/format/tar.lux +++ b/stdlib/source/library/lux/data/format/tar.lux @@ -33,11 +33,11 @@ ["^" pattern]] [type [primitive (.except)]]] - [time - ["[0]" instant (.only Instant)] - ["[0]" duration]] [world - ["[0]" file]]]]) + ["[0]" file] + [time + ["[0]" instant (.only Instant)] + ["[0]" duration]]]]]) (type Size Nat) diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux index 5bf180093..47046fadc 100644 --- a/stdlib/source/library/lux/debug.lux +++ b/stdlib/source/library/lux/debug.lux @@ -35,12 +35,13 @@ ["[0]" syntax (.only syntax)]] ["[0]" type (.only) ["<[1]>" \\parser (.only Parser)]]] - [time (.only Time) - [instant (.only Instant)] - [duration (.only Duration)] - [date (.only Date)] - [month (.only Month)] - [day (.only Day)]]]]) + [world + [time (.only Time) + [instant (.only Instant)] + [duration (.only Duration)] + [date (.only Date)] + [month (.only Month)] + [day (.only Day)]]]]]) (with_expansions [ (these (import java/lang/String "[1]::[0]") diff --git a/stdlib/source/library/lux/math/random.lux b/stdlib/source/library/lux/math/random.lux index ece9576f8..d482c72b3 100644 --- a/stdlib/source/library/lux/math/random.lux +++ b/stdlib/source/library/lux/math/random.lux @@ -31,12 +31,13 @@ [meta [type [refinement (.only Refiner Refined)]]] - ["[0]" time (.only Time) - ["[0]" instant (.only Instant)] - ["[0]" date (.only Date)] - ["[0]" duration (.only Duration)] - ["[0]" month (.only Month)] - ["[0]" day (.only Day)]]]]) + [world + ["[0]" time (.only Time) + ["[0]" instant (.only Instant)] + ["[0]" date (.only Date)] + ["[0]" duration (.only Duration)] + ["[0]" month (.only Month)] + ["[0]" day (.only Day)]]]]]) (type .public PRNG (Rec PRNG diff --git a/stdlib/source/library/lux/meta/compiler/meta/export.lux b/stdlib/source/library/lux/meta/compiler/meta/export.lux index 20a0bd0cd..a32656ffa 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/export.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/export.lux @@ -23,10 +23,10 @@ [cli (.only Source Export)] ["[0]" io ["[1]" context]]]]] - [time - ["[0]" instant]] [world - ["[0]" file]]]]) + ["[0]" file] + [time + ["[0]" instant]]]]]) (def .public file "library.tar") diff --git a/stdlib/source/library/lux/meta/compiler/meta/packager/scheme.lux b/stdlib/source/library/lux/meta/compiler/meta/packager/scheme.lux index b98361ff0..0b14e378f 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/packager/scheme.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/packager/scheme.lux @@ -23,10 +23,10 @@ [meta [target ["_" scheme]]] - [time - ["[0]" instant (.only Instant)]] [world - ["[0]" file]]]] + ["[0]" file] + [time + ["[0]" instant (.only Instant)]]]]] [program [compositor ["[0]" static (.only Static)]]] diff --git a/stdlib/source/library/lux/meta/compiler/phase.lux b/stdlib/source/library/lux/meta/compiler/phase.lux index a0b4df481..2b67baec4 100644 --- a/stdlib/source/library/lux/meta/compiler/phase.lux +++ b/stdlib/source/library/lux/meta/compiler/phase.lux @@ -13,9 +13,10 @@ ["[0]" product] [text ["%" \\format (.only format)]]] - [time - ["[0]" instant] - ["[0]" duration]]]] + [world + [time + ["[0]" instant] + ["[0]" duration]]]]] [// [meta [archive (.only Archive)]]]) diff --git a/stdlib/source/library/lux/test.lux b/stdlib/source/library/lux/test.lux index b3de0884d..e6690c522 100644 --- a/stdlib/source/library/lux/test.lux +++ b/stdlib/source/library/lux/test.lux @@ -35,12 +35,12 @@ ["<[1]>" \\parser]] [macro [syntax (.only syntax)]]] - [time - ["[0]" instant] - ["[0]" duration (.only Duration)]] [world ["[0]" environment] - ["[0]" console]]]]) + ["[0]" console] + [time + ["[0]" instant] + ["[0]" duration (.only Duration)]]]]]) (type .public Tally (Record diff --git a/stdlib/source/library/lux/time.lux b/stdlib/source/library/lux/time.lux deleted file mode 100644 index d24e87497..000000000 --- a/stdlib/source/library/lux/time.lux +++ /dev/null @@ -1,215 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - [equivalence (.only Equivalence)] - [order (.only Order)] - [enum (.only Enum)] - [codec (.only Codec)] - [monad (.only Monad do)]] - [control - ["<>" parser (.only)] - ["[0]" pipe] - ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] - [data - ["[0]" text (.use "[1]#[0]" monoid) - ["<[1]>" \\parser (.only Parser)]]] - [math - [number - ["n" nat (.use "[1]#[0]" decimal)]]] - [meta - [type - [primitive (.except)]]]]] - [/ - ["[0]" duration (.only Duration)]]) - -(with_template [ ] - [(def .public - Nat - (.nat (duration.ticks )))] - - [milli_seconds duration.milli_second duration.second] - [seconds duration.second duration.minute] - [minutes duration.minute duration.hour] - [hours duration.hour duration.day] - ) - -(def limit - Nat - (.nat (duration.millis duration.day))) - -(exception .public (time_exceeds_a_day [time Nat]) - (exception.report - (list ["Time (in milli-seconds)" (n#encoded time)] - ["Maximum (in milli-seconds)" (n#encoded (-- limit))]))) - -(def separator ":") - -(def section_parser - (Parser Nat) - (<>.codec n.decimal (.exactly 2 .decimal))) - -(def millis_parser - (Parser Nat) - (<>.either (|> (.at_most 3 .decimal) - (<>.codec n.decimal) - (<>.after (.this "."))) - (at <>.monad in 0))) - -(with_template [ ] - [(exception .public ( [value Nat]) - (exception.report - (list ["Value" (n#encoded value)] - ["Minimum" (n#encoded 0)] - ["Maximum" (n#encoded (-- ))]))) - - (def - (Parser Nat) - (do <>.monad - [value ] - (if (n.< value) - (in value) - (<>.lifted (exception.except [value])))))] - - [..hours hour_parser invalid_hour ..section_parser] - [..minutes minute_parser invalid_minute ..section_parser] - [..seconds second_parser invalid_second ..section_parser] - ) - -(primitive .public Time - Nat - - (def .public midnight - Time - (abstraction 0)) - - (def .public (of_millis milli_seconds) - (-> Nat (Try Time)) - (if (n.< ..limit milli_seconds) - {try.#Success (abstraction milli_seconds)} - (exception.except ..time_exceeds_a_day [milli_seconds]))) - - (def .public millis - (-> Time Nat) - (|>> representation)) - - (def .public equivalence - (Equivalence Time) - (implementation - (def (= param subject) - (n.= (representation param) (representation subject))))) - - (def .public order - (Order Time) - (implementation - (def equivalence ..equivalence) - - (def (< param subject) - (n.< (representation param) (representation subject))))) - - (`` (def .public enum - (Enum Time) - (implementation - (def order ..order) - - (def succ - (|>> representation ++ (n.% ..limit) abstraction)) - - (def pred - (|>> representation - (pipe.case - 0 ..limit - millis millis) - -- - abstraction))))) - - (def .public parser - (Parser Time) - (let [millis (is (-> Duration Nat) - (|>> duration.millis .nat)) - hour (millis duration.hour) - minute (millis duration.minute) - second (millis duration.second) - millis (millis duration.milli_second)] - (do [! <>.monad] - [utc_hour ..hour_parser - _ (.this ..separator) - utc_minute ..minute_parser - _ (.this ..separator) - utc_second ..second_parser - utc_millis ..millis_parser] - (in (abstraction - (all n.+ - (n.* utc_hour hour) - (n.* utc_minute minute) - (n.* utc_second second) - (n.* utc_millis millis))))))) - ) - -(def (padded value) - (-> Nat Text) - (if (n.< 10 value) - (text#composite "0" (n#encoded value)) - (n#encoded value))) - -(def (positive space duration) - (-> Duration Duration Duration) - (if (duration.negative? duration) - (duration.composite space duration) - duration)) - -(def (millis_format millis) - (-> Nat Text) - (cond (n.= 0 millis) "" - (n.< 10 millis) (all text#composite ".00" (n#encoded millis)) - (n.< 100 millis) (all text#composite ".0" (n#encoded millis)) - ... (n.< 1,000 millis) - (all text#composite "." (n#encoded millis)))) - -(type .public Clock - (Record - [#hour Nat - #minute Nat - #second Nat - #milli_second Nat])) - -(def .public (clock time) - (-> Time Clock) - (let [time (|> time ..millis .int duration.of_millis) - [hours time] [(duration.ticks duration.hour time) (duration.framed duration.hour time)] - [minutes time] [(duration.ticks duration.minute time) (duration.framed duration.minute time)] - [seconds millis] [(duration.ticks duration.second time) (duration.framed duration.second time)]] - [#hour (.nat hours) - #minute (.nat minutes) - #second (.nat seconds) - #milli_second (|> millis - (..positive duration.second) - duration.millis - .nat)])) - -(def .public (time clock) - (-> Clock (Try Time)) - (|> (all duration.composite - (duration.up (the #hour clock) duration.hour) - (duration.up (the #minute clock) duration.minute) - (duration.up (the #second clock) duration.second) - (duration.of_millis (.int (the #milli_second clock)))) - duration.millis - .nat - ..of_millis)) - -(def (format time) - (-> Time Text) - (let [(open "_[0]") (..clock time)] - (all text#composite - (..padded _#hour) - ..separator (..padded _#minute) - ..separator (..padded _#second) - (..millis_format _#milli_second)))) - -(def .public codec - (Codec Text Time) - (implementation - (def encoded ..format) - (def decoded (.result ..parser)))) diff --git a/stdlib/source/library/lux/time/date.lux b/stdlib/source/library/lux/time/date.lux deleted file mode 100644 index 09fd828ae..000000000 --- a/stdlib/source/library/lux/time/date.lux +++ /dev/null @@ -1,353 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - [equivalence (.only Equivalence)] - [order (.only Order)] - [enum (.only Enum)] - [codec (.only Codec)] - [monad (.only do)]] - [control - ["<>" parser (.only)] - ["[0]" maybe] - ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] - [data - ["[0]" text (.use "[1]#[0]" monoid) - ["<[1]>" \\parser (.only Parser)]] - [collection - ["[0]" list (.use "[1]#[0]" mix)] - ["[0]" dictionary (.only Dictionary)]]] - [math - [number - ["n" nat (.use "[1]#[0]" decimal)] - ["i" int]]] - [meta - [type - [primitive (.except)]]]]] - ["[0]" // - ["[1][0]" year (.only Year)] - ["[1][0]" month (.only Month)]]) - -(def month_by_number - (Dictionary Nat Month) - (list#mix (function (_ month mapping) - (dictionary.has (//month.number month) month mapping)) - (dictionary.empty n.hash) - //month.year)) - -(def minimum_day - 1) - -(def (month_days year month) - (-> Year Month Nat) - (if (//year.leap? year) - (//month.leap_year_days month) - (//month.days month))) - -(def (invalid_day? year month day) - (-> Year Month Nat Bit) - (or (n.< ..minimum_day day) - (n.> (..month_days year month) day))) - -(exception .public (invalid_day [year Year - month Month - day Nat]) - (exception.report - (list ["Value" (n#encoded day)] - ["Minimum" (n#encoded ..minimum_day)] - ["Maximum" (n#encoded (..month_days year month))] - ["Year" (at //year.codec encoded year)] - ["Month" (n#encoded (//month.number month))]))) - -(def (padded value) - (-> Nat Text) - (let [digits (n#encoded value)] - (if (n.< 10 value) - (text#composite "0" digits) - digits))) - -(def separator - "-") - -(primitive .public Date - (Record - [#year Year - #month Month - #day Nat]) - - (def .public (date year month day_of_month) - (-> Year Month Nat (Try Date)) - (if (..invalid_day? year month day_of_month) - (exception.except ..invalid_day [year month day_of_month]) - {try.#Success - (abstraction - [#year year - #month month - #day day_of_month])})) - - (def .public epoch - Date - (try.trusted - (..date //year.epoch - {//month.#January} - ..minimum_day))) - - (with_template [ ] - [(def .public - (-> Date ) - (|>> representation (the )))] - - [year Year #year] - [month Month #month] - [day_of_month Nat #day] - ) - - (def .public equivalence - (Equivalence Date) - (implementation - (def (= reference sample) - (let [reference (representation reference) - sample (representation sample)] - (and (at //year.equivalence = - (the #year reference) - (the #year sample)) - (at //month.equivalence = - (the #month reference) - (the #month sample)) - (n.= (the #day reference) - (the #day sample))))))) - - (def .public order - (Order Date) - (implementation - (def equivalence ..equivalence) - - (def (< reference sample) - (let [reference (representation reference) - sample (representation sample)] - (or (at //year.order < - (the #year reference) - (the #year sample)) - (and (at //year.equivalence = - (the #year reference) - (the #year sample)) - (or (at //month.order < - (the #month reference) - (the #month sample)) - (and (at //month.order = - (the #month reference) - (the #month sample)) - (n.< (the #day reference) - (the #day sample)))))))))) - ) - -(def section_parser - (Parser Nat) - (<>.codec n.decimal (.exactly 2 .decimal))) - -(def millis_parser - (Parser Nat) - (<>.either (|> (.at_most 3 .decimal) - (<>.codec n.decimal) - (<>.after (.this "."))) - (at <>.monad in 0))) - -(with_template [ ] - [(exception .public ( [value Nat]) - (exception.report - (list ["Value" (n#encoded value)] - ["Minimum" (n#encoded )] - ["Maximum" (n#encoded )]))) - - (def - (Parser Nat) - (do <>.monad - [value ..section_parser] - (if (or (n.< value) - (n.> value)) - (<>.lifted (exception.except [value])) - (in value))))] - - [1 12 month_parser invalid_month] - ) - -(def .public parser - (Parser Date) - (do <>.monad - [utc_year //year.parser - _ (.this ..separator) - utc_month ..month_parser - _ (.this ..separator) - .let [month (maybe.trusted (dictionary.value utc_month ..month_by_number))] - utc_day ..section_parser] - (<>.lifted (..date utc_year month utc_day)))) - -(def (format value) - (-> Date Text) - (all text#composite - (at //year.codec encoded (..year value)) - ..separator (..padded (|> value ..month //month.number)) - ..separator (..padded (..day_of_month value)))) - -(def .public codec - (Codec Text Date) - (implementation - (def encoded ..format) - (def decoded (.result ..parser)))) - -(def days_per_leap - (|> //year.days - (n.* 4) - (n.+ 1))) - -(def days_per_century - (let [leaps_per_century (n./ //year.leap - //year.century)] - (|> //year.century - (n.* //year.days) - (n.+ leaps_per_century) - (n.- 1)))) - -(def days_per_era - (let [centuries_per_era (n./ //year.century - //year.era)] - (|> centuries_per_era - (n.* ..days_per_century) - (n.+ 1)))) - -(def days_since_epoch - (let [years::70 70 - leaps::70 (n./ //year.leap - years::70) - days::70 (|> years::70 - (n.* //year.days) - (n.+ leaps::70)) - ... The epoch is being calculated from March 1st, instead of January 1st. - january_&_february (n.+ (//month.days {//month.#January}) - (//month.days {//month.#February}))] - (|> 0 - ... 1600/01/01 - (n.+ (n.* 4 days_per_era)) - ... 1900/01/01 - (n.+ (n.* 3 days_per_century)) - ... 1970/01/01 - (n.+ days::70) - ... 1970/03/01 - (n.- january_&_february)))) - -(def first_month_of_civil_year 3) - -(with_expansions [ +3 - +9] - (def (internal_month civil_month) - (-> Nat Int) - (if (n.< ..first_month_of_civil_year civil_month) - (i.+ (.int civil_month)) - (i.- (.int civil_month)))) - - (def (civil_month internal_month) - (-> Int Nat) - (.nat (if (i.< +10 internal_month) - (i.+ internal_month) - (i.- internal_month))))) - -(with_expansions [ +153 - +2 - +5] - (def day_of_year_from_month - (-> Nat Int) - (|>> ..internal_month - (i.* ) - (i.+ ) - (i./ ))) - - (def month_from_day_of_year - (-> Int Nat) - (|>> (i.* ) - (i.+ ) - (i./ ) - ..civil_month))) - -(def last_era_leap_day - (.int (-- ..days_per_leap))) - -(def last_era_day - (.int (-- ..days_per_era))) - -(def (civil_year utc_month utc_year) - (-> Nat Year Int) - (let [... Coercing, because the year is already in external form. - utc_year (as Int utc_year)] - (if (n.< ..first_month_of_civil_year utc_month) - (-- utc_year) - utc_year))) - -... http://howardhinnant.github.io/date_algorithms.html -(def .public (days date) - (-> Date Int) - (let [utc_month (|> date ..month //month.number) - civil_year (..civil_year utc_month (..year date)) - era (|> (if (i.< +0 civil_year) - (i.- (.int (-- //year.era)) - civil_year) - civil_year) - (i./ (.int //year.era))) - year_of_era (i.- (i.* (.int //year.era) - era) - civil_year) - day_of_year (|> utc_month - ..day_of_year_from_month - (i.+ (.int (-- (..day_of_month date))))) - day_of_era (|> day_of_year - (i.+ (i.* (.int //year.days) year_of_era)) - (i.+ (i./ (.int //year.leap) year_of_era)) - (i.- (i./ (.int //year.century) year_of_era)))] - (|> (i.* (.int ..days_per_era) era) - (i.+ day_of_era) - (i.- (.int ..days_since_epoch))))) - -... http://howardhinnant.github.io/date_algorithms.html -(def .public (of_days days) - (-> Int Date) - (let [days (i.+ (.int ..days_since_epoch) days) - era (|> (if (i.< +0 days) - (i.- ..last_era_day days) - days) - (i./ (.int ..days_per_era))) - day_of_era (i.- (i.* (.int ..days_per_era) era) days) - year_of_era (|> day_of_era - (i.- (i./ ..last_era_leap_day day_of_era)) - (i.+ (i./ (.int ..days_per_century) day_of_era)) - (i.- (i./ ..last_era_day day_of_era)) - (i./ (.int //year.days))) - year (i.+ (i.* (.int //year.era) era) - year_of_era) - day_of_year (|> day_of_era - (i.- (i.* (.int //year.days) year_of_era)) - (i.- (i./ (.int //year.leap) year_of_era)) - (i.+ (i./ (.int //year.century) year_of_era))) - month (..month_from_day_of_year day_of_year) - day (|> day_of_year - (i.- (..day_of_year_from_month month)) - (i.+ +1) - .nat) - year (if (n.< ..first_month_of_civil_year month) - (++ year) - year)] - ... Coercing, because the year is already in internal form. - (try.trusted - (..date (as Year year) - (maybe.trusted (dictionary.value month ..month_by_number)) - day)))) - -(def .public enum - (Enum Date) - (implementation - (def order ..order) - - (def succ - (|>> ..days ++ ..of_days)) - - (def pred - (|>> ..days -- ..of_days)))) diff --git a/stdlib/source/library/lux/time/day.lux b/stdlib/source/library/lux/time/day.lux deleted file mode 100644 index 4f1570d43..000000000 --- a/stdlib/source/library/lux/time/day.lux +++ /dev/null @@ -1,189 +0,0 @@ -(.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 [] - [[{} {}] - #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 [] - [{} - (text.replaced "#" "" (template.text []))]) - ([..#Monday] - [..#Tuesday] - [..#Wednesday] - [..#Thursday] - [..#Friday] - [..#Saturday] - [..#Sunday]))) - (def (decoded value) - (case (text#composite "#" value) - (^.with_template [] - [(template.text []) - {try.#Success {}}]) - ([..#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 [ (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 [ ] - [{} - ]) - ())) - - (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 [ ] - [ - {try.#Success {}}]) - () - - _ - (exception.except ..invalid_day [number]))) - ) - -(def .public hash - (Hash Day) - (implementation - (def equivalence ..equivalence) - (def (hash day) - (case day - (^.with_template [ ] - [{} - ]) - ([02 #Sunday] - [03 #Monday] - [05 #Tuesday] - [07 #Wednesday] - [11 #Thursday] - [13 #Friday] - [17 #Saturday]))))) diff --git a/stdlib/source/library/lux/time/duration.lux b/stdlib/source/library/lux/time/duration.lux deleted file mode 100644 index 00a7c1d1e..000000000 --- a/stdlib/source/library/lux/time/duration.lux +++ /dev/null @@ -1,202 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - [equivalence (.only Equivalence)] - [order (.only Order)] - [enum (.only Enum)] - [codec (.only Codec)] - [monoid (.only Monoid)] - [monad (.only do)]] - [control - ["<>" parser (.only)] - ["[0]" try]] - [data - ["[0]" text (.use "[1]#[0]" monoid) - ["<[1]>" \\parser (.only Parser)]]] - [math - [number - ["i" int] - ["[0]" nat (.use "[1]#[0]" decimal)]]] - [meta - [type - [primitive (.except)]]]]] - ["[0]" // - ["[1][0]" year]]) - -(primitive .public Duration - Int - - (def .public of_millis - (-> Int Duration) - (|>> abstraction)) - - (def .public millis - (-> Duration Int) - (|>> representation)) - - (with_template [ ] - [(def .public ( param subject) - (-> Duration Duration Duration) - (abstraction ( (representation param) (representation subject))))] - - [i.+ composite] - [i.% framed] - ) - - (with_template [ ] - [(def .public ( scalar) - (-> Nat Duration Duration) - (|>> representation ( (.int scalar)) abstraction))] - - [i.* up] - [i./ down] - ) - - (def .public inverse - (-> Duration Duration) - (|>> representation (i.* -1) abstraction)) - - (def .public (ticks param subject) - (-> Duration Duration Int) - (i./ (representation param) (representation subject))) - - (def .public equivalence - (Equivalence Duration) - (implementation - (def (= param subject) - (i.= (representation param) (representation subject))))) - - (def .public order - (Order Duration) - (implementation - (def equivalence ..equivalence) - (def (< param subject) - (i.< (representation param) (representation subject))))) - - (with_template [ ] - [(def .public - (-> Duration Bit) - (|>> representation ( +0)))] - - [i.> positive?] - [i.< negative?] - [i.= neutral?] - ) - ) - -(def .public empty - (..of_millis +0)) - -(def .public milli_second - (..of_millis +1)) - -(with_template [ ] - [(def .public - (..up ))] - - [second 1,000 milli_second] - [minute 60 second] - [hour 60 minute] - [day 24 hour] - - [week 7 day] - [normal_year //year.days day] - ) - -(def .public leap_year - (..composite ..day ..normal_year)) - -(def .public monoid - (Monoid Duration) - (implementation - (def identity ..empty) - (def composite ..composite))) - -(with_template [ ] - [(def )] - - ["D" day_suffix] - ["h" hour_suffix] - ["m" minute_suffix] - ["s" second_suffix] - ["ms" milli_second_suffix] - - ["+" positive_sign] - ["-" negative_sign] - ) - -(def (encoded duration) - (if (at ..equivalence = ..empty duration) - (all text#composite - ..positive_sign - (nat#encoded 0) - ..milli_second_suffix) - (let [signed? (negative? duration) - [days time_left] [(ticks day duration) (framed day duration)] - days (if signed? - (i.abs days) - days) - time_left (if signed? - (..inverse time_left) - time_left) - [hours time_left] [(ticks hour time_left) (framed hour time_left)] - [minutes time_left] [(ticks minute time_left) (framed minute time_left)] - [seconds time_left] [(ticks second time_left) (framed second time_left)] - millis (..millis time_left)] - (all text#composite - (if signed? ..negative_sign ..positive_sign) - (if (i.= +0 days) "" (text#composite (nat#encoded (.nat days)) ..day_suffix)) - (if (i.= +0 hours) "" (text#composite (nat#encoded (.nat hours)) ..hour_suffix)) - (if (i.= +0 minutes) "" (text#composite (nat#encoded (.nat minutes)) ..minute_suffix)) - (if (i.= +0 seconds) "" (text#composite (nat#encoded (.nat seconds)) ..second_suffix)) - (if (i.= +0 millis) "" (text#composite (nat#encoded (.nat millis)) ..milli_second_suffix)) - )))) - -(def parser - (Parser Duration) - (let [section (is (-> Text Text (Parser Nat)) - (function (_ suffix false_suffix) - (|> (.many .decimal) - (<>.codec nat.decimal) - (<>.before (case false_suffix - "" (.this suffix) - _ (<>.after (<>.not (.this false_suffix)) - (.this suffix)))) - (<>.else 0))))] - (do <>.monad - [sign (<>.or (.this ..negative_sign) - (.this ..positive_sign)) - days (section ..day_suffix "") - hours (section hour_suffix "") - minutes (section ..minute_suffix ..milli_second_suffix) - seconds (section ..second_suffix "") - millis (section ..milli_second_suffix "") - .let [span (|> ..empty - (..composite (..up days ..day)) - (..composite (..up hours ..hour)) - (..composite (..up minutes ..minute)) - (..composite (..up seconds ..second)) - (..composite (..up millis ..milli_second)))]] - (in (case sign - {.#Left _} (..inverse span) - {.#Right _} span))))) - -(def .public codec - (Codec Text Duration) - (implementation - (def encoded ..encoded) - (def decoded (.result ..parser)))) - -(def .public (difference from to) - (-> Duration Duration Duration) - (|> from ..inverse (..composite to))) - -(def .public enum - (Enum Duration) - (implementation - (def order ..order) - (def succ - (..composite ..milli_second)) - (def pred - (..composite (..inverse ..milli_second))))) diff --git a/stdlib/source/library/lux/time/instant.lux b/stdlib/source/library/lux/time/instant.lux deleted file mode 100644 index 2f08a6833..000000000 --- a/stdlib/source/library/lux/time/instant.lux +++ /dev/null @@ -1,230 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - [equivalence (.only Equivalence)] - [order (.only Order)] - [enum (.only Enum)] - [codec (.only Codec)] - [monad (.only Monad do)]] - [control - [io (.only IO io)] - ["<>" parser (.only)] - ["[0]" maybe] - ["[0]" try]] - [data - ["[0]" text (.use "[1]#[0]" monoid) - ["<[1]>" \\parser (.only Parser)]]] - [math - [number - ["i" int] - ["f" frac]]] - [meta - ["@" target] - [type - [primitive (.except)]]]]] - ["[0]" // (.only Time) - ["[0]" duration (.only Duration)] - ["[0]" year (.only Year)] - ["[0]" month (.only Month)] - ["[0]" day (.only Day)] - ["[0]" date (.only Date)]]) - -(primitive .public Instant - Int - - (def .public of_millis - (-> Int Instant) - (|>> abstraction)) - - (def .public millis - (-> Instant Int) - (|>> representation)) - - (def .public (span from to) - (-> Instant Instant Duration) - (duration.of_millis (i.- (representation from) (representation to)))) - - (def .public (after duration instant) - (-> Duration Instant Instant) - (abstraction (i.+ (duration.millis duration) (representation instant)))) - - (def .public (relative instant) - (-> Instant Duration) - (|> instant representation duration.of_millis)) - - (def .public (absolute offset) - (-> Duration Instant) - (|> offset duration.millis abstraction)) - - (def .public equivalence - (Equivalence Instant) - (implementation - (def (= param subject) - (at i.equivalence = (representation param) (representation subject))))) - - (def .public order - (Order Instant) - (implementation - (def equivalence ..equivalence) - (def (< param subject) - (at i.order < (representation param) (representation subject))))) - - (`` (def .public enum - (Enum Instant) - (implementation - (def order ..order) - (,, (with_template [] - [(def - (|>> representation (at i.enum ) abstraction))] - - [succ] [pred] - ))))) - ) - -(def .public epoch - Instant - (..of_millis +0)) - -(def millis_per_day - (duration.ticks duration.milli_second duration.day)) - -(def (date_time instant) - (-> Instant [Date Duration]) - (let [offset (..millis instant) - bce? (i.< +0 offset) - [days day_time] (if bce? - (let [[days millis] (i./% ..millis_per_day offset)] - (case millis - +0 [days millis] - _ [(-- days) (i.+ ..millis_per_day millis)])) - (i./% ..millis_per_day offset))] - [(date.of_days days) - (duration.of_millis day_time)])) - -(with_template [ ] - [(def Text )] - - ["T" date_suffix] - ["Z" time_suffix] - ) - -(def (clock_time duration) - (-> Duration Time) - (|> (if (at duration.order < duration.empty duration) - (duration.composite duration.day duration) - duration) - duration.millis - .nat - //.of_millis - try.trusted)) - -(def (format instant) - (-> Instant Text) - (let [[date time] (..date_time instant) - time (..clock_time time)] - (all text#composite - (at date.codec encoded date) ..date_suffix - (at //.codec encoded time) ..time_suffix))) - -(def parser - (Parser Instant) - (do [! <>.monad] - [days (at ! each date.days date.parser) - _ (.this ..date_suffix) - time (at ! each //.millis //.parser) - _ (.this ..time_suffix)] - (in (|> (if (i.< +0 days) - (|> duration.day - (duration.up (.nat (i.* -1 days))) - duration.inverse) - (duration.up (.nat days) duration.day)) - (duration.composite (duration.up time duration.milli_second)) - ..absolute)))) - -(def .public codec - (Codec Text Instant) - (implementation - (def encoded ..format) - (def decoded (.result ..parser)))) - -(def .public now - (IO Instant) - (io (..of_millis (for @.old ("jvm invokestatic:java.lang.System:currentTimeMillis:") - @.jvm (|> ("jvm member invoke static" [] "java.lang.System" "currentTimeMillis" []) - ("jvm object cast") - (is (Primitive "java.lang.Long")) - (as Int)) - @.js (let [date ("js object new" ("js constant" "Date") [])] - (|> ("js object do" "getTime" date []) - (as Frac) - "lux f64 i64")) - @.python (let [time ("python import" "time")] - (|> ("python object do" "time" time []) - (as Frac) - (f.* +1,000.0) - "lux f64 i64")) - @.lua (|> ("lua apply" ("lua constant" "os.time") []) - (as Int) - (i.* +1,000)) - @.ruby (let [% ("ruby constant" "Time") - % ("ruby object do" "now" % [])] - (|> ("ruby object do" "to_f" % []) - (as Frac) - (f.* +1,000.0) - "lux f64 i64")) - @.php (|> ("php constant" "time") - "php apply" - (as Int) - (i.* +1,000)) - @.scheme (|> ("scheme constant" "current-second") - (as Int) - (i.* +1,000) - ("scheme apply" ("scheme constant" "exact")) - ("scheme apply" ("scheme constant" "truncate"))) - @.common_lisp (|> ("common_lisp constant" "get-universal-time") - "common_lisp apply" - (as Int) - (i.* +1,000)) - )))) - -(with_template [ ] - [(def .public ( instant) - (-> Instant ) - (let [[date time] (..date_time instant)] - (|> )))] - - [date Date (|>)] - [time Time ..clock_time] - ) - -(def .public (day_of_week instant) - (-> Instant Day) - (let [offset (..relative instant) - days (duration.ticks duration.day offset) - day_time (duration.framed duration.day offset) - days (if (and (duration.negative? offset) - (not (duration.neutral? day_time))) - (-- days) - days) - ... 1970/01/01 was a Thursday - y1970m0d0 +4] - (case (|> y1970m0d0 - (i.+ days) (i.% +7) - ... This is done to turn negative days into positive days. - (i.+ +7) (i.% +7)) - +0 {day.#Sunday} - +1 {day.#Monday} - +2 {day.#Tuesday} - +3 {day.#Wednesday} - +4 {day.#Thursday} - +5 {day.#Friday} - +6 {day.#Saturday} - _ (undefined)))) - -(def .public (of_date_time date time) - (-> Date Time Instant) - (|> (date.days date) - (i.* (duration.millis duration.day)) - (i.+ (.int (//.millis time))) - ..of_millis)) diff --git a/stdlib/source/library/lux/time/month.lux b/stdlib/source/library/lux/time/month.lux deleted file mode 100644 index c2e88c976..000000000 --- a/stdlib/source/library/lux/time/month.lux +++ /dev/null @@ -1,252 +0,0 @@ -(.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 [] - [[{} {}] - true]) - ([#January] - [#February] - [#March] - [#April] - [#May] - [#June] - [#July] - [#August] - [#September] - [#October] - [#November] - [#December]) - - _ - false)))) - -(with_expansions [ (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 [ ] - [{} - ]) - ())) - - (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 [ ] - [ - {try.#Success {}}]) - () - - _ - (exception.except ..invalid_month [number]))) - ) - -(def .public hash - (Hash Month) - (implementation - (def equivalence ..equivalence) - (def (hash month) - (case month - (^.with_template [ ] - [{} - ]) - ([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 [ ] - [{} - ]) - ([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 [] - [{} - (text.replaced "#" "" (template.text []))]) - ([..#January] - [..#February] - [..#March] - [..#April] - [..#May] - [..#June] - [..#July] - [..#August] - [..#September] - [..#October] - [..#November] - [..#December]))) - (def (decoded value) - (case (text#composite "#" value) - (^.with_template [] - [(template.text []) - {try.#Success {}}]) - ([..#January] - [..#February] - [..#March] - [..#April] - [..#May] - [..#June] - [..#July] - [..#August] - [..#September] - [..#October] - [..#November] - [..#December]) - _ (exception.except ..not_a_month_of_the_year [value]))))) diff --git a/stdlib/source/library/lux/time/year.lux b/stdlib/source/library/lux/time/year.lux deleted file mode 100644 index a7bdb0dcf..000000000 --- a/stdlib/source/library/lux/time/year.lux +++ /dev/null @@ -1,143 +0,0 @@ -(.require - [library - [lux (.except) - [abstract - [monad (.only do)] - [codec (.only Codec)] - [equivalence (.only Equivalence)] - [order (.only Order)]] - [control - ["<>" parser (.only)] - ["[0]" try (.only Try)] - ["[0]" exception (.only exception)]] - [data - ["[0]" text (.use "[1]#[0]" monoid) - ["<[1]>" \\parser (.only Parser)]]] - [math - [number - ["n" nat (.use "[1]#[0]" decimal)] - ["i" int (.use "[1]#[0]" decimal)]]] - [meta - [type - [primitive (.except)]]]]]) - -(def (internal year) - (-> Int Int) - (if (i.< +0 year) - (++ year) - year)) - -(def (external year) - (-> Int Int) - (if (i.> +0 year) - year - (-- year))) - -(exception .public there_is_no_year_0) - -... https://en.wikipedia.org/wiki/Gregorian_calendar -(primitive .public Year - Int - - (def .public (year value) - (-> Int (Try Year)) - (case value - +0 (exception.except ..there_is_no_year_0 []) - _ {try.#Success (abstraction (..internal value))})) - - (def .public value - (-> Year Int) - (|>> representation ..external)) - - (def .public epoch - Year - (abstraction +1970)) - ) - -(def .public days - Nat - 365) - -(type .public Period - Nat) - -(with_template [ ] - [(def .public - Period - )] - - [004 leap] - [100 century] - [400 era] - ) - -(def (divisible? factor input) - (-> Int Int Bit) - (|> input (i.% factor) (i.= +0))) - -... https://en.wikipedia.org/wiki/Leap_year#Algorithm -(def .public (leap? year) - (-> Year Bit) - (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)] - (if after_year_0? - (i.+ +1 days) - days))) - -(def .public (leaps year) - (-> Year Int) - (let [year (|> year ..value ..internal) - limit (if (i.> +0 year) - (-- year) - (++ year))] - (`` (|> +0 - (,, (with_template [ ] - [( (i./ (.int ) limit))] - - [i.+ ..leap] - [i.- ..century] - [i.+ ..era] - )) - (..with_year_0_leap year))))) - -(def (encoded year) - (-> Year Text) - (let [year (..value year)] - (if (i.< +0 year) - (i#encoded year) - (n#encoded (.nat year))))) - -(def .public parser - (Parser Year) - (do [! <>.monad] - [sign (<>.or (.this "-") (in [])) - digits (.many .decimal) - raw_year (<>.codec i.decimal (in (text#composite "+" digits)))] - (<>.lifted (..year (case sign - {.#Left _} (i.* -1 raw_year) - {.#Right _} raw_year))))) - -(def .public codec - (Codec Text Year) - (implementation - (def encoded ..encoded) - (def decoded (.result ..parser)))) - -(def .public equivalence - (Equivalence Year) - (implementation - (def (= reference subject) - (i.= (..value reference) (..value subject))))) - -(def .public order - (Order Year) - (implementation - (def equivalence ..equivalence) - - (def (< reference subject) - (i.< (..value reference) (..value subject))))) diff --git a/stdlib/source/library/lux/world/db/jdbc/input.lux b/stdlib/source/library/lux/world/db/jdbc/input.lux index fb8f9b3e3..713a108de 100644 --- a/stdlib/source/library/lux/world/db/jdbc/input.lux +++ b/stdlib/source/library/lux/world/db/jdbc/input.lux @@ -7,10 +7,10 @@ [monad (.only Monad do)] ["[0]" try (.only Try)] ["[0]" io (.only IO)]] - [time - ["[0]" instant (.only Instant)]] [world - [binary (.only Binary)]]]]) + [binary (.only Binary)] + [time + ["[0]" instant (.only Instant)]]]]]) (import java/lang/String) diff --git a/stdlib/source/library/lux/world/db/jdbc/output.lux b/stdlib/source/library/lux/world/db/jdbc/output.lux index 6a9181636..383f565dc 100644 --- a/stdlib/source/library/lux/world/db/jdbc/output.lux +++ b/stdlib/source/library/lux/world/db/jdbc/output.lux @@ -9,10 +9,10 @@ ["ex" exception] ["[0]" try (.only Try)] ["[0]" io (.only IO)]] - [time - ["[0]" instant (.only Instant)]] [world - [binary (.only Binary)]]]]) + [binary (.only Binary)] + [time + ["[0]" instant (.only Instant)]]]]]) (import java/lang/String) diff --git a/stdlib/source/library/lux/world/file.lux b/stdlib/source/library/lux/world/file.lux index 560ae9e4e..cb8c48307 100644 --- a/stdlib/source/library/lux/world/file.lux +++ b/stdlib/source/library/lux/world/file.lux @@ -34,10 +34,11 @@ [meta ["@" target] [macro - ["[0]" template]]] - [time - ["[0]" instant (.only Instant)] - ["[0]" duration]]]]))) + ["[0]" template]]]]] + [// + [time + ["[0]" instant (.only Instant)] + ["[0]" duration]]]))) (type .public Path Text) diff --git a/stdlib/source/library/lux/world/file/watch.lux b/stdlib/source/library/lux/world/file/watch.lux index fac39061f..91cd25c53 100644 --- a/stdlib/source/library/lux/world/file/watch.lux +++ b/stdlib/source/library/lux/world/file/watch.lux @@ -26,12 +26,13 @@ [math [number ["n" nat]]] - [time - ["[0]" instant (.only Instant) (.use "[1]#[0]" equivalence)]] [meta ["@" target] [type - [primitive (.only primitive representation abstraction)]]]]] + [primitive (.only primitive representation abstraction)]]] + [world + [time + ["[0]" instant (.only Instant) (.use "[1]#[0]" equivalence)]]]]] ["[0]" //]) (primitive .public Concern diff --git a/stdlib/source/library/lux/world/net/http/cookie.lux b/stdlib/source/library/lux/world/net/http/cookie.lux index ffad57e2c..a87addd69 100644 --- a/stdlib/source/library/lux/world/net/http/cookie.lux +++ b/stdlib/source/library/lux/world/net/http/cookie.lux @@ -15,8 +15,9 @@ ["[0]" context (.only Context)]] [collection ["[0]" dictionary]]] - [time - ["[0]" duration (.only Duration)]]]] + [world + [time + ["[0]" duration (.only Duration)]]]]] ["[0]" // (.only Header) ["[0]" header]]) diff --git a/stdlib/source/library/lux/world/time.lux b/stdlib/source/library/lux/world/time.lux new file mode 100644 index 000000000..d24e87497 --- /dev/null +++ b/stdlib/source/library/lux/world/time.lux @@ -0,0 +1,215 @@ +(.require + [library + [lux (.except) + [abstract + [equivalence (.only Equivalence)] + [order (.only Order)] + [enum (.only Enum)] + [codec (.only Codec)] + [monad (.only Monad do)]] + [control + ["<>" parser (.only)] + ["[0]" pipe] + ["[0]" try (.only Try)] + ["[0]" exception (.only exception)]] + [data + ["[0]" text (.use "[1]#[0]" monoid) + ["<[1]>" \\parser (.only Parser)]]] + [math + [number + ["n" nat (.use "[1]#[0]" decimal)]]] + [meta + [type + [primitive (.except)]]]]] + [/ + ["[0]" duration (.only Duration)]]) + +(with_template [ ] + [(def .public + Nat + (.nat (duration.ticks )))] + + [milli_seconds duration.milli_second duration.second] + [seconds duration.second duration.minute] + [minutes duration.minute duration.hour] + [hours duration.hour duration.day] + ) + +(def limit + Nat + (.nat (duration.millis duration.day))) + +(exception .public (time_exceeds_a_day [time Nat]) + (exception.report + (list ["Time (in milli-seconds)" (n#encoded time)] + ["Maximum (in milli-seconds)" (n#encoded (-- limit))]))) + +(def separator ":") + +(def section_parser + (Parser Nat) + (<>.codec n.decimal (.exactly 2 .decimal))) + +(def millis_parser + (Parser Nat) + (<>.either (|> (.at_most 3 .decimal) + (<>.codec n.decimal) + (<>.after (.this "."))) + (at <>.monad in 0))) + +(with_template [ ] + [(exception .public ( [value Nat]) + (exception.report + (list ["Value" (n#encoded value)] + ["Minimum" (n#encoded 0)] + ["Maximum" (n#encoded (-- ))]))) + + (def + (Parser Nat) + (do <>.monad + [value ] + (if (n.< value) + (in value) + (<>.lifted (exception.except [value])))))] + + [..hours hour_parser invalid_hour ..section_parser] + [..minutes minute_parser invalid_minute ..section_parser] + [..seconds second_parser invalid_second ..section_parser] + ) + +(primitive .public Time + Nat + + (def .public midnight + Time + (abstraction 0)) + + (def .public (of_millis milli_seconds) + (-> Nat (Try Time)) + (if (n.< ..limit milli_seconds) + {try.#Success (abstraction milli_seconds)} + (exception.except ..time_exceeds_a_day [milli_seconds]))) + + (def .public millis + (-> Time Nat) + (|>> representation)) + + (def .public equivalence + (Equivalence Time) + (implementation + (def (= param subject) + (n.= (representation param) (representation subject))))) + + (def .public order + (Order Time) + (implementation + (def equivalence ..equivalence) + + (def (< param subject) + (n.< (representation param) (representation subject))))) + + (`` (def .public enum + (Enum Time) + (implementation + (def order ..order) + + (def succ + (|>> representation ++ (n.% ..limit) abstraction)) + + (def pred + (|>> representation + (pipe.case + 0 ..limit + millis millis) + -- + abstraction))))) + + (def .public parser + (Parser Time) + (let [millis (is (-> Duration Nat) + (|>> duration.millis .nat)) + hour (millis duration.hour) + minute (millis duration.minute) + second (millis duration.second) + millis (millis duration.milli_second)] + (do [! <>.monad] + [utc_hour ..hour_parser + _ (.this ..separator) + utc_minute ..minute_parser + _ (.this ..separator) + utc_second ..second_parser + utc_millis ..millis_parser] + (in (abstraction + (all n.+ + (n.* utc_hour hour) + (n.* utc_minute minute) + (n.* utc_second second) + (n.* utc_millis millis))))))) + ) + +(def (padded value) + (-> Nat Text) + (if (n.< 10 value) + (text#composite "0" (n#encoded value)) + (n#encoded value))) + +(def (positive space duration) + (-> Duration Duration Duration) + (if (duration.negative? duration) + (duration.composite space duration) + duration)) + +(def (millis_format millis) + (-> Nat Text) + (cond (n.= 0 millis) "" + (n.< 10 millis) (all text#composite ".00" (n#encoded millis)) + (n.< 100 millis) (all text#composite ".0" (n#encoded millis)) + ... (n.< 1,000 millis) + (all text#composite "." (n#encoded millis)))) + +(type .public Clock + (Record + [#hour Nat + #minute Nat + #second Nat + #milli_second Nat])) + +(def .public (clock time) + (-> Time Clock) + (let [time (|> time ..millis .int duration.of_millis) + [hours time] [(duration.ticks duration.hour time) (duration.framed duration.hour time)] + [minutes time] [(duration.ticks duration.minute time) (duration.framed duration.minute time)] + [seconds millis] [(duration.ticks duration.second time) (duration.framed duration.second time)]] + [#hour (.nat hours) + #minute (.nat minutes) + #second (.nat seconds) + #milli_second (|> millis + (..positive duration.second) + duration.millis + .nat)])) + +(def .public (time clock) + (-> Clock (Try Time)) + (|> (all duration.composite + (duration.up (the #hour clock) duration.hour) + (duration.up (the #minute clock) duration.minute) + (duration.up (the #second clock) duration.second) + (duration.of_millis (.int (the #milli_second clock)))) + duration.millis + .nat + ..of_millis)) + +(def (format time) + (-> Time Text) + (let [(open "_[0]") (..clock time)] + (all text#composite + (..padded _#hour) + ..separator (..padded _#minute) + ..separator (..padded _#second) + (..millis_format _#milli_second)))) + +(def .public codec + (Codec Text Time) + (implementation + (def encoded ..format) + (def decoded (.result ..parser)))) diff --git a/stdlib/source/library/lux/world/time/date.lux b/stdlib/source/library/lux/world/time/date.lux new file mode 100644 index 000000000..09fd828ae --- /dev/null +++ b/stdlib/source/library/lux/world/time/date.lux @@ -0,0 +1,353 @@ +(.require + [library + [lux (.except) + [abstract + [equivalence (.only Equivalence)] + [order (.only Order)] + [enum (.only Enum)] + [codec (.only Codec)] + [monad (.only do)]] + [control + ["<>" parser (.only)] + ["[0]" maybe] + ["[0]" try (.only Try)] + ["[0]" exception (.only exception)]] + [data + ["[0]" text (.use "[1]#[0]" monoid) + ["<[1]>" \\parser (.only Parser)]] + [collection + ["[0]" list (.use "[1]#[0]" mix)] + ["[0]" dictionary (.only Dictionary)]]] + [math + [number + ["n" nat (.use "[1]#[0]" decimal)] + ["i" int]]] + [meta + [type + [primitive (.except)]]]]] + ["[0]" // + ["[1][0]" year (.only Year)] + ["[1][0]" month (.only Month)]]) + +(def month_by_number + (Dictionary Nat Month) + (list#mix (function (_ month mapping) + (dictionary.has (//month.number month) month mapping)) + (dictionary.empty n.hash) + //month.year)) + +(def minimum_day + 1) + +(def (month_days year month) + (-> Year Month Nat) + (if (//year.leap? year) + (//month.leap_year_days month) + (//month.days month))) + +(def (invalid_day? year month day) + (-> Year Month Nat Bit) + (or (n.< ..minimum_day day) + (n.> (..month_days year month) day))) + +(exception .public (invalid_day [year Year + month Month + day Nat]) + (exception.report + (list ["Value" (n#encoded day)] + ["Minimum" (n#encoded ..minimum_day)] + ["Maximum" (n#encoded (..month_days year month))] + ["Year" (at //year.codec encoded year)] + ["Month" (n#encoded (//month.number month))]))) + +(def (padded value) + (-> Nat Text) + (let [digits (n#encoded value)] + (if (n.< 10 value) + (text#composite "0" digits) + digits))) + +(def separator + "-") + +(primitive .public Date + (Record + [#year Year + #month Month + #day Nat]) + + (def .public (date year month day_of_month) + (-> Year Month Nat (Try Date)) + (if (..invalid_day? year month day_of_month) + (exception.except ..invalid_day [year month day_of_month]) + {try.#Success + (abstraction + [#year year + #month month + #day day_of_month])})) + + (def .public epoch + Date + (try.trusted + (..date //year.epoch + {//month.#January} + ..minimum_day))) + + (with_template [ ] + [(def .public + (-> Date ) + (|>> representation (the )))] + + [year Year #year] + [month Month #month] + [day_of_month Nat #day] + ) + + (def .public equivalence + (Equivalence Date) + (implementation + (def (= reference sample) + (let [reference (representation reference) + sample (representation sample)] + (and (at //year.equivalence = + (the #year reference) + (the #year sample)) + (at //month.equivalence = + (the #month reference) + (the #month sample)) + (n.= (the #day reference) + (the #day sample))))))) + + (def .public order + (Order Date) + (implementation + (def equivalence ..equivalence) + + (def (< reference sample) + (let [reference (representation reference) + sample (representation sample)] + (or (at //year.order < + (the #year reference) + (the #year sample)) + (and (at //year.equivalence = + (the #year reference) + (the #year sample)) + (or (at //month.order < + (the #month reference) + (the #month sample)) + (and (at //month.order = + (the #month reference) + (the #month sample)) + (n.< (the #day reference) + (the #day sample)))))))))) + ) + +(def section_parser + (Parser Nat) + (<>.codec n.decimal (.exactly 2 .decimal))) + +(def millis_parser + (Parser Nat) + (<>.either (|> (.at_most 3 .decimal) + (<>.codec n.decimal) + (<>.after (.this "."))) + (at <>.monad in 0))) + +(with_template [ ] + [(exception .public ( [value Nat]) + (exception.report + (list ["Value" (n#encoded value)] + ["Minimum" (n#encoded )] + ["Maximum" (n#encoded )]))) + + (def + (Parser Nat) + (do <>.monad + [value ..section_parser] + (if (or (n.< value) + (n.> value)) + (<>.lifted (exception.except [value])) + (in value))))] + + [1 12 month_parser invalid_month] + ) + +(def .public parser + (Parser Date) + (do <>.monad + [utc_year //year.parser + _ (.this ..separator) + utc_month ..month_parser + _ (.this ..separator) + .let [month (maybe.trusted (dictionary.value utc_month ..month_by_number))] + utc_day ..section_parser] + (<>.lifted (..date utc_year month utc_day)))) + +(def (format value) + (-> Date Text) + (all text#composite + (at //year.codec encoded (..year value)) + ..separator (..padded (|> value ..month //month.number)) + ..separator (..padded (..day_of_month value)))) + +(def .public codec + (Codec Text Date) + (implementation + (def encoded ..format) + (def decoded (.result ..parser)))) + +(def days_per_leap + (|> //year.days + (n.* 4) + (n.+ 1))) + +(def days_per_century + (let [leaps_per_century (n./ //year.leap + //year.century)] + (|> //year.century + (n.* //year.days) + (n.+ leaps_per_century) + (n.- 1)))) + +(def days_per_era + (let [centuries_per_era (n./ //year.century + //year.era)] + (|> centuries_per_era + (n.* ..days_per_century) + (n.+ 1)))) + +(def days_since_epoch + (let [years::70 70 + leaps::70 (n./ //year.leap + years::70) + days::70 (|> years::70 + (n.* //year.days) + (n.+ leaps::70)) + ... The epoch is being calculated from March 1st, instead of January 1st. + january_&_february (n.+ (//month.days {//month.#January}) + (//month.days {//month.#February}))] + (|> 0 + ... 1600/01/01 + (n.+ (n.* 4 days_per_era)) + ... 1900/01/01 + (n.+ (n.* 3 days_per_century)) + ... 1970/01/01 + (n.+ days::70) + ... 1970/03/01 + (n.- january_&_february)))) + +(def first_month_of_civil_year 3) + +(with_expansions [ +3 + +9] + (def (internal_month civil_month) + (-> Nat Int) + (if (n.< ..first_month_of_civil_year civil_month) + (i.+ (.int civil_month)) + (i.- (.int civil_month)))) + + (def (civil_month internal_month) + (-> Int Nat) + (.nat (if (i.< +10 internal_month) + (i.+ internal_month) + (i.- internal_month))))) + +(with_expansions [ +153 + +2 + +5] + (def day_of_year_from_month + (-> Nat Int) + (|>> ..internal_month + (i.* ) + (i.+ ) + (i./ ))) + + (def month_from_day_of_year + (-> Int Nat) + (|>> (i.* ) + (i.+ ) + (i./ ) + ..civil_month))) + +(def last_era_leap_day + (.int (-- ..days_per_leap))) + +(def last_era_day + (.int (-- ..days_per_era))) + +(def (civil_year utc_month utc_year) + (-> Nat Year Int) + (let [... Coercing, because the year is already in external form. + utc_year (as Int utc_year)] + (if (n.< ..first_month_of_civil_year utc_month) + (-- utc_year) + utc_year))) + +... http://howardhinnant.github.io/date_algorithms.html +(def .public (days date) + (-> Date Int) + (let [utc_month (|> date ..month //month.number) + civil_year (..civil_year utc_month (..year date)) + era (|> (if (i.< +0 civil_year) + (i.- (.int (-- //year.era)) + civil_year) + civil_year) + (i./ (.int //year.era))) + year_of_era (i.- (i.* (.int //year.era) + era) + civil_year) + day_of_year (|> utc_month + ..day_of_year_from_month + (i.+ (.int (-- (..day_of_month date))))) + day_of_era (|> day_of_year + (i.+ (i.* (.int //year.days) year_of_era)) + (i.+ (i./ (.int //year.leap) year_of_era)) + (i.- (i./ (.int //year.century) year_of_era)))] + (|> (i.* (.int ..days_per_era) era) + (i.+ day_of_era) + (i.- (.int ..days_since_epoch))))) + +... http://howardhinnant.github.io/date_algorithms.html +(def .public (of_days days) + (-> Int Date) + (let [days (i.+ (.int ..days_since_epoch) days) + era (|> (if (i.< +0 days) + (i.- ..last_era_day days) + days) + (i./ (.int ..days_per_era))) + day_of_era (i.- (i.* (.int ..days_per_era) era) days) + year_of_era (|> day_of_era + (i.- (i./ ..last_era_leap_day day_of_era)) + (i.+ (i./ (.int ..days_per_century) day_of_era)) + (i.- (i./ ..last_era_day day_of_era)) + (i./ (.int //year.days))) + year (i.+ (i.* (.int //year.era) era) + year_of_era) + day_of_year (|> day_of_era + (i.- (i.* (.int //year.days) year_of_era)) + (i.- (i./ (.int //year.leap) year_of_era)) + (i.+ (i./ (.int //year.century) year_of_era))) + month (..month_from_day_of_year day_of_year) + day (|> day_of_year + (i.- (..day_of_year_from_month month)) + (i.+ +1) + .nat) + year (if (n.< ..first_month_of_civil_year month) + (++ year) + year)] + ... Coercing, because the year is already in internal form. + (try.trusted + (..date (as Year year) + (maybe.trusted (dictionary.value month ..month_by_number)) + day)))) + +(def .public enum + (Enum Date) + (implementation + (def order ..order) + + (def succ + (|>> ..days ++ ..of_days)) + + (def pred + (|>> ..days -- ..of_days)))) 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 [] + [[{} {}] + #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 [] + [{} + (text.replaced "#" "" (template.text []))]) + ([..#Monday] + [..#Tuesday] + [..#Wednesday] + [..#Thursday] + [..#Friday] + [..#Saturday] + [..#Sunday]))) + (def (decoded value) + (case (text#composite "#" value) + (^.with_template [] + [(template.text []) + {try.#Success {}}]) + ([..#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 [ (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 [ ] + [{} + ]) + ())) + + (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 [ ] + [ + {try.#Success {}}]) + () + + _ + (exception.except ..invalid_day [number]))) + ) + +(def .public hash + (Hash Day) + (implementation + (def equivalence ..equivalence) + (def (hash day) + (case day + (^.with_template [ ] + [{} + ]) + ([02 #Sunday] + [03 #Monday] + [05 #Tuesday] + [07 #Wednesday] + [11 #Thursday] + [13 #Friday] + [17 #Saturday]))))) diff --git a/stdlib/source/library/lux/world/time/duration.lux b/stdlib/source/library/lux/world/time/duration.lux new file mode 100644 index 000000000..00a7c1d1e --- /dev/null +++ b/stdlib/source/library/lux/world/time/duration.lux @@ -0,0 +1,202 @@ +(.require + [library + [lux (.except) + [abstract + [equivalence (.only Equivalence)] + [order (.only Order)] + [enum (.only Enum)] + [codec (.only Codec)] + [monoid (.only Monoid)] + [monad (.only do)]] + [control + ["<>" parser (.only)] + ["[0]" try]] + [data + ["[0]" text (.use "[1]#[0]" monoid) + ["<[1]>" \\parser (.only Parser)]]] + [math + [number + ["i" int] + ["[0]" nat (.use "[1]#[0]" decimal)]]] + [meta + [type + [primitive (.except)]]]]] + ["[0]" // + ["[1][0]" year]]) + +(primitive .public Duration + Int + + (def .public of_millis + (-> Int Duration) + (|>> abstraction)) + + (def .public millis + (-> Duration Int) + (|>> representation)) + + (with_template [ ] + [(def .public ( param subject) + (-> Duration Duration Duration) + (abstraction ( (representation param) (representation subject))))] + + [i.+ composite] + [i.% framed] + ) + + (with_template [ ] + [(def .public ( scalar) + (-> Nat Duration Duration) + (|>> representation ( (.int scalar)) abstraction))] + + [i.* up] + [i./ down] + ) + + (def .public inverse + (-> Duration Duration) + (|>> representation (i.* -1) abstraction)) + + (def .public (ticks param subject) + (-> Duration Duration Int) + (i./ (representation param) (representation subject))) + + (def .public equivalence + (Equivalence Duration) + (implementation + (def (= param subject) + (i.= (representation param) (representation subject))))) + + (def .public order + (Order Duration) + (implementation + (def equivalence ..equivalence) + (def (< param subject) + (i.< (representation param) (representation subject))))) + + (with_template [ ] + [(def .public + (-> Duration Bit) + (|>> representation ( +0)))] + + [i.> positive?] + [i.< negative?] + [i.= neutral?] + ) + ) + +(def .public empty + (..of_millis +0)) + +(def .public milli_second + (..of_millis +1)) + +(with_template [ ] + [(def .public + (..up ))] + + [second 1,000 milli_second] + [minute 60 second] + [hour 60 minute] + [day 24 hour] + + [week 7 day] + [normal_year //year.days day] + ) + +(def .public leap_year + (..composite ..day ..normal_year)) + +(def .public monoid + (Monoid Duration) + (implementation + (def identity ..empty) + (def composite ..composite))) + +(with_template [ ] + [(def )] + + ["D" day_suffix] + ["h" hour_suffix] + ["m" minute_suffix] + ["s" second_suffix] + ["ms" milli_second_suffix] + + ["+" positive_sign] + ["-" negative_sign] + ) + +(def (encoded duration) + (if (at ..equivalence = ..empty duration) + (all text#composite + ..positive_sign + (nat#encoded 0) + ..milli_second_suffix) + (let [signed? (negative? duration) + [days time_left] [(ticks day duration) (framed day duration)] + days (if signed? + (i.abs days) + days) + time_left (if signed? + (..inverse time_left) + time_left) + [hours time_left] [(ticks hour time_left) (framed hour time_left)] + [minutes time_left] [(ticks minute time_left) (framed minute time_left)] + [seconds time_left] [(ticks second time_left) (framed second time_left)] + millis (..millis time_left)] + (all text#composite + (if signed? ..negative_sign ..positive_sign) + (if (i.= +0 days) "" (text#composite (nat#encoded (.nat days)) ..day_suffix)) + (if (i.= +0 hours) "" (text#composite (nat#encoded (.nat hours)) ..hour_suffix)) + (if (i.= +0 minutes) "" (text#composite (nat#encoded (.nat minutes)) ..minute_suffix)) + (if (i.= +0 seconds) "" (text#composite (nat#encoded (.nat seconds)) ..second_suffix)) + (if (i.= +0 millis) "" (text#composite (nat#encoded (.nat millis)) ..milli_second_suffix)) + )))) + +(def parser + (Parser Duration) + (let [section (is (-> Text Text (Parser Nat)) + (function (_ suffix false_suffix) + (|> (.many .decimal) + (<>.codec nat.decimal) + (<>.before (case false_suffix + "" (.this suffix) + _ (<>.after (<>.not (.this false_suffix)) + (.this suffix)))) + (<>.else 0))))] + (do <>.monad + [sign (<>.or (.this ..negative_sign) + (.this ..positive_sign)) + days (section ..day_suffix "") + hours (section hour_suffix "") + minutes (section ..minute_suffix ..milli_second_suffix) + seconds (section ..second_suffix "") + millis (section ..milli_second_suffix "") + .let [span (|> ..empty + (..composite (..up days ..day)) + (..composite (..up hours ..hour)) + (..composite (..up minutes ..minute)) + (..composite (..up seconds ..second)) + (..composite (..up millis ..milli_second)))]] + (in (case sign + {.#Left _} (..inverse span) + {.#Right _} span))))) + +(def .public codec + (Codec Text Duration) + (implementation + (def encoded ..encoded) + (def decoded (.result ..parser)))) + +(def .public (difference from to) + (-> Duration Duration Duration) + (|> from ..inverse (..composite to))) + +(def .public enum + (Enum Duration) + (implementation + (def order ..order) + (def succ + (..composite ..milli_second)) + (def pred + (..composite (..inverse ..milli_second))))) diff --git a/stdlib/source/library/lux/world/time/instant.lux b/stdlib/source/library/lux/world/time/instant.lux new file mode 100644 index 000000000..2f08a6833 --- /dev/null +++ b/stdlib/source/library/lux/world/time/instant.lux @@ -0,0 +1,230 @@ +(.require + [library + [lux (.except) + [abstract + [equivalence (.only Equivalence)] + [order (.only Order)] + [enum (.only Enum)] + [codec (.only Codec)] + [monad (.only Monad do)]] + [control + [io (.only IO io)] + ["<>" parser (.only)] + ["[0]" maybe] + ["[0]" try]] + [data + ["[0]" text (.use "[1]#[0]" monoid) + ["<[1]>" \\parser (.only Parser)]]] + [math + [number + ["i" int] + ["f" frac]]] + [meta + ["@" target] + [type + [primitive (.except)]]]]] + ["[0]" // (.only Time) + ["[0]" duration (.only Duration)] + ["[0]" year (.only Year)] + ["[0]" month (.only Month)] + ["[0]" day (.only Day)] + ["[0]" date (.only Date)]]) + +(primitive .public Instant + Int + + (def .public of_millis + (-> Int Instant) + (|>> abstraction)) + + (def .public millis + (-> Instant Int) + (|>> representation)) + + (def .public (span from to) + (-> Instant Instant Duration) + (duration.of_millis (i.- (representation from) (representation to)))) + + (def .public (after duration instant) + (-> Duration Instant Instant) + (abstraction (i.+ (duration.millis duration) (representation instant)))) + + (def .public (relative instant) + (-> Instant Duration) + (|> instant representation duration.of_millis)) + + (def .public (absolute offset) + (-> Duration Instant) + (|> offset duration.millis abstraction)) + + (def .public equivalence + (Equivalence Instant) + (implementation + (def (= param subject) + (at i.equivalence = (representation param) (representation subject))))) + + (def .public order + (Order Instant) + (implementation + (def equivalence ..equivalence) + (def (< param subject) + (at i.order < (representation param) (representation subject))))) + + (`` (def .public enum + (Enum Instant) + (implementation + (def order ..order) + (,, (with_template [] + [(def + (|>> representation (at i.enum ) abstraction))] + + [succ] [pred] + ))))) + ) + +(def .public epoch + Instant + (..of_millis +0)) + +(def millis_per_day + (duration.ticks duration.milli_second duration.day)) + +(def (date_time instant) + (-> Instant [Date Duration]) + (let [offset (..millis instant) + bce? (i.< +0 offset) + [days day_time] (if bce? + (let [[days millis] (i./% ..millis_per_day offset)] + (case millis + +0 [days millis] + _ [(-- days) (i.+ ..millis_per_day millis)])) + (i./% ..millis_per_day offset))] + [(date.of_days days) + (duration.of_millis day_time)])) + +(with_template [ ] + [(def Text )] + + ["T" date_suffix] + ["Z" time_suffix] + ) + +(def (clock_time duration) + (-> Duration Time) + (|> (if (at duration.order < duration.empty duration) + (duration.composite duration.day duration) + duration) + duration.millis + .nat + //.of_millis + try.trusted)) + +(def (format instant) + (-> Instant Text) + (let [[date time] (..date_time instant) + time (..clock_time time)] + (all text#composite + (at date.codec encoded date) ..date_suffix + (at //.codec encoded time) ..time_suffix))) + +(def parser + (Parser Instant) + (do [! <>.monad] + [days (at ! each date.days date.parser) + _ (.this ..date_suffix) + time (at ! each //.millis //.parser) + _ (.this ..time_suffix)] + (in (|> (if (i.< +0 days) + (|> duration.day + (duration.up (.nat (i.* -1 days))) + duration.inverse) + (duration.up (.nat days) duration.day)) + (duration.composite (duration.up time duration.milli_second)) + ..absolute)))) + +(def .public codec + (Codec Text Instant) + (implementation + (def encoded ..format) + (def decoded (.result ..parser)))) + +(def .public now + (IO Instant) + (io (..of_millis (for @.old ("jvm invokestatic:java.lang.System:currentTimeMillis:") + @.jvm (|> ("jvm member invoke static" [] "java.lang.System" "currentTimeMillis" []) + ("jvm object cast") + (is (Primitive "java.lang.Long")) + (as Int)) + @.js (let [date ("js object new" ("js constant" "Date") [])] + (|> ("js object do" "getTime" date []) + (as Frac) + "lux f64 i64")) + @.python (let [time ("python import" "time")] + (|> ("python object do" "time" time []) + (as Frac) + (f.* +1,000.0) + "lux f64 i64")) + @.lua (|> ("lua apply" ("lua constant" "os.time") []) + (as Int) + (i.* +1,000)) + @.ruby (let [% ("ruby constant" "Time") + % ("ruby object do" "now" % [])] + (|> ("ruby object do" "to_f" % []) + (as Frac) + (f.* +1,000.0) + "lux f64 i64")) + @.php (|> ("php constant" "time") + "php apply" + (as Int) + (i.* +1,000)) + @.scheme (|> ("scheme constant" "current-second") + (as Int) + (i.* +1,000) + ("scheme apply" ("scheme constant" "exact")) + ("scheme apply" ("scheme constant" "truncate"))) + @.common_lisp (|> ("common_lisp constant" "get-universal-time") + "common_lisp apply" + (as Int) + (i.* +1,000)) + )))) + +(with_template [ ] + [(def .public ( instant) + (-> Instant ) + (let [[date time] (..date_time instant)] + (|> )))] + + [date Date (|>)] + [time Time ..clock_time] + ) + +(def .public (day_of_week instant) + (-> Instant Day) + (let [offset (..relative instant) + days (duration.ticks duration.day offset) + day_time (duration.framed duration.day offset) + days (if (and (duration.negative? offset) + (not (duration.neutral? day_time))) + (-- days) + days) + ... 1970/01/01 was a Thursday + y1970m0d0 +4] + (case (|> y1970m0d0 + (i.+ days) (i.% +7) + ... This is done to turn negative days into positive days. + (i.+ +7) (i.% +7)) + +0 {day.#Sunday} + +1 {day.#Monday} + +2 {day.#Tuesday} + +3 {day.#Wednesday} + +4 {day.#Thursday} + +5 {day.#Friday} + +6 {day.#Saturday} + _ (undefined)))) + +(def .public (of_date_time date time) + (-> Date Time Instant) + (|> (date.days date) + (i.* (duration.millis duration.day)) + (i.+ (.int (//.millis time))) + ..of_millis)) 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 [] + [[{} {}] + true]) + ([#January] + [#February] + [#March] + [#April] + [#May] + [#June] + [#July] + [#August] + [#September] + [#October] + [#November] + [#December]) + + _ + false)))) + +(with_expansions [ (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 [ ] + [{} + ]) + ())) + + (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 [ ] + [ + {try.#Success {}}]) + () + + _ + (exception.except ..invalid_month [number]))) + ) + +(def .public hash + (Hash Month) + (implementation + (def equivalence ..equivalence) + (def (hash month) + (case month + (^.with_template [ ] + [{} + ]) + ([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 [ ] + [{} + ]) + ([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 [] + [{} + (text.replaced "#" "" (template.text []))]) + ([..#January] + [..#February] + [..#March] + [..#April] + [..#May] + [..#June] + [..#July] + [..#August] + [..#September] + [..#October] + [..#November] + [..#December]))) + (def (decoded value) + (case (text#composite "#" value) + (^.with_template [] + [(template.text []) + {try.#Success {}}]) + ([..#January] + [..#February] + [..#March] + [..#April] + [..#May] + [..#June] + [..#July] + [..#August] + [..#September] + [..#October] + [..#November] + [..#December]) + _ (exception.except ..not_a_month_of_the_year [value]))))) diff --git a/stdlib/source/library/lux/world/time/year.lux b/stdlib/source/library/lux/world/time/year.lux new file mode 100644 index 000000000..a7bdb0dcf --- /dev/null +++ b/stdlib/source/library/lux/world/time/year.lux @@ -0,0 +1,143 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)] + [codec (.only Codec)] + [equivalence (.only Equivalence)] + [order (.only Order)]] + [control + ["<>" parser (.only)] + ["[0]" try (.only Try)] + ["[0]" exception (.only exception)]] + [data + ["[0]" text (.use "[1]#[0]" monoid) + ["<[1]>" \\parser (.only Parser)]]] + [math + [number + ["n" nat (.use "[1]#[0]" decimal)] + ["i" int (.use "[1]#[0]" decimal)]]] + [meta + [type + [primitive (.except)]]]]]) + +(def (internal year) + (-> Int Int) + (if (i.< +0 year) + (++ year) + year)) + +(def (external year) + (-> Int Int) + (if (i.> +0 year) + year + (-- year))) + +(exception .public there_is_no_year_0) + +... https://en.wikipedia.org/wiki/Gregorian_calendar +(primitive .public Year + Int + + (def .public (year value) + (-> Int (Try Year)) + (case value + +0 (exception.except ..there_is_no_year_0 []) + _ {try.#Success (abstraction (..internal value))})) + + (def .public value + (-> Year Int) + (|>> representation ..external)) + + (def .public epoch + Year + (abstraction +1970)) + ) + +(def .public days + Nat + 365) + +(type .public Period + Nat) + +(with_template [ ] + [(def .public + Period + )] + + [004 leap] + [100 century] + [400 era] + ) + +(def (divisible? factor input) + (-> Int Int Bit) + (|> input (i.% factor) (i.= +0))) + +... https://en.wikipedia.org/wiki/Leap_year#Algorithm +(def .public (leap? year) + (-> Year Bit) + (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)] + (if after_year_0? + (i.+ +1 days) + days))) + +(def .public (leaps year) + (-> Year Int) + (let [year (|> year ..value ..internal) + limit (if (i.> +0 year) + (-- year) + (++ year))] + (`` (|> +0 + (,, (with_template [ ] + [( (i./ (.int ) limit))] + + [i.+ ..leap] + [i.- ..century] + [i.+ ..era] + )) + (..with_year_0_leap year))))) + +(def (encoded year) + (-> Year Text) + (let [year (..value year)] + (if (i.< +0 year) + (i#encoded year) + (n#encoded (.nat year))))) + +(def .public parser + (Parser Year) + (do [! <>.monad] + [sign (<>.or (.this "-") (in [])) + digits (.many .decimal) + raw_year (<>.codec i.decimal (in (text#composite "+" digits)))] + (<>.lifted (..year (case sign + {.#Left _} (i.* -1 raw_year) + {.#Right _} raw_year))))) + +(def .public codec + (Codec Text Year) + (implementation + (def encoded ..encoded) + (def decoded (.result ..parser)))) + +(def .public equivalence + (Equivalence Year) + (implementation + (def (= reference subject) + (i.= (..value reference) (..value subject))))) + +(def .public order + (Order Year) + (implementation + (def equivalence ..equivalence) + + (def (< reference subject) + (i.< (..value reference) (..value subject))))) diff --git a/stdlib/source/polytypic/lux/abstract/equivalence.lux b/stdlib/source/polytypic/lux/abstract/equivalence.lux index 50d04c8e0..64c684936 100644 --- a/stdlib/source/polytypic/lux/abstract/equivalence.lux +++ b/stdlib/source/polytypic/lux/abstract/equivalence.lux @@ -31,12 +31,13 @@ ["<[1]>" \\parser] ["[0]" poly (.only polytypic)] ["[0]" unit]]] - [time - ["[0]" duration] - ["[0]" date] - ["[0]" instant] - ["[0]" day] - ["[0]" month]]]] + [world + [time + ["[0]" duration] + ["[0]" date] + ["[0]" instant] + ["[0]" day] + ["[0]" month]]]]] [\\library ["[0]" /]]) diff --git a/stdlib/source/polytypic/lux/data/format/json.lux b/stdlib/source/polytypic/lux/data/format/json.lux index cae0194d4..c68d521ce 100644 --- a/stdlib/source/polytypic/lux/data/format/json.lux +++ b/stdlib/source/polytypic/lux/data/format/json.lux @@ -32,12 +32,13 @@ ["<[1]>" \\parser] ["[0]" unit] ["[0]" poly (.only polytypic)]]] - [time - ... ["[0]" instant] - ... ["[0]" duration] - ["[0]" date] - ["[0]" day] - ["[0]" month]]]] + [world + [time + ... ["[0]" instant] + ... ["[0]" duration] + ["[0]" date] + ["[0]" day] + ["[0]" month]]]]] [\\library ["[0]" / (.only JSON)]]) diff --git a/stdlib/source/program/aedifex/artifact/snapshot/time.lux b/stdlib/source/program/aedifex/artifact/snapshot/time.lux index 9acb04c63..b4fb82186 100644 --- a/stdlib/source/program/aedifex/artifact/snapshot/time.lux +++ b/stdlib/source/program/aedifex/artifact/snapshot/time.lux @@ -13,8 +13,9 @@ [format ["[0]" xml (.only XML) ["<[1]>" \\parser (.only Parser)]]]] - [time - ["[0]" instant (.only Instant)]]]] + [world + [time + ["[0]" instant (.only Instant)]]]]] ["[0]" /// ["[1][0]" time ["[1]/[0]" date] diff --git a/stdlib/source/program/aedifex/artifact/time.lux b/stdlib/source/program/aedifex/artifact/time.lux index 59e0ee3d1..764ae9b86 100644 --- a/stdlib/source/program/aedifex/artifact/time.lux +++ b/stdlib/source/program/aedifex/artifact/time.lux @@ -12,8 +12,9 @@ ["[0]" text ["%" \\format (.only Format)] ["<[1]>" \\parser (.only Parser)]]] - ["[0]" time (.only) - ["[0]" instant (.only Instant)]]]] + [world + ["[0]" time (.only) + ["[0]" instant (.only Instant)]]]]] ["[0]" / ["[1][0]" date] ["[1][0]" time]]) diff --git a/stdlib/source/program/aedifex/artifact/time/date.lux b/stdlib/source/program/aedifex/artifact/time/date.lux index 5cdbd0d1d..84e33836a 100644 --- a/stdlib/source/program/aedifex/artifact/time/date.lux +++ b/stdlib/source/program/aedifex/artifact/time/date.lux @@ -16,12 +16,14 @@ [number ["n" nat] ["i" int]]] - [time - ["[0]" date (.use "[1]#[0]" equivalence)] - ["[0]" year] - ["[0]" month]] - [type - [primitive (.except)]]]]) + [meta + [type + [primitive (.except)]]] + [world + [time + ["[0]" date (.use "[1]#[0]" equivalence)] + ["[0]" year] + ["[0]" month]]]]]) (def .public (pad value) (-> Nat Text) diff --git a/stdlib/source/program/aedifex/artifact/versioning.lux b/stdlib/source/program/aedifex/artifact/versioning.lux index 53e6824f0..9ccfd46ba 100644 --- a/stdlib/source/program/aedifex/artifact/versioning.lux +++ b/stdlib/source/program/aedifex/artifact/versioning.lux @@ -19,10 +19,11 @@ [math [number ["n" nat]]] - ["[0]" time (.only Time) - ["[0]" date (.only Date)] - ["[0]" year] - ["[0]" month]]]] + [world + ["[0]" time (.only Time) + ["[0]" date (.only Date)] + ["[0]" year] + ["[0]" month]]]]] ["[0]" // ["[1][0]" time] ["[1][0]" snapshot (.only Snapshot) diff --git a/stdlib/source/program/aedifex/dependency/deployment.lux b/stdlib/source/program/aedifex/dependency/deployment.lux index 6a2c64817..40d7e2532 100644 --- a/stdlib/source/program/aedifex/dependency/deployment.lux +++ b/stdlib/source/program/aedifex/dependency/deployment.lux @@ -19,8 +19,9 @@ ["[0]" dictionary] ["[0]" set (.only Set)] ["[0]" list (.use "[1]#[0]" monoid)]]] - [time - ["[0]" instant (.only Instant)]]]] + [world + [time + ["[0]" instant (.only Instant)]]]]] ["[0]" /// [repository (.only Repository)] ["[1][0]" hash (.only Hash)] diff --git a/stdlib/source/program/aedifex/metadata/artifact.lux b/stdlib/source/program/aedifex/metadata/artifact.lux index 3ddc320b2..5df1ae3a7 100644 --- a/stdlib/source/program/aedifex/metadata/artifact.lux +++ b/stdlib/source/program/aedifex/metadata/artifact.lux @@ -25,14 +25,14 @@ [math [number ["n" nat]]] - ["[0]" time (.only Time) - ["[0]" instant (.only Instant)] - ["[0]" date (.only Date)] - ["[0]" year] - ["[0]" month]] [world [net - ["[0]" uri (.only URI)]]]]] + ["[0]" uri (.only URI)]] + ["[0]" time (.only Time) + ["[0]" instant (.only Instant)] + ["[0]" date (.only Date)] + ["[0]" year] + ["[0]" month]]]]] ["[0]" // (.only) ["/[1]" // [repository (.only Repository)] diff --git a/stdlib/source/program/aedifex/metadata/snapshot.lux b/stdlib/source/program/aedifex/metadata/snapshot.lux index 78b0e8c55..7b3e4d5d0 100644 --- a/stdlib/source/program/aedifex/metadata/snapshot.lux +++ b/stdlib/source/program/aedifex/metadata/snapshot.lux @@ -25,14 +25,14 @@ [math [number ["n" nat]]] - ["[0]" time (.only Time) - ["[0]" instant (.only Instant)] - ["[0]" date (.only Date)] - ["[0]" year] - ["[0]" month]] [world [net - ["[0]" uri (.only URI)]]]]] + ["[0]" uri (.only URI)]] + ["[0]" time (.only Time) + ["[0]" instant (.only Instant)] + ["[0]" date (.only Date)] + ["[0]" year] + ["[0]" month]]]]] ["[0]" // (.only) ["/[1]" // [repository (.only Repository)] diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index ac17513ed..3b5150c7e 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -50,12 +50,12 @@ ["ioW" archive]]]] ... ["[0]" interpreter] ] - [time - ["[0]" instant]] ["[0]" world ["[0]" file] ["[0]" console] - ["[1]/[0]" environment]]]]) + ["[1]/[0]" environment] + [time + ["[0]" instant]]]]]) (def (or_crash! failure_description action) (All (_ a) diff --git a/stdlib/source/specification/lux/world/file.lux b/stdlib/source/specification/lux/world/file.lux index 607e7e2f6..dc6cb6528 100644 --- a/stdlib/source/specification/lux/world/file.lux +++ b/stdlib/source/specification/lux/world/file.lux @@ -26,8 +26,9 @@ ["[0]" random] [number ["n" nat]]] - [time - ["[0]" instant (.only Instant) (.use "[1]#[0]" equivalence)]]]] + [world + [time + ["[0]" instant (.only Instant) (.use "[1]#[0]" equivalence)]]]]] [\\library ["[0]" /]]) diff --git a/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux b/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux index da8755d6f..2b4265932 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux @@ -14,8 +14,9 @@ ["<[1]>" \\parser]]]] [math ["[0]" random (.only Random)]] - [time - ["[0]" instant]]]] + [world + [time + ["[0]" instant]]]]] [\\program ["[0]" /]] ["$[0]" // diff --git a/stdlib/source/test/aedifex/artifact/time.lux b/stdlib/source/test/aedifex/artifact/time.lux index c81dffa89..2c7d29269 100644 --- a/stdlib/source/test/aedifex/artifact/time.lux +++ b/stdlib/source/test/aedifex/artifact/time.lux @@ -15,8 +15,9 @@ ["[0]" random (.only Random)] [number ["i" int]]] - [time - ["[0]" instant (.use "[1]#[0]" equivalence)]]]] + [world + [time + ["[0]" instant (.use "[1]#[0]" equivalence)]]]]] [\\program ["[0]" /]] ["[0]" / diff --git a/stdlib/source/test/aedifex/command/auto.lux b/stdlib/source/test/aedifex/command/auto.lux index 564cf6ab0..8cc8177a1 100644 --- a/stdlib/source/test/aedifex/command/auto.lux +++ b/stdlib/source/test/aedifex/command/auto.lux @@ -24,14 +24,14 @@ ["[0]" random] [number ["n" nat]]] - [time - ["[0]" instant]] [world [console (.only Console)] ["[0]" shell (.only Exit Shell)] ["[0]" program (.only Program)] ["[0]" file - ["[0]" watch]]]]] + ["[0]" watch]] + [time + ["[0]" instant]]]]] ["[0]" // ["$[0]" version] ["$[0]" build]] diff --git a/stdlib/source/test/aedifex/metadata/artifact.lux b/stdlib/source/test/aedifex/metadata/artifact.lux index 17770c575..ed5b95b3b 100644 --- a/stdlib/source/test/aedifex/metadata/artifact.lux +++ b/stdlib/source/test/aedifex/metadata/artifact.lux @@ -26,15 +26,15 @@ ["n" nat]]] [meta ["[0]" code]] - ["[0]" time (.only) - ["[0]" date] - ["[0]" year] - ["[0]" month] - ["[0]" instant] - ["[0]" duration]] [world ["[0]" file] - ["[0]" program]]]] + ["[0]" program] + ["[0]" time (.only) + ["[0]" date] + ["[0]" year] + ["[0]" month] + ["[0]" instant] + ["[0]" duration]]]]] [\\program ["[0]" / (.only) ["/[1]" // (.only) diff --git a/stdlib/source/test/aedifex/metadata/snapshot.lux b/stdlib/source/test/aedifex/metadata/snapshot.lux index 46e368dbf..773dd262b 100644 --- a/stdlib/source/test/aedifex/metadata/snapshot.lux +++ b/stdlib/source/test/aedifex/metadata/snapshot.lux @@ -26,15 +26,15 @@ ["n" nat]]] [meta ["[0]" code]] - ["[0]" time (.only) - ["[0]" date] - ["[0]" year] - ["[0]" month] - ["[0]" instant (.only Instant)] - ["[0]" duration]] [world ["[0]" file] - ["[0]" program]]]] + ["[0]" program] + ["[0]" time (.only) + ["[0]" date] + ["[0]" year] + ["[0]" month] + ["[0]" instant (.only Instant)] + ["[0]" duration]]]]] ["$[0]" /// ["[1][0]" artifact ["[1]/[0]" type] diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index d9e4bbc29..7212f5fb4 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -55,7 +55,6 @@ ["[1][0]" static] ["[1][0]" test] - ["[1][0]" time] ["[1][0]" world] ["[1][0]" ffi] @@ -1213,7 +1212,6 @@ /static.test /test.test - /time.test /world.test /ffi.test diff --git a/stdlib/source/test/lux/control/concurrency/async.lux b/stdlib/source/test/lux/control/concurrency/async.lux index e5d175486..42d938ddd 100644 --- a/stdlib/source/test/lux/control/concurrency/async.lux +++ b/stdlib/source/test/lux/control/concurrency/async.lux @@ -18,9 +18,10 @@ ["[0]" i64]]] [meta ["@" target]] - [time - ["[0]" instant] - ["[0]" duration]]]] + [world + [time + ["[0]" instant] + ["[0]" duration]]]]] [\\library ["[0]" / (.only) [// diff --git a/stdlib/source/test/lux/control/concurrency/thread.lux b/stdlib/source/test/lux/control/concurrency/thread.lux index 87ba8859a..da2a9ea37 100644 --- a/stdlib/source/test/lux/control/concurrency/thread.lux +++ b/stdlib/source/test/lux/control/concurrency/thread.lux @@ -6,14 +6,15 @@ [monad (.only do)]] [control ["[0]" io]] - [time - ["[0]" instant (.only Instant)] - ["[0]" duration]] [math ["[0]" random] [number ["n" nat] - ["i" int]]]]] + ["i" int]]] + [world + [time + ["[0]" instant (.only Instant)] + ["[0]" duration]]]]] [\\library ["[0]" / (.only) [// diff --git a/stdlib/source/test/lux/control/function/memo.lux b/stdlib/source/test/lux/control/function/memo.lux index 1a310744f..1abe7f7f9 100644 --- a/stdlib/source/test/lux/control/function/memo.lux +++ b/stdlib/source/test/lux/control/function/memo.lux @@ -20,9 +20,10 @@ [meta [macro ["^" pattern]]] - [time - ["[0]" instant] - ["[0]" duration (.only Duration)]]]] + [world + [time + ["[0]" instant] + ["[0]" duration (.only Duration)]]]]] [\\library ["[0]" / (.only) ["/[1]" // diff --git a/stdlib/source/test/lux/control/remember.lux b/stdlib/source/test/lux/control/remember.lux index 83dc740e8..5f4fae4ac 100644 --- a/stdlib/source/test/lux/control/remember.lux +++ b/stdlib/source/test/lux/control/remember.lux @@ -20,10 +20,11 @@ ["<[1]>" \\parser]] ["[0]" macro (.only) ["[0]" syntax (.only syntax)]]] - [time - ["[0]" date (.only Date)] - ["[0]" instant] - ["[0]" duration]]]] + [world + [time + ["[0]" date (.only Date)] + ["[0]" instant] + ["[0]" duration]]]]] [\\library ["[0]" /]]) diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index bda5d1aba..e057efcfe 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -39,12 +39,13 @@ ["[0]" syntax (.only syntax)]] [type ["[0]" unit]]] - [time - ["[0]" date] - ["[0]" instant - ["[0]/[1]" \\test]] - ["[0]" duration - ["[0]/[1]" \\test]]]]] + [world + [time + ["[0]" date] + ["[0]" instant + ["[0]/[1]" \\test]] + ["[0]" duration + ["[0]/[1]" \\test]]]]]] ["[0]" \\polytypic] ["[0]" \\parser] [\\library diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index 7f695042d..5665efaec 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -29,9 +29,10 @@ [number ["n" nat] ["i" int]]] - [time - ["[0]" instant (.only Instant)] - ["[0]" duration]]]] + [world + [time + ["[0]" instant (.only Instant)] + ["[0]" duration]]]]] [\\library ["[0]" /]]) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index 82d998311..8aead4f9b 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -51,12 +51,13 @@ ["<[1]>" \\parser]] [macro ["^" pattern]]] - ["[0]" time (.only) - ["[0]" day] - ["[0]" month] - ["[0]" instant] - ["[0]" duration] - ["[0]" date]]]] + [world + ["[0]" time (.only) + ["[0]" day] + ["[0]" month] + ["[0]" instant] + ["[0]" duration] + ["[0]" date]]]]] ["$[0]" // [format ["[1][0]" xml] diff --git a/stdlib/source/test/lux/debug.lux b/stdlib/source/test/lux/debug.lux index ccf72208a..8dae4a18e 100644 --- a/stdlib/source/test/lux/debug.lux +++ b/stdlib/source/test/lux/debug.lux @@ -25,12 +25,13 @@ ["<[1]>" \\parser]] ["[0]" macro (.only) [syntax (.only syntax)]]] - [time (.only Time) - [instant (.only Instant)] - [date (.only Date)] - [duration (.only Duration)] - [month (.only Month)] - [day (.only Day)]]]] + [world + [time (.only Time) + [instant (.only Instant)] + [date (.only Date)] + [duration (.only Duration)] + [month (.only Month)] + [day (.only Day)]]]]] [\\library ["[0]" /]] ["$[0]" // diff --git a/stdlib/source/test/lux/time.lux b/stdlib/source/test/lux/time.lux deleted file mode 100644 index 62c3ec43c..000000000 --- a/stdlib/source/test/lux/time.lux +++ /dev/null @@ -1,157 +0,0 @@ -(.require - [library - [lux (.except) - ["_" test (.only Test)] - [abstract - [monad (.only do)] - [\\specification - ["$[0]" equivalence] - ["$[0]" order] - ["$[0]" enum] - ["$[0]" codec]]] - [control - ["[0]" pipe] - ["[0]" try (.use "[1]#[0]" functor)] - ["[0]" exception]] - [data - ["[0]" text (.only) - ["%" \\format (.only format)] - ["<[1]>" \\parser]]] - [math - ["[0]" random] - [number - ["n" nat]]]]] - ["[0]" / - ["[1][0]" date] - ["[1][0]" day] - ["[1][0]" duration] - ["[1][0]" instant] - ["[1][0]" month] - ["[1][0]" year]] - [\\library - ["[0]" / (.only) - ["[0]" duration]]]) - -(def for_implementation - Test - (all _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence random.time)) - (_.for [/.order] - ($order.spec /.order random.time)) - (_.for [/.enum] - ($enum.spec /.enum random.time)) - (_.for [/.codec] - ($codec.spec /.equivalence /.codec random.time)))) - -(def for_clock - Test - (do [! random.monad] - [expected random.time] - (_.coverage [/.clock /.time] - (|> expected - /.clock - /.time - (try#each (at /.equivalence = expected)) - (try.else false))))) - -(def for_ranges - Test - (do [! random.monad] - [valid_hour (at ! each (|>> (n.% /.hours) (n.max 10)) random.nat) - valid_minute (at ! each (|>> (n.% /.minutes) (n.max 10)) random.nat) - valid_second (at ! each (|>> (n.% /.seconds) (n.max 10)) random.nat) - valid_milli_second (at ! each (n.% /.milli_seconds) random.nat) - - .let [invalid_hour (|> valid_hour (n.+ /.hours)) - invalid_minute (|> valid_minute (n.+ /.minutes) (n.min 99)) - invalid_second (|> valid_second (n.+ /.seconds) (n.min 99))]] - (`` (all _.and - (,, (with_template [ ] - [(_.coverage [ ] - (let [valid! - (|> - %.nat - (text.prefix ) - (text.suffix ) - (at /.codec decoded) - (pipe.case - {try.#Success _} true - {try.#Failure error} false)) - - invalid! - (|> - %.nat - (text.prefix ) - (text.suffix ) - (at /.codec decoded) - (pipe.case - {try.#Success _} - false - - {try.#Failure error} - (exception.match? error)))] - (and valid! - invalid!)))] - - [/.hours /.invalid_hour "" ":00:00.000" valid_hour invalid_hour] - [/.minutes /.invalid_minute "00:" ":00.000" valid_minute invalid_minute] - [/.seconds /.invalid_second "00:00:" ".000" valid_second invalid_second] - )) - (_.coverage [/.milli_seconds] - (|> valid_milli_second - %.nat - (format "00:00:00.") - (at /.codec decoded) - (pipe.case - {try.#Success _} true - {try.#Failure error} false))) - )))) - -(def .public test - Test - (<| (_.covering /._) - (_.for [/.Time]) - (do [! random.monad] - [.let [day (.nat (duration.millis duration.day))] - expected random.time - - out_of_bounds (at ! each (|>> /.millis (n.+ day)) - random.time)] - (`` (all _.and - ..for_implementation - - (_.coverage [/.millis /.of_millis] - (|> expected - /.millis - /.of_millis - (try#each (at /.equivalence = expected)) - (try.else false))) - (_.coverage [/.time_exceeds_a_day] - (case (/.of_millis out_of_bounds) - {try.#Success _} - false - - {try.#Failure error} - (exception.match? /.time_exceeds_a_day error))) - (_.coverage [/.midnight] - (|> /.midnight - /.millis - (n.= 0))) - (_.coverage [/.parser] - (|> expected - (at /.codec encoded) - (.result /.parser) - (try#each (at /.equivalence = expected)) - (try.else false))) - ..for_ranges - (_.for [/.Clock] - ..for_clock) - - /date.test - /day.test - /duration.test - /instant.test - /month.test - /year.test - ))))) diff --git a/stdlib/source/test/lux/time/date.lux b/stdlib/source/test/lux/time/date.lux deleted file mode 100644 index c97fd626e..000000000 --- a/stdlib/source/test/lux/time/date.lux +++ /dev/null @@ -1,95 +0,0 @@ -(.require - [library - [lux (.except) - ["_" test (.only Test)] - [abstract - [monad (.only do)] - [\\specification - ["$[0]" equivalence] - ["$[0]" order] - ["$[0]" enum] - ["$[0]" codec]]] - [control - ["[0]" try (.use "[1]#[0]" functor)] - ["[0]" exception]] - [data - ["[0]" text - ["%" \\format (.only format)] - ["<[1]>" \\parser]]] - [math - ["[0]" random (.only Random)] - [number - ["n" nat] - ["i" int]]]]] - [\\library - ["[0]" /]]) - -(def .public test - Test - (<| (_.covering /._) - (_.for [/.Date]) - (all _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence random.date)) - (_.for [/.order] - ($order.spec /.order random.date)) - (_.for [/.enum] - ($enum.spec /.enum random.date)) - (_.for [/.codec] - ($codec.spec /.equivalence /.codec random.date)) - - (do random.monad - [expected random.date] - (_.coverage [/.date /.year /.month /.day_of_month] - (|> (/.date (/.year expected) - (/.month expected) - (/.day_of_month expected)) - (try#each (at /.equivalence = expected)) - (try.else false)))) - (do random.monad - [expected random.date] - (_.coverage [/.invalid_day] - (case (/.date (/.year expected) - (/.month expected) - (n.+ 31 (/.day_of_month expected))) - {try.#Failure error} - (exception.match? /.invalid_day error) - - {try.#Success _} - false))) - (do random.monad - [expected random.date] - (_.coverage [/.days /.of_days] - (|> expected - /.days - /.of_days - (at /.equivalence = expected)))) - (_.coverage [/.epoch] - (|> /.epoch - /.days - (i.= +0))) - (do random.monad - [expected random.date] - (_.coverage [/.parser] - (|> (at /.codec encoded expected) - (.result /.parser) - (try#each (at /.equivalence = expected)) - (try.else false)))) - (do [! random.monad] - [year (at ! each (|>> (n.% 10,000) ++) - random.nat) - month (at ! each (|>> (n.% 10) (n.+ 13)) - random.nat) - day (at ! each (|>> (n.% 10) (n.+ 10)) - random.nat) - .let [input (format (%.nat year) - "-" (%.nat month) - "-" (%.nat day))]] - (_.coverage [/.invalid_month] - (case (.result /.parser input) - {try.#Failure error} - (exception.match? /.invalid_month error) - - {try.#Success _} - false))) - ))) diff --git a/stdlib/source/test/lux/time/day.lux b/stdlib/source/test/lux/time/day.lux deleted file mode 100644 index eecc8a0fb..000000000 --- a/stdlib/source/test/lux/time/day.lux +++ /dev/null @@ -1,89 +0,0 @@ -(.require - [library - [lux (.except) - ["_" test (.only Test)] - [abstract - [monad (.only do)] - [\\specification - ["$[0]" equivalence] - ["$[0]" hash] - ["$[0]" order] - ["$[0]" enum] - ["$[0]" codec]]] - [control - ["[0]" try (.use "[1]#[0]" functor)] - ["[0]" exception] - [function - ["[0]" predicate]]] - [data - [collection - ["[0]" list] - ["[0]" set]]] - [math - ["[0]" random (.only Random) (.use "[1]#[0]" monad)] - [number - ["n" nat]]]]] - [\\library - ["[0]" /]]) - -(def .public random - (Random /.Day) - (random.either (random.either (random.either (random#in {/.#Sunday}) - (random#in {/.#Monday})) - (random.either (random#in {/.#Tuesday}) - (random#in {/.#Wednesday}))) - (random.either (random.either (random#in {/.#Thursday}) - (random#in {/.#Friday})) - (random#in {/.#Saturday})))) - -(def .public test - Test - (<| (_.covering /._) - (_.for [/.Day]) - (do random.monad - [expected ..random - invalid (random.only (predicate.or (n.< (/.number {/.#Sunday})) - (n.> (/.number {/.#Saturday}))) - random.nat)] - (all _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.hash] - ($hash.spec /.hash ..random)) - (_.for [/.order] - ($order.spec /.order ..random)) - (_.for [/.enum] - ($enum.spec /.enum ..random)) - (_.for [/.codec] - ($codec.spec /.equivalence /.codec ..random)) - - (do random.monad - [not_a_day (random.upper_case 1)] - (_.coverage [/.not_a_day_of_the_week] - (case (at /.codec decoded not_a_day) - {try.#Failure error} - (exception.match? /.not_a_day_of_the_week error) - - {try.#Success _} - false))) - (_.coverage [/.number /.by_number] - (|> expected - /.number - /.by_number - (try#each (at /.equivalence = expected)) - (try.else false))) - (_.coverage [/.invalid_day] - (case (/.by_number invalid) - {try.#Failure error} - (exception.match? /.invalid_day error) - - {try.#Success _} - false)) - (_.coverage [/.week] - (let [all (list.size /.week) - uniques (set.size (set.of_list /.hash /.week))] - (and (n.= (/.number {/.#Saturday}) - all) - (n.= all - uniques)))) - )))) diff --git a/stdlib/source/test/lux/time/duration.lux b/stdlib/source/test/lux/time/duration.lux deleted file mode 100644 index e73108548..000000000 --- a/stdlib/source/test/lux/time/duration.lux +++ /dev/null @@ -1,100 +0,0 @@ -(.require - [library - [lux (.except) - ["_" test (.only Test)] - [abstract - [monad (.only do)] - [\\specification - ["$[0]" equivalence] - ["$[0]" order] - ["$[0]" enum] - ["$[0]" monoid] - ["$[0]" codec]]] - [data - ["[0]" bit (.use "[1]#[0]" equivalence)]] - [math - ["[0]" random (.only Random)] - [number - ["n" nat] - ["i" int]]]]] - [\\library - ["[0]" /]]) - -(def .public test - Test - (<| (_.covering /._) - (_.for [/.Duration]) - (all _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence random.duration)) - (_.for [/.order] - ($order.spec /.order random.duration)) - (_.for [/.enum] - ($enum.spec /.enum random.duration)) - (_.for [/.monoid] - ($monoid.spec /.equivalence /.monoid random.duration)) - (_.for [/.codec] - ($codec.spec /.equivalence /.codec random.duration)) - - (do random.monad - [duration random.duration] - (_.coverage [/.of_millis /.millis] - (|> duration /.millis /.of_millis (at /.equivalence = duration)))) - (do random.monad - [.let [(open "#[0]") /.equivalence] - expected random.duration - parameter random.duration] - (all _.and - (_.coverage [/.composite /.difference] - (|> expected (/.composite parameter) (/.difference parameter) (#= expected))) - (_.coverage [/.empty] - (|> expected (/.composite /.empty) (#= expected))) - (_.coverage [/.inverse] - (and (|> expected /.inverse /.inverse (#= expected)) - (|> expected (/.composite (/.inverse expected)) (#= /.empty)))) - (_.coverage [/.positive? /.negative? /.neutral?] - (or (bit#= (/.positive? expected) - (/.negative? (/.inverse expected))) - (bit#= (/.neutral? expected) - (/.neutral? (/.inverse expected))))) - )) - (do random.monad - [.let [(open "#[0]") /.equivalence] - factor random.nat] - (_.coverage [/.up /.down] - (|> /.milli_second (/.up factor) (/.down factor) (#= /.milli_second)))) - (do [! random.monad] - [.let [(open "#[0]") /.order - positive (|> random.duration - (random.only (|>> (#= /.empty) not)) - (at ! each (function (_ duration) - (if (/.positive? duration) - duration - (/.inverse duration)))))] - sample positive - frame positive] - (`` (all _.and - (_.coverage [/.framed] - (let [sample' (/.framed frame sample)] - (and (#< frame sample') - (bit#= (#< frame sample) - (#= sample sample'))))) - (_.coverage [/.ticks] - (i.= +1 (/.ticks sample sample))) - (_.coverage [/.milli_second] - (#= /.empty (at /.enum pred /.milli_second))) - (,, (with_template [ ] - [(_.coverage [] - (|> (/.ticks ) (i.= )))] - - [+1,000 /.second /.milli_second] - [+60 /.minute /.second] - [+60 /.hour /.minute] - [+24 /.day /.hour] - - [+7 /.week /.day] - [+365 /.normal_year /.day] - [+366 /.leap_year /.day] - )) - ))) - ))) diff --git a/stdlib/source/test/lux/time/instant.lux b/stdlib/source/test/lux/time/instant.lux deleted file mode 100644 index 3899c04b9..000000000 --- a/stdlib/source/test/lux/time/instant.lux +++ /dev/null @@ -1,106 +0,0 @@ -(.require - [library - [lux (.except) - ["_" test (.only Test)] - [abstract - [monad (.only do)] - [\\specification - ["$[0]" equivalence] - ["$[0]" order] - ["$[0]" enum] - ["$[0]" codec]]] - [control - ["[0]" function] - ["[0]" try] - ["[0]" io]] - [data - [collection - ["[0]" list (.use "[1]#[0]" mix)]]] - [math - ["[0]" random]] - [time - ["[0]" duration (.only Duration)] - ["[0]" day (.only Day) (.use "[1]#[0]" enum)]]]] - [\\library - ["[0]" /]]) - -(def .public test - Test - (<| (_.covering /._) - (_.for [/.Instant]) - (all _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence random.instant)) - (_.for [/.order] - ($order.spec /.order random.instant)) - (_.for [/.enum] - ($enum.spec /.enum random.instant)) - (_.for [/.codec] - ($codec.spec /.equivalence /.codec random.instant)) - - (do random.monad - [.let [(open "#[0]") /.equivalence] - expected random.instant] - (all _.and - (_.coverage [/.millis /.of_millis] - (|> expected /.millis /.of_millis (#= expected))) - (_.coverage [/.relative /.absolute] - (|> expected /.relative /.absolute (#= expected))) - (_.coverage [/.date /.time /.of_date_time] - (#= expected - (/.of_date_time (/.date expected) - (/.time expected)))) - )) - (do random.monad - [.let [(open "#[0]") /.equivalence - (open "duration#[0]") duration.equivalence] - from random.instant - to random.instant] - (all _.and - (_.coverage [/.span] - (|> from (/.span from) (duration#= duration.empty))) - (_.coverage [/.after] - (|> from (/.after (/.span from to)) (#= to))) - (_.coverage [/.epoch] - (duration#= (/.relative to) - (/.span /.epoch to))) - )) - (do random.monad - [instant random.instant - .let [d0 (/.day_of_week instant)]] - (_.coverage [/.day_of_week] - (let [apply (is (-> (-> Duration Duration) (-> Day Day) Nat Bit) - (function (_ polarity move steps) - (let [day_shift (list#mix (function.constant move) - d0 - (list.repeated steps [])) - instant_shift (|> instant - (/.after (polarity (duration.up steps duration.day))) - /.day_of_week)] - (day#= day_shift - instant_shift))))] - (and (apply function.identity day#succ 0) - (apply function.identity day#succ 1) - (apply function.identity day#succ 2) - (apply function.identity day#succ 3) - (apply function.identity day#succ 4) - (apply function.identity day#succ 5) - (apply function.identity day#succ 6) - (apply function.identity day#succ 7) - - (apply duration.inverse day#pred 0) - (apply duration.inverse day#pred 1) - (apply duration.inverse day#pred 2) - (apply duration.inverse day#pred 3) - (apply duration.inverse day#pred 4) - (apply duration.inverse day#pred 5) - (apply duration.inverse day#pred 6) - (apply duration.inverse day#pred 7))))) - (_.coverage [/.now] - (case (try (io.run! /.now)) - {try.#Success _} - true - - {try.#Failure _} - false)) - ))) diff --git a/stdlib/source/test/lux/time/month.lux b/stdlib/source/test/lux/time/month.lux deleted file mode 100644 index c87a956cd..000000000 --- a/stdlib/source/test/lux/time/month.lux +++ /dev/null @@ -1,101 +0,0 @@ -(.require - [library - [lux (.except) - ["_" test (.only Test)] - [abstract - [monad (.only do)] - [\\specification - ["$[0]" equivalence] - ["$[0]" hash] - ["$[0]" order] - ["$[0]" enum] - ["$[0]" codec]]] - [control - ["[0]" try (.use "[1]#[0]" functor)] - ["[0]" exception] - [function - ["[0]" predicate]]] - [data - [collection - ["[0]" set] - ["[0]" list (.use "[1]#[0]" functor mix)]]] - [math - ["[0]" random (.only Random)] - [number - ["n" nat]]]]] - [\\library - ["[0]" / (.only) - [// - ["[0]" duration]]]]) - -(def .public random - (Random /.Month) - (let [december (/.number {/.#December})] - (|> random.nat - (at random.monad each (|>> (n.% december) ++)) - (random.one (|>> /.by_number try.maybe))))) - -(def .public test - Test - (<| (_.covering /._) - (_.for [/.Month]) - (all _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.hash] - ($hash.spec /.hash ..random)) - (_.for [/.order] - ($order.spec /.order ..random)) - (_.for [/.enum] - ($enum.spec /.enum ..random)) - (_.for [/.codec] - ($codec.spec /.equivalence /.codec ..random)) - - (do random.monad - [expected ..random - invalid (random.only (predicate.or (n.< (/.number {/.#January})) - (n.> (/.number {/.#December}))) - random.nat)] - (all _.and - (_.coverage [/.number /.by_number] - (|> expected - /.number - /.by_number - (try#each (at /.equivalence = expected)) - (try.else false))) - (_.coverage [/.invalid_month] - (case (/.by_number invalid) - {try.#Failure error} - (exception.match? /.invalid_month error) - - {try.#Success _} - false)) - (_.coverage [/.year] - (let [all (list.size /.year) - uniques (set.size (set.of_list /.hash /.year))] - (and (n.= (/.number {/.#December}) - all) - (n.= all - uniques)))) - (_.coverage [/.days] - (let [expected (.nat (duration.ticks duration.day duration.normal_year))] - (|> /.year - (list#each /.days) - (list#mix n.+ 0) - (n.= expected)))) - (_.coverage [/.leap_year_days] - (let [expected (.nat (duration.ticks duration.day duration.leap_year))] - (|> /.year - (list#each /.leap_year_days) - (list#mix n.+ 0) - (n.= expected)))) - (do random.monad - [not_a_month (random.upper_case 1)] - (_.coverage [/.not_a_month_of_the_year] - (case (at /.codec decoded not_a_month) - {try.#Failure error} - (exception.match? /.not_a_month_of_the_year error) - - {try.#Success _} - false))) - ))))) diff --git a/stdlib/source/test/lux/time/year.lux b/stdlib/source/test/lux/time/year.lux deleted file mode 100644 index 0e0dee518..000000000 --- a/stdlib/source/test/lux/time/year.lux +++ /dev/null @@ -1,97 +0,0 @@ -(.require - [library - [lux (.except) - ["_" test (.only Test)] - [abstract - [monad (.only do)] - [\\specification - ["$[0]" equivalence] - ["$[0]" order] - ["$[0]" codec]]] - [control - ["[0]" try] - ["[0]" exception]] - [data - ["[0]" bit (.use "[1]#[0]" equivalence)] - [text - ["%" \\format (.only format)]]] - [math - ["[0]" random (.only Random)] - [number - ["n" nat] - ["i" int]]]]] - [\\library - ["[0]" / (.only) - ["/[1]" // (.only) - ["[1][0]" duration] - ["[1][0]" instant] - ["[1][0]" date]]]]) - -(def .public random - (Random /.Year) - (random.one (|>> /.year try.maybe) random.int)) - -(def .public test - Test - (<| (_.covering /._) - (_.for [/.Year]) - (all _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.order] - ($order.spec /.order ..random)) - (_.for [/.codec /.parser] - ($codec.spec /.equivalence /.codec ..random)) - - (do random.monad - [expected random.int] - (all _.and - (_.coverage [/.year] - (bit#= (i.= +0 expected) - (case (/.year expected) - {try.#Success _} - false - - {try.#Failure _} - true))) - (_.coverage [/.value] - (case (/.year expected) - {try.#Success year} - (i.= expected (/.value year)) - - {try.#Failure _} - (i.= +0 expected))) - )) - (_.coverage [/.there_is_no_year_0] - (case (/.year +0) - {try.#Success _} - false - - {try.#Failure error} - (exception.match? /.there_is_no_year_0 error))) - (_.coverage [/.days] - (n.= (.nat (//duration.ticks //duration.day //duration.normal_year)) - /.days)) - (_.coverage [/.epoch] - (at /.equivalence = - (//date.year (//instant.date //instant.epoch)) - /.epoch)) - (_.for [/.Period] - (_.coverage [/.leap /.century /.era] - (n.= /.leap (n./ /.century /.era)))) - (let [leap (try.trusted (/.year (.int /.leap))) - century (try.trusted (/.year (.int /.century))) - era (try.trusted (/.year (.int /.era)))] - (all _.and - (_.coverage [/.leap?] - (and (/.leap? leap) - (not (/.leap? century)) - (/.leap? era))) - (_.coverage [/.leaps] - (and (i.= +1 (/.leaps leap)) - (i.= (.int (n./ /.leap /.century)) - (/.leaps century)) - (i.= (++ (i.* +4 (-- (/.leaps century)))) - (/.leaps era)))) - )) - ))) diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux index 37b9d2892..e0018ab8b 100644 --- a/stdlib/source/test/lux/world.lux +++ b/stdlib/source/test/lux/world.lux @@ -15,7 +15,8 @@ ["[1][0]" net ["[1]/[0]" http ["[1]/[0]" client] - ["[1]/[0]" status]]]]) + ["[1]/[0]" status]]] + ["[1][0]" time]]) (def .public test Test @@ -28,4 +29,5 @@ /output/video/resolution.test /net/http/client.test /net/http/status.test + /time.test )) diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux index 5133e9c39..faebedb1f 100644 --- a/stdlib/source/test/lux/world/file.lux +++ b/stdlib/source/test/lux/world/file.lux @@ -22,8 +22,9 @@ [meta [macro ["^" pattern]]] - [time - ["[0]" instant (.only Instant)]]]] + [world + [time + ["[0]" instant (.only Instant)]]]]] ["[0]" / ["[1][0]" watch]] [\\library diff --git a/stdlib/source/test/lux/world/time.lux b/stdlib/source/test/lux/world/time.lux new file mode 100644 index 000000000..62c3ec43c --- /dev/null +++ b/stdlib/source/test/lux/world/time.lux @@ -0,0 +1,157 @@ +(.require + [library + [lux (.except) + ["_" test (.only Test)] + [abstract + [monad (.only do)] + [\\specification + ["$[0]" equivalence] + ["$[0]" order] + ["$[0]" enum] + ["$[0]" codec]]] + [control + ["[0]" pipe] + ["[0]" try (.use "[1]#[0]" functor)] + ["[0]" exception]] + [data + ["[0]" text (.only) + ["%" \\format (.only format)] + ["<[1]>" \\parser]]] + [math + ["[0]" random] + [number + ["n" nat]]]]] + ["[0]" / + ["[1][0]" date] + ["[1][0]" day] + ["[1][0]" duration] + ["[1][0]" instant] + ["[1][0]" month] + ["[1][0]" year]] + [\\library + ["[0]" / (.only) + ["[0]" duration]]]) + +(def for_implementation + Test + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence random.time)) + (_.for [/.order] + ($order.spec /.order random.time)) + (_.for [/.enum] + ($enum.spec /.enum random.time)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec random.time)))) + +(def for_clock + Test + (do [! random.monad] + [expected random.time] + (_.coverage [/.clock /.time] + (|> expected + /.clock + /.time + (try#each (at /.equivalence = expected)) + (try.else false))))) + +(def for_ranges + Test + (do [! random.monad] + [valid_hour (at ! each (|>> (n.% /.hours) (n.max 10)) random.nat) + valid_minute (at ! each (|>> (n.% /.minutes) (n.max 10)) random.nat) + valid_second (at ! each (|>> (n.% /.seconds) (n.max 10)) random.nat) + valid_milli_second (at ! each (n.% /.milli_seconds) random.nat) + + .let [invalid_hour (|> valid_hour (n.+ /.hours)) + invalid_minute (|> valid_minute (n.+ /.minutes) (n.min 99)) + invalid_second (|> valid_second (n.+ /.seconds) (n.min 99))]] + (`` (all _.and + (,, (with_template [ ] + [(_.coverage [ ] + (let [valid! + (|> + %.nat + (text.prefix ) + (text.suffix ) + (at /.codec decoded) + (pipe.case + {try.#Success _} true + {try.#Failure error} false)) + + invalid! + (|> + %.nat + (text.prefix ) + (text.suffix ) + (at /.codec decoded) + (pipe.case + {try.#Success _} + false + + {try.#Failure error} + (exception.match? error)))] + (and valid! + invalid!)))] + + [/.hours /.invalid_hour "" ":00:00.000" valid_hour invalid_hour] + [/.minutes /.invalid_minute "00:" ":00.000" valid_minute invalid_minute] + [/.seconds /.invalid_second "00:00:" ".000" valid_second invalid_second] + )) + (_.coverage [/.milli_seconds] + (|> valid_milli_second + %.nat + (format "00:00:00.") + (at /.codec decoded) + (pipe.case + {try.#Success _} true + {try.#Failure error} false))) + )))) + +(def .public test + Test + (<| (_.covering /._) + (_.for [/.Time]) + (do [! random.monad] + [.let [day (.nat (duration.millis duration.day))] + expected random.time + + out_of_bounds (at ! each (|>> /.millis (n.+ day)) + random.time)] + (`` (all _.and + ..for_implementation + + (_.coverage [/.millis /.of_millis] + (|> expected + /.millis + /.of_millis + (try#each (at /.equivalence = expected)) + (try.else false))) + (_.coverage [/.time_exceeds_a_day] + (case (/.of_millis out_of_bounds) + {try.#Success _} + false + + {try.#Failure error} + (exception.match? /.time_exceeds_a_day error))) + (_.coverage [/.midnight] + (|> /.midnight + /.millis + (n.= 0))) + (_.coverage [/.parser] + (|> expected + (at /.codec encoded) + (.result /.parser) + (try#each (at /.equivalence = expected)) + (try.else false))) + ..for_ranges + (_.for [/.Clock] + ..for_clock) + + /date.test + /day.test + /duration.test + /instant.test + /month.test + /year.test + ))))) diff --git a/stdlib/source/test/lux/world/time/date.lux b/stdlib/source/test/lux/world/time/date.lux new file mode 100644 index 000000000..c97fd626e --- /dev/null +++ b/stdlib/source/test/lux/world/time/date.lux @@ -0,0 +1,95 @@ +(.require + [library + [lux (.except) + ["_" test (.only Test)] + [abstract + [monad (.only do)] + [\\specification + ["$[0]" equivalence] + ["$[0]" order] + ["$[0]" enum] + ["$[0]" codec]]] + [control + ["[0]" try (.use "[1]#[0]" functor)] + ["[0]" exception]] + [data + ["[0]" text + ["%" \\format (.only format)] + ["<[1]>" \\parser]]] + [math + ["[0]" random (.only Random)] + [number + ["n" nat] + ["i" int]]]]] + [\\library + ["[0]" /]]) + +(def .public test + Test + (<| (_.covering /._) + (_.for [/.Date]) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence random.date)) + (_.for [/.order] + ($order.spec /.order random.date)) + (_.for [/.enum] + ($enum.spec /.enum random.date)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec random.date)) + + (do random.monad + [expected random.date] + (_.coverage [/.date /.year /.month /.day_of_month] + (|> (/.date (/.year expected) + (/.month expected) + (/.day_of_month expected)) + (try#each (at /.equivalence = expected)) + (try.else false)))) + (do random.monad + [expected random.date] + (_.coverage [/.invalid_day] + (case (/.date (/.year expected) + (/.month expected) + (n.+ 31 (/.day_of_month expected))) + {try.#Failure error} + (exception.match? /.invalid_day error) + + {try.#Success _} + false))) + (do random.monad + [expected random.date] + (_.coverage [/.days /.of_days] + (|> expected + /.days + /.of_days + (at /.equivalence = expected)))) + (_.coverage [/.epoch] + (|> /.epoch + /.days + (i.= +0))) + (do random.monad + [expected random.date] + (_.coverage [/.parser] + (|> (at /.codec encoded expected) + (.result /.parser) + (try#each (at /.equivalence = expected)) + (try.else false)))) + (do [! random.monad] + [year (at ! each (|>> (n.% 10,000) ++) + random.nat) + month (at ! each (|>> (n.% 10) (n.+ 13)) + random.nat) + day (at ! each (|>> (n.% 10) (n.+ 10)) + random.nat) + .let [input (format (%.nat year) + "-" (%.nat month) + "-" (%.nat day))]] + (_.coverage [/.invalid_month] + (case (.result /.parser input) + {try.#Failure error} + (exception.match? /.invalid_month error) + + {try.#Success _} + false))) + ))) diff --git a/stdlib/source/test/lux/world/time/day.lux b/stdlib/source/test/lux/world/time/day.lux new file mode 100644 index 000000000..eecc8a0fb --- /dev/null +++ b/stdlib/source/test/lux/world/time/day.lux @@ -0,0 +1,89 @@ +(.require + [library + [lux (.except) + ["_" test (.only Test)] + [abstract + [monad (.only do)] + [\\specification + ["$[0]" equivalence] + ["$[0]" hash] + ["$[0]" order] + ["$[0]" enum] + ["$[0]" codec]]] + [control + ["[0]" try (.use "[1]#[0]" functor)] + ["[0]" exception] + [function + ["[0]" predicate]]] + [data + [collection + ["[0]" list] + ["[0]" set]]] + [math + ["[0]" random (.only Random) (.use "[1]#[0]" monad)] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]]) + +(def .public random + (Random /.Day) + (random.either (random.either (random.either (random#in {/.#Sunday}) + (random#in {/.#Monday})) + (random.either (random#in {/.#Tuesday}) + (random#in {/.#Wednesday}))) + (random.either (random.either (random#in {/.#Thursday}) + (random#in {/.#Friday})) + (random#in {/.#Saturday})))) + +(def .public test + Test + (<| (_.covering /._) + (_.for [/.Day]) + (do random.monad + [expected ..random + invalid (random.only (predicate.or (n.< (/.number {/.#Sunday})) + (n.> (/.number {/.#Saturday}))) + random.nat)] + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) + (_.for [/.order] + ($order.spec /.order ..random)) + (_.for [/.enum] + ($enum.spec /.enum ..random)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec ..random)) + + (do random.monad + [not_a_day (random.upper_case 1)] + (_.coverage [/.not_a_day_of_the_week] + (case (at /.codec decoded not_a_day) + {try.#Failure error} + (exception.match? /.not_a_day_of_the_week error) + + {try.#Success _} + false))) + (_.coverage [/.number /.by_number] + (|> expected + /.number + /.by_number + (try#each (at /.equivalence = expected)) + (try.else false))) + (_.coverage [/.invalid_day] + (case (/.by_number invalid) + {try.#Failure error} + (exception.match? /.invalid_day error) + + {try.#Success _} + false)) + (_.coverage [/.week] + (let [all (list.size /.week) + uniques (set.size (set.of_list /.hash /.week))] + (and (n.= (/.number {/.#Saturday}) + all) + (n.= all + uniques)))) + )))) diff --git a/stdlib/source/test/lux/world/time/duration.lux b/stdlib/source/test/lux/world/time/duration.lux new file mode 100644 index 000000000..e73108548 --- /dev/null +++ b/stdlib/source/test/lux/world/time/duration.lux @@ -0,0 +1,100 @@ +(.require + [library + [lux (.except) + ["_" test (.only Test)] + [abstract + [monad (.only do)] + [\\specification + ["$[0]" equivalence] + ["$[0]" order] + ["$[0]" enum] + ["$[0]" monoid] + ["$[0]" codec]]] + [data + ["[0]" bit (.use "[1]#[0]" equivalence)]] + [math + ["[0]" random (.only Random)] + [number + ["n" nat] + ["i" int]]]]] + [\\library + ["[0]" /]]) + +(def .public test + Test + (<| (_.covering /._) + (_.for [/.Duration]) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence random.duration)) + (_.for [/.order] + ($order.spec /.order random.duration)) + (_.for [/.enum] + ($enum.spec /.enum random.duration)) + (_.for [/.monoid] + ($monoid.spec /.equivalence /.monoid random.duration)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec random.duration)) + + (do random.monad + [duration random.duration] + (_.coverage [/.of_millis /.millis] + (|> duration /.millis /.of_millis (at /.equivalence = duration)))) + (do random.monad + [.let [(open "#[0]") /.equivalence] + expected random.duration + parameter random.duration] + (all _.and + (_.coverage [/.composite /.difference] + (|> expected (/.composite parameter) (/.difference parameter) (#= expected))) + (_.coverage [/.empty] + (|> expected (/.composite /.empty) (#= expected))) + (_.coverage [/.inverse] + (and (|> expected /.inverse /.inverse (#= expected)) + (|> expected (/.composite (/.inverse expected)) (#= /.empty)))) + (_.coverage [/.positive? /.negative? /.neutral?] + (or (bit#= (/.positive? expected) + (/.negative? (/.inverse expected))) + (bit#= (/.neutral? expected) + (/.neutral? (/.inverse expected))))) + )) + (do random.monad + [.let [(open "#[0]") /.equivalence] + factor random.nat] + (_.coverage [/.up /.down] + (|> /.milli_second (/.up factor) (/.down factor) (#= /.milli_second)))) + (do [! random.monad] + [.let [(open "#[0]") /.order + positive (|> random.duration + (random.only (|>> (#= /.empty) not)) + (at ! each (function (_ duration) + (if (/.positive? duration) + duration + (/.inverse duration)))))] + sample positive + frame positive] + (`` (all _.and + (_.coverage [/.framed] + (let [sample' (/.framed frame sample)] + (and (#< frame sample') + (bit#= (#< frame sample) + (#= sample sample'))))) + (_.coverage [/.ticks] + (i.= +1 (/.ticks sample sample))) + (_.coverage [/.milli_second] + (#= /.empty (at /.enum pred /.milli_second))) + (,, (with_template [ ] + [(_.coverage [] + (|> (/.ticks ) (i.= )))] + + [+1,000 /.second /.milli_second] + [+60 /.minute /.second] + [+60 /.hour /.minute] + [+24 /.day /.hour] + + [+7 /.week /.day] + [+365 /.normal_year /.day] + [+366 /.leap_year /.day] + )) + ))) + ))) diff --git a/stdlib/source/test/lux/world/time/instant.lux b/stdlib/source/test/lux/world/time/instant.lux new file mode 100644 index 000000000..56a4749ec --- /dev/null +++ b/stdlib/source/test/lux/world/time/instant.lux @@ -0,0 +1,106 @@ +(.require + [library + [lux (.except) + ["_" test (.only Test)] + [abstract + [monad (.only do)] + [\\specification + ["$[0]" equivalence] + ["$[0]" order] + ["$[0]" enum] + ["$[0]" codec]]] + [control + ["[0]" function] + ["[0]" try] + ["[0]" io]] + [data + [collection + ["[0]" list (.use "[1]#[0]" mix)]]] + [math + ["[0]" random]]]] + [\\library + ["[0]" / (.only) + [// + ["[0]" duration (.only Duration)] + ["[0]" day (.only Day) (.use "[1]#[0]" enum)]]]]) + +(def .public test + Test + (<| (_.covering /._) + (_.for [/.Instant]) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence random.instant)) + (_.for [/.order] + ($order.spec /.order random.instant)) + (_.for [/.enum] + ($enum.spec /.enum random.instant)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec random.instant)) + + (do random.monad + [.let [(open "#[0]") /.equivalence] + expected random.instant] + (all _.and + (_.coverage [/.millis /.of_millis] + (|> expected /.millis /.of_millis (#= expected))) + (_.coverage [/.relative /.absolute] + (|> expected /.relative /.absolute (#= expected))) + (_.coverage [/.date /.time /.of_date_time] + (#= expected + (/.of_date_time (/.date expected) + (/.time expected)))) + )) + (do random.monad + [.let [(open "#[0]") /.equivalence + (open "duration#[0]") duration.equivalence] + from random.instant + to random.instant] + (all _.and + (_.coverage [/.span] + (|> from (/.span from) (duration#= duration.empty))) + (_.coverage [/.after] + (|> from (/.after (/.span from to)) (#= to))) + (_.coverage [/.epoch] + (duration#= (/.relative to) + (/.span /.epoch to))) + )) + (do random.monad + [instant random.instant + .let [d0 (/.day_of_week instant)]] + (_.coverage [/.day_of_week] + (let [apply (is (-> (-> Duration Duration) (-> Day Day) Nat Bit) + (function (_ polarity move steps) + (let [day_shift (list#mix (function.constant move) + d0 + (list.repeated steps [])) + instant_shift (|> instant + (/.after (polarity (duration.up steps duration.day))) + /.day_of_week)] + (day#= day_shift + instant_shift))))] + (and (apply function.identity day#succ 0) + (apply function.identity day#succ 1) + (apply function.identity day#succ 2) + (apply function.identity day#succ 3) + (apply function.identity day#succ 4) + (apply function.identity day#succ 5) + (apply function.identity day#succ 6) + (apply function.identity day#succ 7) + + (apply duration.inverse day#pred 0) + (apply duration.inverse day#pred 1) + (apply duration.inverse day#pred 2) + (apply duration.inverse day#pred 3) + (apply duration.inverse day#pred 4) + (apply duration.inverse day#pred 5) + (apply duration.inverse day#pred 6) + (apply duration.inverse day#pred 7))))) + (_.coverage [/.now] + (case (try (io.run! /.now)) + {try.#Success _} + true + + {try.#Failure _} + false)) + ))) diff --git a/stdlib/source/test/lux/world/time/month.lux b/stdlib/source/test/lux/world/time/month.lux new file mode 100644 index 000000000..c87a956cd --- /dev/null +++ b/stdlib/source/test/lux/world/time/month.lux @@ -0,0 +1,101 @@ +(.require + [library + [lux (.except) + ["_" test (.only Test)] + [abstract + [monad (.only do)] + [\\specification + ["$[0]" equivalence] + ["$[0]" hash] + ["$[0]" order] + ["$[0]" enum] + ["$[0]" codec]]] + [control + ["[0]" try (.use "[1]#[0]" functor)] + ["[0]" exception] + [function + ["[0]" predicate]]] + [data + [collection + ["[0]" set] + ["[0]" list (.use "[1]#[0]" functor mix)]]] + [math + ["[0]" random (.only Random)] + [number + ["n" nat]]]]] + [\\library + ["[0]" / (.only) + [// + ["[0]" duration]]]]) + +(def .public random + (Random /.Month) + (let [december (/.number {/.#December})] + (|> random.nat + (at random.monad each (|>> (n.% december) ++)) + (random.one (|>> /.by_number try.maybe))))) + +(def .public test + Test + (<| (_.covering /._) + (_.for [/.Month]) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) + (_.for [/.order] + ($order.spec /.order ..random)) + (_.for [/.enum] + ($enum.spec /.enum ..random)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec ..random)) + + (do random.monad + [expected ..random + invalid (random.only (predicate.or (n.< (/.number {/.#January})) + (n.> (/.number {/.#December}))) + random.nat)] + (all _.and + (_.coverage [/.number /.by_number] + (|> expected + /.number + /.by_number + (try#each (at /.equivalence = expected)) + (try.else false))) + (_.coverage [/.invalid_month] + (case (/.by_number invalid) + {try.#Failure error} + (exception.match? /.invalid_month error) + + {try.#Success _} + false)) + (_.coverage [/.year] + (let [all (list.size /.year) + uniques (set.size (set.of_list /.hash /.year))] + (and (n.= (/.number {/.#December}) + all) + (n.= all + uniques)))) + (_.coverage [/.days] + (let [expected (.nat (duration.ticks duration.day duration.normal_year))] + (|> /.year + (list#each /.days) + (list#mix n.+ 0) + (n.= expected)))) + (_.coverage [/.leap_year_days] + (let [expected (.nat (duration.ticks duration.day duration.leap_year))] + (|> /.year + (list#each /.leap_year_days) + (list#mix n.+ 0) + (n.= expected)))) + (do random.monad + [not_a_month (random.upper_case 1)] + (_.coverage [/.not_a_month_of_the_year] + (case (at /.codec decoded not_a_month) + {try.#Failure error} + (exception.match? /.not_a_month_of_the_year error) + + {try.#Success _} + false))) + ))))) diff --git a/stdlib/source/test/lux/world/time/year.lux b/stdlib/source/test/lux/world/time/year.lux new file mode 100644 index 000000000..0e0dee518 --- /dev/null +++ b/stdlib/source/test/lux/world/time/year.lux @@ -0,0 +1,97 @@ +(.require + [library + [lux (.except) + ["_" test (.only Test)] + [abstract + [monad (.only do)] + [\\specification + ["$[0]" equivalence] + ["$[0]" order] + ["$[0]" codec]]] + [control + ["[0]" try] + ["[0]" exception]] + [data + ["[0]" bit (.use "[1]#[0]" equivalence)] + [text + ["%" \\format (.only format)]]] + [math + ["[0]" random (.only Random)] + [number + ["n" nat] + ["i" int]]]]] + [\\library + ["[0]" / (.only) + ["/[1]" // (.only) + ["[1][0]" duration] + ["[1][0]" instant] + ["[1][0]" date]]]]) + +(def .public random + (Random /.Year) + (random.one (|>> /.year try.maybe) random.int)) + +(def .public test + Test + (<| (_.covering /._) + (_.for [/.Year]) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.order] + ($order.spec /.order ..random)) + (_.for [/.codec /.parser] + ($codec.spec /.equivalence /.codec ..random)) + + (do random.monad + [expected random.int] + (all _.and + (_.coverage [/.year] + (bit#= (i.= +0 expected) + (case (/.year expected) + {try.#Success _} + false + + {try.#Failure _} + true))) + (_.coverage [/.value] + (case (/.year expected) + {try.#Success year} + (i.= expected (/.value year)) + + {try.#Failure _} + (i.= +0 expected))) + )) + (_.coverage [/.there_is_no_year_0] + (case (/.year +0) + {try.#Success _} + false + + {try.#Failure error} + (exception.match? /.there_is_no_year_0 error))) + (_.coverage [/.days] + (n.= (.nat (//duration.ticks //duration.day //duration.normal_year)) + /.days)) + (_.coverage [/.epoch] + (at /.equivalence = + (//date.year (//instant.date //instant.epoch)) + /.epoch)) + (_.for [/.Period] + (_.coverage [/.leap /.century /.era] + (n.= /.leap (n./ /.century /.era)))) + (let [leap (try.trusted (/.year (.int /.leap))) + century (try.trusted (/.year (.int /.century))) + era (try.trusted (/.year (.int /.era)))] + (all _.and + (_.coverage [/.leap?] + (and (/.leap? leap) + (not (/.leap? century)) + (/.leap? era))) + (_.coverage [/.leaps] + (and (i.= +1 (/.leaps leap)) + (i.= (.int (n./ /.leap /.century)) + (/.leaps century)) + (i.= (++ (i.* +4 (-- (/.leaps century)))) + (/.leaps era)))) + )) + ))) -- cgit v1.2.3