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". --- .../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 +++++++++ 28 files changed, 1641 insertions(+), 1633 deletions(-) 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 (limited to 'stdlib/source/library') 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))))) -- cgit v1.2.3