diff options
author | Eduardo Julian | 2021-06-12 01:32:40 -0400 |
---|---|---|
committer | Eduardo Julian | 2021-06-12 01:32:40 -0400 |
commit | af3e6e2cb011dc2ad9204440990731a2f272716d (patch) | |
tree | 3521c74b05fc5b3ddddbe901d32ace87dbb6c018 /stdlib | |
parent | 8f575da5095e3b259d4eb6b6f13d3e37ef1d38e4 (diff) |
Constraining the year of the snapshot time in Aedifex.
Diffstat (limited to 'stdlib')
24 files changed, 236 insertions, 163 deletions
diff --git a/stdlib/source/lux/target/jvm/type/parser.lux b/stdlib/source/lux/target/jvm/type/parser.lux index d54c1c504..56e992082 100644 --- a/stdlib/source/lux/target/jvm/type/parser.lux +++ b/stdlib/source/lux/target/jvm/type/parser.lux @@ -61,10 +61,7 @@ (format var/head "0123456789$")) -(def: class/head - (format var/head //name.internal_separator)) - -(def: class/tail +(def: class/set (format var/tail //name.internal_separator)) (template [<type> <name> <head> <tail> <adapter>] @@ -74,7 +71,7 @@ (<t>.slice (<t>.and! (<t>.one_of! <head>) (<t>.some! (<t>.one_of! <tail>))))))] - [External class_name class/head class/tail (|>> //name.internal //name.external)] + [External class_name class/set class/set (|>> //name.internal //name.external)] [Text var_name var/head var/tail function.identity] ) diff --git a/stdlib/source/lux/time.lux b/stdlib/source/lux/time.lux index a1675dc17..fe08164d0 100644 --- a/stdlib/source/lux/time.lux +++ b/stdlib/source/lux/time.lux @@ -81,7 +81,7 @@ {#.doc "Time is defined as milliseconds since the start of the day (00:00:00.000)."} - (def: #export start + (def: #export midnight {#.doc "The instant corresponding to the start of the day: 00:00:00.000"} Time (:abstraction 0)) diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux index 48e4e7d41..872f91f13 100644 --- a/stdlib/source/lux/time/date.lux +++ b/stdlib/source/lux/time/date.lux @@ -80,6 +80,12 @@ #day day})) (exception.throw ..invalid_day [year month day]))) + (def: #export epoch + Date + (try.assume (..date //year.epoch + #//month.January + ..minimum_day))) + (template [<name> <type> <field>] [(def: #export <name> (-> Date <type>) diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index 25df6407c..78dcadde1 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -155,6 +155,7 @@ (IO Instant) (io (..from_millis (for {@.old ("jvm invokestatic:java.lang.System:currentTimeMillis:") @.jvm (|> ("jvm member invoke static" [] "java.lang.System" "currentTimeMillis" []) + ("jvm object cast") (: (primitive "java.lang.Long")) (:coerce Int)) @.js (let [date ("js object new" ("js constant" "Date") [])] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/abstract.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/abstract.lux index 419fca601..0b4885180 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/abstract.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/function/abstract.lux @@ -1,5 +1,8 @@ (.module: [lux (#- Type) + [data + [text + ["%" format]]] [target [jvm ["." type (#+ Type) @@ -9,7 +12,11 @@ [constant ["." arity]]]]) -(def: #export class (type.class "LuxFunction" (list))) +(def: #export artifact_id + 1) + +(def: #export class + (type.class (%.nat artifact_id) (list))) (def: #export init (Type Method) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux index 011734cc8..ec3080fc2 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux @@ -88,7 +88,11 @@ "/" (%.nat module) "/" (%.nat id))) -(def: #export class (type.class "LuxRuntime" (list))) +(def: artifact_id + 0) + +(def: #export class + (type.class (%.nat ..artifact_id) (list))) (def: procedure (-> Text (Type category.Method) (Bytecode Any)) @@ -532,7 +536,7 @@ (row.row)))] (do ////.monad [_ (generation.execute! [class bytecode])] - (generation.save! class [class bytecode])))) + (generation.save! ..artifact_id [class bytecode])))) (def: generate_function (Operation Any) @@ -589,7 +593,7 @@ (row.row)))] (do ////.monad [_ (generation.execute! [class bytecode])] - (generation.save! class [class bytecode])))) + (generation.save! //function.artifact_id [class bytecode])))) (def: #export generate (Operation Any) diff --git a/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux b/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux index 15552a656..1df76453c 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux @@ -15,8 +15,8 @@ ["." text ["%" format (#+ format)]] [collection - ["." row (#+ Row)] - ["." list ("#\." functor)]]] + ["." row (#+ Row) ("#\." fold)] + ["." list ("#\." functor fold)]]] [math [number ["n" nat]]] @@ -31,9 +31,11 @@ ["." static (#+ Static)]]] ["." // (#+ Packager) [// - ["." archive + ["." archive (#+ Output) ["." descriptor (#+ Module)] ["." artifact]] + [cache + ["." dependency]] ["." io #_ ["#" archive]] [// @@ -106,64 +108,41 @@ (-> Context java/util/jar/Manifest) (let [manifest (java/util/jar/Manifest::new)] (exec (do_to (java/util/jar/Manifest::getMainAttributes manifest) - (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MAIN_CLASS) (|> program runtime.class_name name.internal name.external)) - (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MANIFEST_VERSION) ..manifest_version)) + (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MAIN_CLASS) (|> program runtime.class_name name.internal name.external)) + (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MANIFEST_VERSION) ..manifest_version)) manifest))) -## TODO: Delete ASAP -(type: (Action ! a) - (! (Try a))) - -(def: (write_class monad file_system static context sink) - (All [!] - (-> (Monad !) (file.System !) Static Context java/util/jar/JarOutputStream - (Action ! java/util/jar/JarOutputStream))) - (do (try.with monad) - [artifact (let [[module artifact] context] - (!.use (\ file_system file) [(io.artifact file_system static module (%.nat artifact))])) - content (!.use (\ artifact content) []) - #let [class_path (format (runtime.class_name context) (get@ #static.artifact_extension static))]] - (wrap (do_to sink - (java/util/jar/JarOutputStream::putNextEntry (java/util/jar/JarEntry::new class_path)) - (java/util/zip/ZipOutputStream::write content +0 (.int (binary.size content))) +(def: (write_class static module artifact content sink) + (-> Static archive.ID artifact.ID Binary java/util/jar/JarOutputStream + java/util/jar/JarOutputStream) + (let [class_path (format (runtime.class_name [module artifact]) + (get@ #static.artifact_extension static))] + (do_to sink + (java/util/jar/JarOutputStream::putNextEntry (java/util/jar/JarEntry::new class_path)) + (java/util/zip/ZipOutputStream::write content +0 (.int (binary.size content))) + (java/io/Flushable::flush) + (java/util/zip/ZipOutputStream::closeEntry)))) + +(def: (write_module static [module output] sink) + (-> Static [archive.ID Output] java/util/jar/JarOutputStream + java/util/jar/JarOutputStream) + (row\fold (function (_ [artifact content] sink) + (..write_class static module artifact content sink)) + sink + output)) + +(def: #export (package static) + (-> Static Packager) + (function (_ archive program) + (do {! try.monad} + [order (dependency.load_order $.key archive) + #let [buffer (java/io/ByteArrayOutputStream::new (.int ..mebi_byte)) + sink (|> order + (list\map (function (_ [module [module_id [descriptor document output]]]) + [module_id output])) + (list\fold (..write_module static) + (java/util/jar/JarOutputStream::new buffer (..manifest program)))) + _ (do_to sink (java/io/Flushable::flush) - (java/util/zip/ZipOutputStream::closeEntry))))) - -(def: (write_module monad file_system static [module artifacts] sink) - (All [!] - (-> (Monad !) (file.System !) Static [archive.ID (List artifact.ID)] java/util/jar/JarOutputStream - (Action ! java/util/jar/JarOutputStream))) - (monad.fold (:assume (try.with monad)) - (function (_ artifact sink) - (..write_class monad file_system static [module artifact] sink)) - sink - artifacts)) - -(def: #export (package monad file_system static archive program) - (All [!] (Packager !)) - (do {! (try.with monad)} - [cache (:share [!] - {(Monad !) - monad} - {(! (Try (Directory !))) - (:assume (!.use (\ file_system directory) [(get@ #static.target static)]))}) - order (|> archive - archive.archived - (monad.map try.monad (function (_ module) - (do try.monad - [[descriptor document] (archive.find module archive) - module_id (archive.id module archive)] - (wrap (|> descriptor - (get@ #descriptor.registry) - artifact.artifacts - row.to_list - (list\map (|>> (get@ #artifact.id))) - [module_id]))))) - (\ monad wrap)) - #let [buffer (java/io/ByteArrayOutputStream::new (.int ..mebi_byte)) - sink (java/util/jar/JarOutputStream::new buffer (..manifest program))] - sink (monad.fold ! (..write_module monad file_system static) sink order) - #let [_ (do_to sink - (java/io/Flushable::flush) - (java/io/Closeable::close))]] - (wrap (java/io/ByteArrayOutputStream::toByteArray buffer)))) + (java/io/Closeable::close))]] + (wrap (java/io/ByteArrayOutputStream::toByteArray buffer))))) diff --git a/stdlib/source/lux/type/variance.lux b/stdlib/source/lux/type/variance.lux index 4ffe94780..863824e59 100644 --- a/stdlib/source/lux/type/variance.lux +++ b/stdlib/source/lux/type/variance.lux @@ -1,11 +1,11 @@ (.module: [lux #*]) -(type: #export (CoV t) +(type: #export (Co t) (-> Any t)) -(type: #export (ContraV t) +(type: #export (Contra t) (-> t Any)) -(type: #export (InV t) +(type: #export (In t) (-> t t)) diff --git a/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux b/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux index ca59b11a6..f321e11c1 100644 --- a/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux +++ b/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux @@ -42,11 +42,6 @@ (list (..time_format time) (//build.format build))) -## (exception: #export (mismatch {expected Instant} {actual Instant}) -## (exception.report -## ["Expected" (%.instant expected)] -## ["Actual" (%.instant actual)])) - (def: time_parser (Parser Time) (do <>.monad diff --git a/stdlib/source/program/aedifex/artifact/snapshot/time.lux b/stdlib/source/program/aedifex/artifact/snapshot/time.lux index ea9bf3047..e0cb8c112 100644 --- a/stdlib/source/program/aedifex/artifact/snapshot/time.lux +++ b/stdlib/source/program/aedifex/artifact/snapshot/time.lux @@ -16,30 +16,30 @@ [time ["." instant (#+ Instant)]]] ["." /// #_ - [time - ["#." date] - ["#." time]]]) + ["#." time + ["#/." date] + ["#/." time]]]) (type: #export Time - Instant) + ///time.Time) (def: #export equivalence (Equivalence Time) - instant.equivalence) + ///time.equivalence) (def: separator ".") -(def: #export (format value) +(def: #export (format [date time]) (%.Format Time) - (%.format (///date.format (instant.date value)) + (%.format (///time/date.format date) ..separator - (///time.format (instant.time value)))) + (///time/time.format time))) (def: #export parser (<text>.Parser Time) (do <>.monad - [date ///date.parser + [date ///time/date.parser _ (<text>.this ..separator) - time ///time.parser] - (wrap (instant.from_date_time date time)))) + time ///time/time.parser] + (wrap [date time]))) diff --git a/stdlib/source/program/aedifex/artifact/time.lux b/stdlib/source/program/aedifex/artifact/time.lux index 19eb417a5..59367c37d 100644 --- a/stdlib/source/program/aedifex/artifact/time.lux +++ b/stdlib/source/program/aedifex/artifact/time.lux @@ -1,5 +1,6 @@ (.module: [lux #* + ["." time] [abstract [equivalence (#+ Equivalence)] [monad (#+ do)]] @@ -7,29 +8,33 @@ ["<>" parser ["<.>" text (#+ Parser)]]] [data + ["." product] [text - ["%" format (#+ Format)]]] - [time - ["." instant (#+ Instant)]]] + ["%" format (#+ Format)]]]] ["." / #_ ["#." date] ["#." time]]) (type: #export Time - Instant) + [/date.Date /time.Time]) + +(def: #export epoch + Time + [/date.epoch time.midnight]) (def: #export equivalence (Equivalence Time) - instant.equivalence) + (product.equivalence /date.equivalence + time.equivalence)) -(def: #export (format value) +(def: #export (format [date time]) (Format Time) - (%.format (/date.format (instant.date value)) - (/time.format (instant.time value)))) + (%.format (/date.format date) + (/time.format time))) (def: #export parser (Parser Time) (do <>.monad [date /date.parser time /time.parser] - (wrap (instant.from_date_time date time)))) + (wrap [date time]))) diff --git a/stdlib/source/program/aedifex/artifact/time/date.lux b/stdlib/source/program/aedifex/artifact/time/date.lux index 18df2900b..989abb5fc 100644 --- a/stdlib/source/program/aedifex/artifact/time/date.lux +++ b/stdlib/source/program/aedifex/artifact/time/date.lux @@ -1,8 +1,11 @@ (.module: [lux #* [abstract - [monad (#+ do)]] + [monad (#+ do)] + [equivalence (#+ Equivalence)]] [control + ["." try (#+ Try)] + ["." exception (#+ exception:)] ["<>" parser ["<.>" text (#+ Parser)]]] [data @@ -10,11 +13,14 @@ ["%" format]]] [math [number - ["n" nat]]] + ["n" nat] + ["i" int]]] [time - ["." date (#+ Date)] + ["." date ("#\." equivalence)] ["." year] - ["." month]]]) + ["." month]] + [type + abstract]]) (def: #export (pad value) (-> Nat Text) @@ -22,18 +28,54 @@ (%.format "0" (%.nat value)) (%.nat value))) -(def: #export (format value) - (%.Format Date) - (%.format (|> value date.year year.value .nat %.nat) - (|> value date.month month.number ..pad) - (|> value date.day_of_month ..pad))) - -(def: #export parser - (Parser Date) - (do <>.monad - [year (<>.codec n.decimal (<text>.exactly 4 <text>.decimal)) - year (<>.lift (year.year (.int year))) - month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal)) - month (<>.lift (month.by_number month)) - day_of_month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))] - (<>.lift (date.date year month day_of_month)))) +(def: min_year +1,000) +(def: max_year +9,999) + +(exception: #export (year_is_out_of_range {year year.Year}) + (exception.report + ["Minimum" (%.int ..min_year)] + ["Maximum" (%.int ..max_year)] + ["Year" (%.int (year.value year))])) + +(abstract: #export Date + date.Date + + (def: #export epoch + Date + (:abstraction date.epoch)) + + (def: #export (date raw) + (-> date.Date (Try Date)) + (let [year (|> raw date.year year.value)] + (if (and (i.>= ..min_year year) + (i.<= ..max_year year)) + (#try.Success (:abstraction raw)) + (exception.throw ..year_is_out_of_range [(date.year raw)])))) + + (def: #export value + (-> Date date.Date) + (|>> :representation)) + + (structure: #export equivalence + (Equivalence Date) + + (def: (= reference subject) + (date\= (:representation reference) + (:representation subject)))) + + (def: #export (format value) + (%.Format Date) + (%.format (|> value :representation date.year year.value .nat %.nat) + (|> value :representation date.month month.number ..pad) + (|> value :representation date.day_of_month ..pad))) + + (def: #export parser + (Parser Date) + (do <>.monad + [year (<>.codec n.decimal (<text>.exactly 4 <text>.decimal)) + year (<>.lift (year.year (.int year))) + month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal)) + month (<>.lift (month.by_number month)) + day_of_month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal)) + date (<>.lift (date.date year month day_of_month))] + (wrap (:abstraction date))))) diff --git a/stdlib/source/program/aedifex/artifact/versioning.lux b/stdlib/source/program/aedifex/artifact/versioning.lux index dab943145..a16d92796 100644 --- a/stdlib/source/program/aedifex/artifact/versioning.lux +++ b/stdlib/source/program/aedifex/artifact/versioning.lux @@ -21,7 +21,6 @@ [number ["n" nat]]] ["." time (#+ Time) - ["." instant (#+ Instant)] ["." date (#+ Date)] ["." year] ["." month]]] @@ -32,19 +31,19 @@ (type: #export Versioning {#snapshot Snapshot - #last_updated Instant + #last_updated //time.Time #versions (List Version)}) (def: #export init {#snapshot #//snapshot.Local - #last_updated instant.epoch + #last_updated //time.epoch #versions (list)}) (def: #export equivalence (Equivalence Versioning) ($_ product.equivalence //snapshot.equivalence - instant.equivalence + //time.equivalence (list.equivalence //snapshot/version.equivalence) )) @@ -58,7 +57,7 @@ ) (def: format_last_updated - (-> Instant XML) + (-> //time.Time XML) (|>> //time.format #xml.Text list (#xml.Node ..<last_updated> xml.attributes))) (def: #export (format (^slots [#snapshot #last_updated #versions])) @@ -81,7 +80,7 @@ (..sub tag <xml>.text)) (def: last_updated_parser - (Parser Instant) + (Parser //time.Time) (<text>.embed //time.parser (..text ..<last_updated>))) @@ -90,7 +89,7 @@ (<| (..sub ..<versioning>) ($_ <>.and (<>.default #//snapshot.Local (<xml>.somewhere //snapshot.parser)) - (<>.default instant.epoch (<xml>.somewhere ..last_updated_parser)) + (<>.default //time.epoch (<xml>.somewhere ..last_updated_parser)) (<| (<>.default (list)) <xml>.somewhere (..sub ..<snapshot_versions>) diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux index 9d2cf9069..935d835bb 100644 --- a/stdlib/source/test/aedifex/artifact.lux +++ b/stdlib/source/test/aedifex/artifact.lux @@ -19,11 +19,11 @@ [net ["." uri]]]] ["." / #_ - ["#." type] ["#." extension] + ["#." snapshot] ["#." time] - ["#." versioning] - ["#." snapshot]] + ["#." type] + ["#." versioning]] {#program ["." /]}) @@ -43,9 +43,9 @@ (_.for [/.equivalence] ($equivalence.spec /.equivalence ..random)) - /type.test /extension.test + /snapshot.test /time.test + /type.test /versioning.test - /snapshot.test )))) diff --git a/stdlib/source/test/aedifex/artifact/snapshot.lux b/stdlib/source/test/aedifex/artifact/snapshot.lux index 192978ebf..d48c8f34e 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot.lux @@ -14,10 +14,9 @@ ["." random (#+ Random) ("#\." monad)]]] ["$." / #_ ["#." build] - ["#." time] ["#." stamp] - ["#." version - ["#/." value]]] + ["#." time] + ["#." version]] {#program ["." /]}) @@ -45,8 +44,7 @@ (try.default false)))) $/build.test - $/time.test $/stamp.test + $/time.test $/version.test - $/version/value.test )))) diff --git a/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux b/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux index a36e5af9d..f2051d037 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux @@ -37,12 +37,10 @@ (do random.monad [expected ..random] - ($_ _.and - (_.cover [/.format /.parser] - (|> expected - /.format - (<xml>.run /.parser) - (try\map (\ /.equivalence = expected)) - (try.default false))) - )) + (_.cover [/.format /.parser] + (|> expected + /.format + (<xml>.run /.parser) + (try\map (\ /.equivalence = expected)) + (try.default false)))) ))) diff --git a/stdlib/source/test/aedifex/artifact/snapshot/time.lux b/stdlib/source/test/aedifex/artifact/snapshot/time.lux index 567c70ce4..3acb37232 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot/time.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot/time.lux @@ -11,15 +11,15 @@ [parser ["<.>" text]]] [math - ["." random (#+ Random)]] - [time - ["." instant]]] + ["." random (#+ Random)]]] {#program - ["." /]}) + ["." /]} + ["$." /// #_ + ["#." time]]) (def: #export random (Random /.Time) - random.instant) + $///time.random) (def: #export test Test @@ -36,7 +36,7 @@ (|> expected /.format (<text>.run /.parser) - (try\map (\ instant.equivalence = expected)) + (try\map (\ /.equivalence = expected)) (try.default false))) )) ))) diff --git a/stdlib/source/test/aedifex/artifact/snapshot/version.lux b/stdlib/source/test/aedifex/artifact/snapshot/version.lux index e08691c3c..59ed7189f 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot/version.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot/version.lux @@ -14,6 +14,8 @@ ["." random (#+ Random)]]] {#program ["." /]} + ["." / #_ + ["#." value]] ["$." /// #_ ["#." type] ["#." time]]) @@ -43,4 +45,6 @@ (<xml>.run /.parser) (try\map (\ /.equivalence = expected)) (try.default false)))) + + /value.test ))) diff --git a/stdlib/source/test/aedifex/artifact/time.lux b/stdlib/source/test/aedifex/artifact/time.lux index b14032a8c..b9b0ab4e0 100644 --- a/stdlib/source/test/aedifex/artifact/time.lux +++ b/stdlib/source/test/aedifex/artifact/time.lux @@ -13,9 +13,7 @@ [math ["." random (#+ Random)] [number - ["i" int]]] - [time - ["." instant]]] + ["i" int]]]] {#program ["." /]} ["." / #_ @@ -27,7 +25,7 @@ (do random.monad [date /date.random time /time.random] - (wrap (instant.from_date_time date time)))) + (wrap [date time]))) (def: #export test Test @@ -43,7 +41,7 @@ (|> expected /.format (<text>.run /.parser) - (try\map (\ instant.equivalence = expected)) + (try\map (\ /.equivalence = expected)) (try.default false)))) /date.test diff --git a/stdlib/source/test/aedifex/artifact/time/date.lux b/stdlib/source/test/aedifex/artifact/time/date.lux index 932d1698e..a68a60a56 100644 --- a/stdlib/source/test/aedifex/artifact/time/date.lux +++ b/stdlib/source/test/aedifex/artifact/time/date.lux @@ -13,25 +13,27 @@ ["n" nat] ["i" int]]] [time - ["." date (#+ Date)] + ["." date] ["." year]]] {#program ["." /]}) (def: #export random - (Random Date) + (Random /.Date) (random.one (function (_ raw) (try.to_maybe (do try.monad - [year (|> raw date.year year.value i.abs (i.% +9,000) (i.+ +1,000) year.year)] - (date.date year - (date.month raw) - (date.day_of_month raw))))) + [year (|> raw date.year year.value i.abs (i.% +9,000) (i.+ +1,000) year.year) + raw (date.date year + (date.month raw) + (date.day_of_month raw))] + (/.date raw)))) random.date)) (def: #export test Test (<| (_.covering /._) + (_.for [/.Date]) ($_ _.and (do random.monad [expected ..random] @@ -39,6 +41,6 @@ (|> expected /.format (<text>.run /.parser) - (try\map (\ date.equivalence = expected)) + (try\map (\ /.equivalence = expected)) (try.default false)))) ))) diff --git a/stdlib/source/test/aedifex/artifact/versioning.lux b/stdlib/source/test/aedifex/artifact/versioning.lux index ab0e94236..c438caca5 100644 --- a/stdlib/source/test/aedifex/artifact/versioning.lux +++ b/stdlib/source/test/aedifex/artifact/versioning.lux @@ -15,6 +15,7 @@ {#program ["." /]} ["$." // #_ + ["#." time] ["#." snapshot ["#/." version]]]) @@ -22,7 +23,7 @@ (Random /.Versioning) ($_ random.and $//snapshot.random - random.instant + $//time.random (random.list 5 $//snapshot/version.random) )) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index d305c19c9..ad63d30cb 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -7,6 +7,7 @@ [program (#+ program:)] ["_" test (#+ Test)] ["@" target] + ["." debug] [abstract [monad (#+ do)] [predicate (#+ Predicate)]] diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index 654aeb748..b881aec70 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -24,7 +24,8 @@ ["#." quotient] ["#." refinement] ["#." resource] - ["#." unit]]) + ["#." unit] + ["#." variance]]) (def: short (Random Text) @@ -178,4 +179,5 @@ /refinement.test /resource.test /unit.test + /variance.test ))) diff --git a/stdlib/source/test/lux/type/variance.lux b/stdlib/source/test/lux/type/variance.lux new file mode 100644 index 000000000..83927d03c --- /dev/null +++ b/stdlib/source/test/lux/type/variance.lux @@ -0,0 +1,34 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [math + ["." random (#+ Random)]]] + {1 + ["." / + ["/#" // #_ + ["#." check]]]}) + +(type: Super + (Ex [sub] [Text sub])) + +(type: Sub + (Super Bit)) + +(def: #export test + Test + (<| (_.covering /._) + ($_ _.and + (_.cover [/.Co] + (and (//check.checks? (type (/.Co Super)) (type (/.Co Sub))) + (not (//check.checks? (type (/.Co Sub)) (type (/.Co Super)))))) + (_.cover [/.Contra] + (and (//check.checks? (type (/.Contra Sub)) (type (/.Contra Super))) + (not (//check.checks? (type (/.Contra Super)) (type (/.Contra Sub)))))) + (_.cover [/.In] + (and (//check.checks? (type (/.In Super)) (type (/.In Super))) + (//check.checks? (type (/.In Sub)) (type (/.In Sub))) + (not (//check.checks? (type (/.In Sub)) (type (/.In Super)))) + (not (//check.checks? (type (/.In Super)) (type (/.In Sub)))))) + ))) |