diff options
Diffstat (limited to 'stdlib')
21 files changed, 673 insertions, 172 deletions
diff --git a/stdlib/source/lux/control/concurrency/promise.lux b/stdlib/source/lux/control/concurrency/promise.lux index b6076f300..acba089fd 100644 --- a/stdlib/source/lux/control/concurrency/promise.lux +++ b/stdlib/source/lux/control/concurrency/promise.lux @@ -10,7 +10,7 @@ ["." io (#+ IO io)]] [data ["." product]] - [type + [type (#+ :share) abstract]] [// ["." thread] @@ -126,10 +126,19 @@ (def: #export (and left right) {#.doc "Sequencing combinator."} (All [a b] (-> (Promise a) (Promise b) (Promise [a b]))) - (do ..monad - [a left - b right] - (wrap [a b]))) + (let [[read! write!] (:share [a b] + [(Promise a) (Promise b)] + [left right] + + [(Promise [a b]) + (Resolver [a b])] + (..promise [])) + _ (io.run (..await (function (_ left) + (..await (function (_ right) + (write! [left right])) + right)) + left))] + read!)) (def: #export (or left right) {#.doc "Heterogeneous alternative combinator."} diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index 480c6fd59..15e017e6b 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -325,3 +325,49 @@ _ false)))) + +(def: #export (lower_case value) + (-> Text Text) + (for {@.old + (:coerce Text + ("jvm invokevirtual:java.lang.String:toLowerCase:" + (:coerce (primitive "java.lang.String") value))) + @.jvm + (:coerce Text + ("jvm member invoke virtual" [] "java.lang.String" "toLowerCase" [] + (:coerce (primitive "java.lang.String") value))) + @.js + (:coerce Text + ("js object do" "toLowerCase" value)) + @.python + (:coerce Text + ("python object do" "lower" value)) + @.lua + (:coerce Text + ("lua apply" ("lua constant" "string.lower") value)) + @.ruby + (:coerce Text + ("ruby object do" "downcase" value))})) + +(def: #export (upper_case value) + (-> Text Text) + (for {@.old + (:coerce Text + ("jvm invokevirtual:java.lang.String:toUpperCase:" + (:coerce (primitive "java.lang.String") value))) + @.jvm + (:coerce Text + ("jvm member invoke virtual" [] "java.lang.String" "toUpperCase" [] + (:coerce (primitive "java.lang.String") value))) + @.js + (:coerce Text + ("js object do" "toUpperCase" value)) + @.python + (:coerce Text + ("python object do" "upper" value)) + @.lua + (:coerce Text + ("lua apply" ("lua constant" "string.upper") value)) + @.ruby + (:coerce Text + ("ruby object do" "upcase" value))})) diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index c67ce2030..398b58aa0 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -19,7 +19,9 @@ ["." time ["." instant] ["." duration] - ["." date]] + ["." date] + ["." day] + ["." month]] [math ["." modular] [number @@ -61,22 +63,23 @@ [int Int (\ int.decimal encode)] [rev Rev (\ rev.decimal encode)] [frac Frac (\ frac.decimal encode)] - [ratio ratio.Ratio (\ ratio.codec encode)] - [text Text text.format] + [ratio ratio.Ratio (\ ratio.codec encode)] [name Name (\ name.codec encode)] [location Location location.format] [code Code code.format] [type Type type.format] - [xml xml.XML (\ xml.codec encode)] - [json json.JSON (\ json.codec encode)] - [instant instant.Instant (\ instant.codec encode)] [duration duration.Duration (\ duration.codec encode)] [date date.Date (\ date.codec encode)] [time time.Time (\ time.codec encode)] + [day day.Day (\ day.codec encode)] + [month month.Month (\ month.codec encode)] + + [xml xml.XML (\ xml.codec encode)] + [json json.JSON (\ json.codec encode)] ) (template [<type> <format>,<codec>] @@ -119,3 +122,13 @@ (|>> (list\map (|>> formatter (format " "))) (text.join_with "") (text.enclose ["(list" ")"]))) + +(def: #export (maybe format) + (All [a] (-> (Format a) (Format (Maybe a)))) + (function (_ value) + (case value + #.None + "#.None" + + (#.Some value) + (..format "(#.Some " (format value) ")")))) diff --git a/stdlib/source/lux/debug.lux b/stdlib/source/lux/debug.lux index 2e353f44f..d0ceb4b5e 100644 --- a/stdlib/source/lux/debug.lux +++ b/stdlib/source/lux/debug.lux @@ -6,7 +6,7 @@ [abstract ["." monad (#+ do)]] [control - [pipe (#+ case> new>)] + [pipe (#+ new>)] ["." function] ["." try (#+ Try)] ["." exception (#+ exception:)] @@ -15,7 +15,7 @@ ["<.>" code]]] [data ["." text - ["%" format]] + ["%" format (#+ Format)]] [format [xml (#+ XML)] ["." json]] @@ -23,19 +23,21 @@ ["." array] ["." list ("#\." functor)] ["." dictionary]]] - ["." meta - ["." location]] + ["." meta] [macro ["." template] ["." syntax (#+ syntax:)] ["." code]] [math [number + [ratio (#+ Ratio)] ["i" int]]] - [time + [time (#+ Time) [instant (#+ Instant)] [duration (#+ Duration)] - [date (#+ Date)]]]) + [date (#+ Date)] + [month (#+ Month)] + [day (#+ Day)]]]) (with_expansions [<jvm> (as_is (import: java/lang/String) @@ -111,7 +113,8 @@ (import: (format [Text .Any] Text))) })) -(def: Inspector (-> Any Text)) +(def: Inspector + (.type (Format Any))) (def: (inspect_tuple inspect) (-> Inspector Inspector) @@ -131,9 +134,9 @@ #.None)] [java/lang/Boolean [(:coerce .Bit) %.bit]] - [java/lang/String [(:coerce .Text) %.text]] [java/lang/Long [(:coerce .Int) %.int]] [java/lang/Number [java/lang/Number::doubleValue %.frac]] + [java/lang/String [(:coerce .Text) %.text]] )) (case (ffi.check [java/lang/Object] object) (#.Some value) @@ -167,8 +170,8 @@ [<type_of> (`` (|> value (~~ (template.splice <then>))))]) (["boolean" [(:coerce .Bit) %.bit]] - ["string" [(:coerce .Text) %.text]] ["number" [(:coerce .Frac) %.frac]] + ["string" [(:coerce .Text) %.text]] ["undefined" [JSON::stringify]]) "object" @@ -379,7 +382,8 @@ [Int %.int] [Rev %.rev] [Frac %.frac] - [Text %.text]))))) + [Text %.text])) + ))) (def: (special_representation representation) (-> (Parser Representation) (Parser Representation)) @@ -389,11 +393,19 @@ [_ (<type>.sub <type>)] (wrap (|>> (:coerce <type>) <formatter>)))] + [Ratio %.ratio] + [Name %.name] + [Location %.location] [Type %.type] [Code %.code] + [Instant %.instant] [Duration %.duration] [Date %.date] + [Time %.time] + [Month %.month] + [Day %.day] + [json.JSON %.json] [XML %.xml])) @@ -406,11 +418,7 @@ [[_ elemT] (<type>.apply (<>.and (<type>.exactly Maybe) <type>.any)) elemR (<type>.local (list elemT) representation)] (wrap (|>> (:coerce (Maybe Any)) - (case> #.None - "#.None" - - (#.Some elemV) - (%.format "(#.Some " (elemR elemV) ")")))))))) + (%.maybe elemR))))))) (def: (variant_representation representation) (-> (Parser Representation) (Parser Representation)) @@ -431,7 +439,7 @@ #.Nil [lefts #1 (rightR right)] - extraR+ + _ (recur (inc lefts) (#.Cons rightR extraR+) right))) _ @@ -462,10 +470,10 @@ (<>.rec (function (_ representation) ($_ <>.either - primitive_representation - (special_representation representation) - (variant_representation representation) - (tuple_representation representation) + ..primitive_representation + (..special_representation representation) + (..variant_representation representation) + (..tuple_representation representation) (do <>.monad [[funcT inputsT+] (<type>.apply (<>.and <type>.any (<>.many <type>.any)))] @@ -505,14 +513,14 @@ (exception: #export (type_hole {location Location} {type Type}) (exception.report - ["Location" (location.format location)] + ["Location" (%.location location)] ["Type" (%.type type)])) (syntax: #export (:hole) (do meta.monad [location meta.location expectedT meta.expected_type] - (meta.fail (exception.construct ..type_hole [location expectedT])))) + (function.constant (exception.throw ..type_hole [location expectedT])))) (type: Target [Text (Maybe Code)]) @@ -553,19 +561,18 @@ (monad.map ! (function (_ [name format]) (if (dictionary.key? environment name) (wrap [name format]) - (meta.fail (exception.construct ..unknown_local_binding [name])))) + (function.constant (exception.throw ..unknown_local_binding [name])))) targets)))] (wrap (list (` (..log! ("lux text concat" (~ (code.text (%.format (%.location location) text.new_line))) ((~! exception.report) - (~+ (|> targets - list.reverse - (list\map (function (_ [name format]) - (let [format (case format - #.None - (` (~! ..inspect)) - - (#.Some format) - format)] - (` [(~ (code.text name)) - ((~ format) (~ (code.local_identifier name)))])))))))))))))) + (~+ (list\map (function (_ [name format]) + (let [format (case format + #.None + (` (~! ..inspect)) + + (#.Some format) + format)] + (` [(~ (code.text name)) + ((~ format) (~ (code.local_identifier name)))]))) + targets)))))))))) diff --git a/stdlib/source/lux/macro/template.lux b/stdlib/source/lux/macro/template.lux index 6271b7cd4..b970cae05 100644 --- a/stdlib/source/lux/macro/template.lux +++ b/stdlib/source/lux/macro/template.lux @@ -1,5 +1,5 @@ (.module: - [lux #* + [lux (#- let) ["." meta] [abstract ["." monad (#+ do)]] @@ -55,8 +55,8 @@ (def: (snippet module_side?) (-> Bit (Parser Text)) - (let [full_identifier (..name_side module_side? <code>.identifier) - full_tag (..name_side module_side? <code>.tag)] + (.let [full_identifier (..name_side module_side? <code>.identifier) + full_tag (..name_side module_side? <code>.tag)] ($_ <>.either <code>.text (if module_side? @@ -140,12 +140,12 @@ (-> Local Macro) ("lux macro" (function (_ inputs compiler) - (let [parameters_count (list.size parameters) - inputs_count (list.size inputs)] + (.let [parameters_count (list.size parameters) + inputs_count (list.size inputs)] (if (nat.= parameters_count inputs_count) - (let [environment (: Environment - (|> (list.zip/2 parameters inputs) - (dictionary.from_list text.hash)))] + (.let [environment (: Environment + (|> (list.zip/2 parameters inputs) + (dictionary.from_list text.hash)))] (#.Right [compiler (list\map (..apply environment) template)])) (exception.throw ..irregular_arguments [parameters_count inputs_count])))))) @@ -159,7 +159,7 @@ #parameters parameters #template template}))) -(syntax: #export (with {locals (<code>.tuple (<>.some ..local))} +(syntax: #export (let {locals (<code>.tuple (<>.some ..local))} body) (do meta.monad [here_name meta.current_module_name @@ -177,7 +177,7 @@ locals))] (if expression? (//.with_gensyms [g!body] - (wrap (list (` (let [(~ g!body) (~ body)] + (wrap (list (` (.let [(~ g!body) (~ body)] (exec (~ g!pop) (~ g!body))))))) (wrap (list body diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index bd7927a15..48dc7c792 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -10,6 +10,7 @@ ["." exception (#+ exception:)] ["." io] [concurrency + ["." atom (#+ Atom)] ["." promise (#+ Promise) ("#\." monad)]] ["<>" parser ["<c>" code]]] @@ -21,7 +22,9 @@ ["%" format (#+ format)]] [collection ["." list ("#\." functor fold)] - ["." set (#+ Set)]]] + ["." set (#+ Set)] + ["." dictionary #_ + ["#" ordered (#+ Dictionary)]]]] [time ["." instant] ["." duration (#+ Duration)]] @@ -59,7 +62,9 @@ #actual_coverage (set.new name.hash)}) (template [<name> <category>] - [(def: <name> Tally (update@ <category> .inc start))] + [(def: <name> + Tally + (update@ <category> .inc ..start))] [success #successes] [failure #failures] @@ -71,24 +76,30 @@ (type: #export Test (Random Assertion)) -(def: separator text.new_line) +(def: separator + text.new_line) (def: #export (and' left right) {#.doc "Sequencing combinator."} (-> Assertion Assertion Assertion) - (do promise.monad - [[l_tally l_documentation] left - [r_tally r_documentation] right] - (wrap [(add_tally l_tally r_tally) - (format l_documentation ..separator r_documentation)]))) + (let [[read! write!] (: [(Promise [Tally Text]) + (promise.Resolver [Tally Text])] + (promise.promise [])) + _ (|> left + (promise.await (function (_ [l_tally l_documentation]) + (promise.await (function (_ [r_tally r_documentation]) + (write! [(add_tally l_tally r_tally) + (format l_documentation ..separator r_documentation)])) + right))) + io.run)] + read!)) (def: #export (and left right) {#.doc "Sequencing combinator."} (-> Test Test Test) - (do random.monad - [left left - right right] - (wrap (..and' left right)))) + (do {! random.monad} + [left left] + (\ ! map (..and' left) right))) (def: context_prefix text.tab) @@ -116,17 +127,17 @@ (-> Text Bit Assertion) (<| promise\wrap (if condition - [success (format ..success_prefix message)] - [failure (format ..failure_prefix message)]))) + [..success (format ..success_prefix message)] + [..failure (format ..failure_prefix message)]))) (def: #export (test message condition) {#.doc "Check that a condition is #1, and fail with the given message otherwise."} (-> Text Bit Test) - (\ random.monad wrap (assert message condition))) + (random\wrap (assert message condition))) (def: #export (lift message random) (-> Text (Random Bit) Test) - (\ random.monad map (..assert message) random)) + (random\map (..assert message) random)) (def: pcg32_magic_inc Nat @@ -169,9 +180,7 @@ (promise.time_out millis_time_out instance) #.None - (do ! - [output instance] - (wrap (#.Some output))))] + (\ ! map (|>> #.Some) instance))] (case outcome (#.Some [tally documentation]) (if (failed? tally) @@ -185,7 +194,7 @@ #.None (exec - ("lux io log" "Time-out reached! Retrying tests...") + (debug.log! "Time-out reached! Retrying tests...") (product.right (recur prng)))))]))))) ## TODO: Figure out why tests sometimes freeze and fix it. Delete "seed'" afterwards. @@ -249,7 +258,7 @@ ["Pending definitions to cover" (report missing)] ["Unexpected definitions covered" (report unexpected)]))) -(def: failure_exit_code -1) +(def: failure_exit_code +1) (def: success_exit_code +0) (def: #export (run! test) @@ -283,7 +292,7 @@ (def: (|cover| coverage condition) (-> (List Name) Bit Test) (|> (..|cover'| coverage condition) - (\ random.monad wrap))) + random\wrap)) (def: (|for| coverage test) (-> (List Name) Test Test) @@ -385,27 +394,48 @@ (def: #export (in_parallel tests) (-> (List Test) Test) - (do random.monad - [seed random.nat - #let [prng (random.pcg32 [..pcg32_magic_inc seed]) - run! (: (-> Test Assertion) - (|>> (random.run prng) - product.right - io.io - "lux try" - (case> (#try.Success output) - output - - (#try.Failure error) - (..assert (exception.construct ..error_during_execution [error]) false)) - io.io - promise.future - promise\join))]] - (wrap (do {! promise.monad} - [assertions (monad.seq ! (list\map run! tests))] - (wrap [(|> assertions - (list\map product.left) - (list\fold ..add_tally ..start)) - (|> assertions - (list\map product.right) - (text.join_with ..separator))]))))) + (case (list.size tests) + 0 + (random\wrap (promise\wrap [..start ""])) + + expected_tests + (do random.monad + [seed random.nat + #let [prng (random.pcg32 [..pcg32_magic_inc seed]) + run! (: (-> Test Assertion) + (|>> (random.run prng) + product.right + io.io + "lux try" + (case> (#try.Success output) + output + + (#try.Failure error) + (..assert (exception.construct ..error_during_execution [error]) false)) + io.io + promise.future + promise\join)) + state (: (Atom (Dictionary Nat [Tally Text])) + (atom.atom (dictionary.new n.order))) + [read! write!] (: [Assertion + (promise.Resolver [Tally Text])] + (promise.promise [])) + _ (io.run (monad.map io.monad + (function (_ [index test]) + (promise.await (function (_ assertion) + (do io.monad + [[_ results] (atom.update (dictionary.put index assertion) state)] + (if (n.= expected_tests (dictionary.size results)) + (let [assertions (|> results + dictionary.entries + (list\map product.right))] + (write! [(|> assertions + (list\map product.left) + (list\fold ..add_tally ..start)) + (|> assertions + (list\map product.right) + (text.join_with ..separator))])) + (wrap [])))) + (run! test))) + (list.enumeration tests)))]] + (wrap read!)))) diff --git a/stdlib/source/lux/time/day.lux b/stdlib/source/lux/time/day.lux index 6d9b7f4a5..94b1dcabd 100644 --- a/stdlib/source/lux/time/day.lux +++ b/stdlib/source/lux/time/day.lux @@ -3,7 +3,13 @@ [abstract [equivalence (#+ Equivalence)] [order (#+ Order)] - [enum (#+ Enum)]] + [enum (#+ Enum)] + [codec (#+ Codec)]] + [control + ["." try] + ["." exception (#+ exception:)]] + [data + ["." text]] [math [number ["n" nat]]]]) @@ -79,3 +85,30 @@ #Friday #Thursday #Saturday #Friday #Sunday #Saturday))) + +(exception: #export (not_a_day_of_the_week {value Text}) + (exception.report + ["Value" (text.format value)])) + +(structure: #export codec + (Codec Text Day) + + (def: (encode value) + (case value + #Monday "Monday" + #Tuesday "Tuesday" + #Wednesday "Wednesday" + #Thursday "Thursday" + #Friday "Friday" + #Saturday "Saturday" + #Sunday "Sunday")) + (def: (decode value) + (case value + "Monday" (#try.Success #..Monday) + "Tuesday" (#try.Success #..Tuesday) + "Wednesday" (#try.Success #..Wednesday) + "Thursday" (#try.Success #..Thursday) + "Friday" (#try.Success #..Friday) + "Saturday" (#try.Success #..Saturday) + "Sunday" (#try.Success #..Sunday) + _ (exception.throw ..not_a_day_of_the_week [value])))) diff --git a/stdlib/source/lux/time/month.lux b/stdlib/source/lux/time/month.lux index 60d66ce28..34be47c1c 100644 --- a/stdlib/source/lux/time/month.lux +++ b/stdlib/source/lux/time/month.lux @@ -4,10 +4,13 @@ [equivalence (#+ Equivalence)] [hash (#+ Hash)] [order (#+ Order)] - [enum (#+ Enum)]] + [enum (#+ Enum)] + [codec (#+ Codec)]] [control ["." try (#+ Try)] ["." exception (#+ exception:)]] + [data + ["." text]] [math [number ["n" nat]]]]) @@ -176,3 +179,40 @@ #October #November #December)) + +(exception: #export (not_a_month_of_the_year {value Text}) + (exception.report + ["Value" (text.format value)])) + +(structure: #export codec + (Codec Text Month) + + (def: (encode value) + (case value + #January "January" + #February "February" + #March "March" + #April "April" + #May "May" + #June "June" + #July "July" + #August "August" + #September "September" + #October "October" + #November "November" + #December "December")) + (def: (decode value) + (case value + "January" (#try.Success #January) + "February" (#try.Success #February) + "March" (#try.Success #March) + "April" (#try.Success #April) + "May" (#try.Success #May) + "June" (#try.Success #June) + "July" (#try.Success #July) + "August" (#try.Success #August) + "September" (#try.Success #September) + "October" (#try.Success #October) + "November" (#try.Success #November) + "December" (#try.Success #December) + _ (exception.throw ..not_a_month_of_the_year [value])))) diff --git a/stdlib/source/lux/world/file/watch.lux b/stdlib/source/lux/world/file/watch.lux index 4695c1e00..0a826717f 100644 --- a/stdlib/source/lux/world/file/watch.lux +++ b/stdlib/source/lux/world/file/watch.lux @@ -356,10 +356,15 @@ (def: (default\\start watch_events watcher path) (-> (List Watch_Event) java/nio/file/WatchService //.Path (Promise (Try java/nio/file/WatchKey))) - (promise.future - (java/nio/file/Path::register watcher - (array.from_list watch_events) - (|> path java/io/File::new java/io/File::toPath)))) + (let [watch_events' (list\fold (function (_ [index watch_event] watch_events') + (ffi.array_write index watch_event watch_events')) + (ffi.array (java/nio/file/WatchEvent$Kind java/lang/Object) + (list.size watch_events)) + (list.enumeration watch_events))] + (promise.future + (java/nio/file/Path::register watcher + watch_events' + (|> path java/io/File::new java/io/File::toPath))))) (def: (default\\poll watcher) (-> java/nio/file/WatchService (IO (Try (List [//.Path Concern])))) diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index ae9bde67c..b7d0d29d9 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -8,42 +8,49 @@ ["#." artifact] ["#." cli] ["#." command] - ## ["#." input] - ## ["#." local] - ## ["#." dependency - ## ## ["#/." resolution] - ## ["#/." status]] + ["#." dependency + ["#/." resolution] + ["#/." status]] + ["#." hash] + ["#." input] + ["#." local] + ["#." metadata] ## ["#." package] ## ["#." profile] ## ["#." project] - ## ["#." hash] ## ["#." parser] ## ["#." pom] ## ["#." repository] ## ["#." runtime] - ## ["#." metadata] ]) +(def: dependency + Test + ($_ _.and + /dependency.test + /dependency/resolution.test + /dependency/status.test + )) + (def: test Test ($_ _.and /artifact.test /cli.test /command.test - ## /input.test - ## /local.test - ## /dependency.test - ## ## /dependency/resolution.test - ## /dependency/status.test + ..dependency + /hash.test + /input.test + /local.test + /metadata.test + ## /package.test ## /profile.test ## /project.test - ## /hash.test ## /parser.test ## /pom.test ## /repository.test ## /runtime.test - ## /metadata.test )) (program: args diff --git a/stdlib/source/test/aedifex/command/test.lux b/stdlib/source/test/aedifex/command/test.lux index 36c21b520..6b7ba9324 100644 --- a/stdlib/source/test/aedifex/command/test.lux +++ b/stdlib/source/test/aedifex/command/test.lux @@ -44,7 +44,7 @@ Test (<| (_.covering /._) (do {! random.monad} - [program (random.ascii/alpha 5) + [test (random.ascii/alpha 5) target (random.ascii/alpha 5) home (random.ascii/alpha 5) working_directory (random.ascii/alpha 5) @@ -52,11 +52,11 @@ (\ ///.monoid identity)) with_target (: (-> Profile Profile) (set@ #///.target (#.Some target))) - with_program (: (-> Profile Profile) - (set@ #///.program (#.Some program))) + with_test (: (-> Profile Profile) + (set@ #///.test (#.Some test))) profile (|> empty_profile - with_program + with_test with_target)] resolution @build.resolution] ($_ _.and diff --git a/stdlib/source/test/aedifex/local.lux b/stdlib/source/test/aedifex/local.lux index 6729d4485..3f6574ed9 100644 --- a/stdlib/source/test/aedifex/local.lux +++ b/stdlib/source/test/aedifex/local.lux @@ -10,7 +10,9 @@ [// ["@." artifact]] {#program - ["." /]}) + ["." / + ["/#" // #_ + ["#." artifact]]]}) (def: #export test Test @@ -20,5 +22,5 @@ ($_ _.and (_.cover [/.repository /.uri] (text.starts_with? /.repository - (/.uri sample))) + (/.uri (get@ #//artifact.version sample) sample))) )))) diff --git a/stdlib/source/test/aedifex/metadata/artifact.lux b/stdlib/source/test/aedifex/metadata/artifact.lux index 9977be8e1..6c3e509b1 100644 --- a/stdlib/source/test/aedifex/metadata/artifact.lux +++ b/stdlib/source/test/aedifex/metadata/artifact.lux @@ -33,9 +33,9 @@ (random.ascii/alpha 5) (random.list 5 (random.ascii/alpha 5)) (do {! random.monad} - [year (\ ! map (|>> (n.% 10,000) .int) random.nat) - month (\ ! map (n.% 13) random.nat) - day_of_month (\ ! map (n.% 29) random.nat) + [year (\ ! map (|>> (n.% 9,000) (n.+ 1,000) .int) random.nat) + month (\ ! map (|>> (n.% 12) (n.+ 1)) random.nat) + day_of_month (\ ! map (|>> (n.% 28) (n.+ 1)) random.nat) hour (\ ! map (n.% 24) random.nat) minute (\ ! map (n.% 60) random.nat) second (\ ! map (n.% 60) random.nat)] @@ -63,6 +63,7 @@ (_.cover [/.format /.parser] (|> expected /.format + list (<xml>.run /.parser) (try\map (\ /.equivalence = expected)) (try.default false)))) diff --git a/stdlib/source/test/aedifex/metadata/snapshot.lux b/stdlib/source/test/aedifex/metadata/snapshot.lux index a2f0b65db..1858cae25 100644 --- a/stdlib/source/test/aedifex/metadata/snapshot.lux +++ b/stdlib/source/test/aedifex/metadata/snapshot.lux @@ -20,21 +20,28 @@ ["." instant (#+ Instant)] ["." duration]] [math - ["." random (#+ Random)]] + ["." random (#+ Random) ("#\." monad)]] [macro ["." code]]] ["$." /// #_ ["#." artifact - ["#/." type]]] + ["#/." type] + ["#/." time] + ["#/." snapshot #_ + ["#/." version]]]] {#program - ["." /]}) + ["." / + [/// + [artifact + [versioning (#+ Versioning)] + ["#." snapshot]]]]}) (def: random_instant (Random Instant) (do {! random.monad} - [year (\ ! map (|>> (n.% 10,000) .int) random.nat) - month (\ ! map (n.% 13) random.nat) - day_of_month (\ ! map (n.% 29) random.nat) + [year (\ ! map (|>> (n.% 9,000) (n.+ 1,000) .int) random.nat) + month (\ ! map (|>> (n.% 12) (n.+ 1)) random.nat) + day_of_month (\ ! map (|>> (n.% 28) (n.+ 1)) random.nat) hour (\ ! map (n.% 24) random.nat) minute (\ ! map (n.% 60) random.nat) second (\ ! map (n.% 60) random.nat)] @@ -51,18 +58,19 @@ (wrap (instant.from_date_time date time))))))) (def: random_versioning - (Random /.Versioning) + (Random Versioning) ($_ random.and - ..random_instant - random.nat - (random.list 5 $///artifact/type.random) + (random\wrap #/snapshot.Local) + $///artifact/time.random + (random.list 5 $///artifact/snapshot/version.random) )) (def: #export random (Random /.Metadata) ($_ random.and $///artifact.random - ..random_versioning)) + ..random_versioning + )) (def: #export test Test @@ -76,6 +84,7 @@ (_.cover [/.format /.parser] (|> expected /.format + list (<xml>.run /.parser) (try\map (\ /.equivalence = expected)) (try.default false)))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 69ce89d45..de14f2dea 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -31,6 +31,7 @@ ["#." abstract] ["#." control] ["#." data] + ["#." debug] ["#." locale] ["#." macro] ["#." math] @@ -214,6 +215,7 @@ (`` (_.in_parallel (list /abstract.test /control.test /data.test + /debug.test /locale.test /macro.test /math.test diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index b5c9f433b..345dbdc26 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -205,7 +205,10 @@ #let [dynamic (random.filter (|>> (\ /.equivalence = static) not) (random.ascii/alpha 1))] pre dynamic - post dynamic] + post dynamic + + lower (random.ascii/lower 1) + upper (random.ascii/upper 1)] ($_ _.and (_.cover [/.concat] (n.= (set.size characters) @@ -231,6 +234,46 @@ #.None false)) + (_.cover [/.lower_case] + (let [effectiveness! + (|> upper + /.lower_case + (\ /.equivalence = upper) + not) + + idempotence! + (|> lower + /.lower_case + (\ /.equivalence = lower)) + + inverse! + (|> lower + /.upper_case + /.lower_case + (\ /.equivalence = lower))] + (and effectiveness! + idempotence! + inverse!))) + (_.cover [/.upper_case] + (let [effectiveness! + (|> lower + /.upper_case + (\ /.equivalence = lower) + not) + + idempotence! + (|> upper + /.upper_case + (\ /.equivalence = upper)) + + inverse! + (|> upper + /.lower_case + /.upper_case + (\ /.equivalence = upper))] + (and effectiveness! + idempotence! + inverse!))) ))) (def: #export test diff --git a/stdlib/source/test/lux/data/text/escape.lux b/stdlib/source/test/lux/data/text/escape.lux index e58413ac6..a91ba6247 100644 --- a/stdlib/source/test/lux/data/text/escape.lux +++ b/stdlib/source/test/lux/data/text/escape.lux @@ -141,13 +141,13 @@ (#try.Failure error) true (#try.Success _) false))))] (_.cover [/.invalid_unicode_escape] - (template.with [(!invalid <code>) - [(case (/.un_escape (format "\u" <code>)) - (#try.Success _) - false + (template.let [(!invalid <code>) + [(case (/.un_escape (format "\u" <code>)) + (#try.Success _) + false - (#try.Failure error) - (exception.match? /.invalid_unicode_escape error))]] + (#try.Failure error) + (exception.match? /.invalid_unicode_escape error))]] (and (!invalid (\ n.hex encode too_short)) (!invalid code))))) (_.cover [/.escaped] diff --git a/stdlib/source/test/lux/debug.lux b/stdlib/source/test/lux/debug.lux new file mode 100644 index 000000000..508f9fd6d --- /dev/null +++ b/stdlib/source/test/lux/debug.lux @@ -0,0 +1,254 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." try ("#\." functor)] + ["." exception]] + [data + ["." text ("#\." equivalence) + ["%" format (#+ format)]] + [collection + ["." list ("#\." functor)]] + [format + [json (#+ JSON)] + [xml (#+ XML)]]] + ["." macro + [syntax (#+ syntax:)] + ["." code]] + [math + ["." random (#+ Random)] + [number + [ratio (#+ Ratio)]]] + [time (#+ Time) + [instant (#+ Instant)] + [date (#+ Date)] + [duration (#+ Duration)] + [month (#+ Month)] + [day (#+ Day)]]] + {1 + ["." /]} + ["$." // #_ + ["#." type] + [data + ["#." name] + [format + ["#." json] + ["#." xml]]] + [macro + ["#." code]] + [math + [number + ["#." ratio]]] + [meta + ["#." location]]]) + +(def: can_represent_simple_types + (Random Bit) + (do random.monad + [sample_bit random.bit + sample_int random.int + sample_frac random.frac + sample_text (random.ascii/upper 10) + sample_nat random.nat + sample_rev random.rev] + (wrap (`` (and (~~ (template [<type> <format> <sample>] + [(|> (/.represent <type> <sample>) + (try\map (text\= (<format> <sample>))) + (try.default false))] + + [Bit %.bit sample_bit] + [Nat %.nat sample_nat] + [Int %.int sample_int] + [Rev %.rev sample_rev] + [Frac %.frac sample_frac] + [Text %.text sample_text])) + ))))) + +(def: can_represent_structure_types + (Random Bit) + (do random.monad + [sample_bit random.bit + sample_int random.int + sample_frac random.frac] + (wrap (`` (and (case (/.represent (type [Bit Int Frac]) + [sample_bit sample_int sample_frac]) + (#try.Success actual) + (text\= (format "[" (%.bit sample_bit) + " " (%.int sample_int) + " " (%.frac sample_frac) + "]") + actual) + + (#try.Failure error) + false) + ## TODO: Uncomment after switching from the old (tag+last?) to the new (lefts+right?) representation for variants + ## (~~ (template [<lefts> <right?> <value> <format>] + ## [(|> (/.represent (type (| Bit Int Frac)) + ## (: (| Bit Int Frac) + ## (<lefts> <right?> <value>))) + ## (try\map (text\= (format "(" (%.nat <lefts>) + ## " " (%.bit <right?>) + ## " " (<format> <value>) ")"))) + ## (try.default false))] + + ## [0 #0 sample_bit %.bit] + ## [1 #0 sample_int %.int] + ## [1 #1 sample_frac %.frac] + ## )) + ))))) + +(def: can_represent_complex_types + (Random Bit) + (do random.monad + [sample_ratio $//ratio.random + sample_name ($//name.random 5 5) + sample_location $//location.random + sample_type $//type.random + sample_code $//code.random + sample_xml $//xml.random + sample_json $//json.random] + (wrap (`` (and (~~ (template [<type> <format> <sample>] + [(|> (/.represent <type> <sample>) + (try\map (text\= (<format> <sample>))) + (try.default false))] + + [Ratio %.ratio sample_ratio] + [Name %.name sample_name] + [Location %.location sample_location] + [Code %.code sample_code] + [Type %.type sample_type] + [XML %.xml sample_xml] + [JSON %.json sample_json])) + ))))) + +(def: can_represent_time_types + (Random Bit) + (do random.monad + [sample_instant random.instant + sample_duration random.duration + sample_date random.date + sample_month random.month + sample_time random.time + sample_day random.day] + (wrap (`` (and (~~ (template [<type> <format> <sample>] + [(|> (/.represent <type> <sample>) + (try\map (text\= (<format> <sample>))) + (try.default false))] + + [Instant %.instant sample_instant] + [Duration %.duration sample_duration] + [Date %.date sample_date] + [Month %.month sample_month] + [Time %.time sample_time] + [Day %.day sample_day])) + ))))) + +(def: representation + Test + (do random.monad + [sample_bit random.bit + sample_nat random.nat + sample_int random.int + sample_frac random.frac + + can_represent_simple_types! ..can_represent_simple_types + can_represent_structure_types! ..can_represent_structure_types + can_represent_complex_types! ..can_represent_complex_types + can_represent_time_types! ..can_represent_time_types] + ($_ _.and + (_.cover [/.represent] + (`` (and can_represent_simple_types! + can_represent_structure_types! + can_represent_complex_types! + can_represent_time_types! + + (|> (/.represent .Any sample_frac) + (try\map (text\= "[]")) + (try.default false)) + (|> (/.represent (type (List Nat)) (: (List Nat) (list sample_nat))) + (try\map (text\= (%.list %.nat (list sample_nat)))) + (try.default false)) + (~~ (template [<sample>] + [(|> (/.represent (type (Maybe Nat)) (: (Maybe Nat) <sample>)) + (try\map (text\= (%.maybe %.nat <sample>))) + (try.default false))] + + [(#.Some sample_nat)] + [#.None] + )) + ))) + (_.cover [/.cannot_represent_value] + (case (/.represent (-> Nat Nat) (|>>)) + (#try.Success representation) + false + + (#try.Failure error) + (exception.match? /.cannot_represent_value error))) + ))) + +(def: inspection + Test + (do random.monad + [sample_bit random.bit + sample_int random.int + sample_frac random.frac + sample_text (random.ascii/upper 10)] + (_.cover [/.inspect] + (`` (and (~~ (template [<format> <sample>] + [(text\= (<format> <sample>) (/.inspect <sample>))] + + [%.bit sample_bit] + [%.int sample_int] + [%.frac sample_frac] + [%.text sample_text] + )) + (text\= (|> (list sample_bit sample_int sample_frac sample_text) + (: (List Any)) + (list\map /.inspect) + (text.join_with " ") + (text.enclose ["[" "]"])) + (/.inspect [sample_bit sample_int sample_frac sample_text]))))))) + +(syntax: (macro_error macro) + (function (_ compiler) + (case ((macro.expand macro) compiler) + (#try.Failure error) + (#try.Success [compiler (list (code.text error))]) + + (#try.Success _) + (#try.Failure "OOPS!")))) + +(type: My_Text + Text) + +(def: #export test + Test + (<| (_.covering /._) + ($_ _.and + ..inspection + ..representation + (_.cover [/.:hole /.type_hole] + (let [error (: My_Text (..macro_error (/.:hole)))] + (and (exception.match? /.type_hole error) + (text.contains? (%.type My_Text) error)))) + (do random.monad + [foo (random.ascii/upper 10) + bar random.nat + baz random.bit] + (_.cover [/.here] + (exec + (/.here) + (/.here foo + {bar %.nat}) + true))) + (_.cover [/.unknown_local_binding] + (exception.match? /.unknown_local_binding + (..macro_error (/.here yolo)))) + (_.cover [/.private] + (exec + (: (/.private /.Inspector) + /.inspect) + true)) + ))) diff --git a/stdlib/source/test/lux/macro/template.lux b/stdlib/source/test/lux/macro/template.lux index 9f8b5af6c..8f68ff501 100644 --- a/stdlib/source/test/lux/macro/template.lux +++ b/stdlib/source/test/lux/macro/template.lux @@ -19,8 +19,8 @@ {1 ["." /]}) -(/.with [(!pow/2 <scalar>) - [(nat.* <scalar> <scalar>)]] +(/.let [(!pow/2 <scalar>) + [(nat.* <scalar> <scalar>)]] (def: pow/2 (-> Nat Nat) (|>> !pow/2))) @@ -82,16 +82,16 @@ (nat.= right var1))))) (do ! [scalar random.nat] - (_.cover [/.with] + (_.cover [/.let] (let [can_use_with_statements! (nat.= ($_ nat.* scalar scalar) (..pow/2 scalar))] (and can_use_with_statements! - (/.with [(pow/3 <scalar>) - [($_ nat.* <scalar> <scalar> <scalar>)] + (/.let [(pow/3 <scalar>) + [($_ nat.* <scalar> <scalar> <scalar>)] - (pow/9 <scalar>) - [(pow/3 (pow/3 <scalar>))]] + (pow/9 <scalar>) + [(pow/3 (pow/3 <scalar>))]] (let [can_use_with_expressions! (nat.= ($_ nat.* scalar scalar scalar) (pow/3 scalar)) @@ -113,8 +113,8 @@ can_shadow!))) )))) (_.cover [/.irregular_arguments] - (/.with [(arity/3 <0> <1> <2>) - [""]] + (/.let [(arity/3 <0> <1> <2>) + [""]] (exception.match? /.irregular_arguments (macro_error (arity/3 "a" "b"))))) ))) diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux index 3645ef1bf..919a9c694 100644 --- a/stdlib/source/test/lux/math.lux +++ b/stdlib/source/test/lux/math.lux @@ -98,20 +98,20 @@ angle (\ ! map (f.* /.tau) random.safe_frac) sample (\ ! map f.abs random.safe_frac) big (\ ! map (f.* +1,000,000,000.00) random.safe_frac)] - (template.with [(odd! <function>) - [(_.cover [<function>] - (~= (f.negate (<function> angle)) - (<function> (f.negate angle))))] + (template.let [(odd! <function>) + [(_.cover [<function>] + (~= (f.negate (<function> angle)) + (<function> (f.negate angle))))] - (even! <function>) - [(_.cover [<function>] - (~= (<function> angle) - (<function> (f.negate angle))))] + (even! <function>) + [(_.cover [<function>] + (~= (<function> angle) + (<function> (f.negate angle))))] - (inverse! <left> <right> <input>) - [(_.cover [<left> <right>] - (~= (<right> <input>) - (<left> (f./ <input> +1.0))))]] + (inverse! <left> <right> <input>) + [(_.cover [<left> <right>] + (~= (<right> <input>) + (<left> (f./ <input> +1.0))))]] ($_ _.and (odd! /.sinh) (even! /.cosh) diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index b881aec70..86e7a63e5 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -39,13 +39,13 @@ (def: #export random (Random Type) - (let [(^open "R\.") random.monad] + (let [(^open "random\.") random.monad] (random.rec (function (_ recur) (let [pairG (random.and recur recur) idG random.nat - quantifiedG (random.and (R\wrap (list)) recur)] + quantifiedG (random.and (random\wrap (list)) recur)] ($_ random.or - (random.and ..short (R\wrap (list))) + (random.and ..short (random\wrap (list))) pairG pairG pairG |