diff options
Diffstat (limited to '')
-rwxr-xr-x | shell/lux.bat | 5 | ||||
-rw-r--r-- | stdlib/source/lux/control/parser/xml.lux | 113 | ||||
-rw-r--r-- | stdlib/source/lux/world/program.lux | 25 | ||||
-rw-r--r-- | stdlib/source/program/aedifex/artifact/snapshot.lux | 14 | ||||
-rw-r--r-- | stdlib/source/program/aedifex/artifact/snapshot/build.lux | 8 | ||||
-rw-r--r-- | stdlib/source/program/aedifex/artifact/snapshot/stamp.lux | 7 | ||||
-rw-r--r-- | stdlib/source/program/aedifex/artifact/snapshot/version.lux | 11 | ||||
-rw-r--r-- | stdlib/source/program/aedifex/artifact/versioning.lux | 17 | ||||
-rw-r--r-- | stdlib/source/program/aedifex/metadata/artifact.lux | 18 | ||||
-rw-r--r-- | stdlib/source/program/aedifex/metadata/snapshot.lux | 11 | ||||
-rw-r--r-- | stdlib/source/program/aedifex/pom.lux | 73 | ||||
-rw-r--r-- | stdlib/source/test/lux/control/parser/xml.lux | 78 | ||||
-rw-r--r-- | stdlib/source/test/lux/data/text/unicode/set.lux | 1 | ||||
-rw-r--r-- | stdlib/source/test/lux/debug.lux | 63 | ||||
-rw-r--r-- | stdlib/source/test/lux/ffi.js.lux | 104 |
15 files changed, 270 insertions, 278 deletions
diff --git a/shell/lux.bat b/shell/lux.bat new file mode 100755 index 000000000..98155c8f6 --- /dev/null +++ b/shell/lux.bat @@ -0,0 +1,5 @@ +@echo off +SETLOCAL +cmd /k "java -jar %~dp0aedifex.jar %*" +EXIT /B 0 + diff --git a/stdlib/source/lux/control/parser/xml.lux b/stdlib/source/lux/control/parser/xml.lux index a9d9144b8..9eb794c2d 100644 --- a/stdlib/source/lux/control/parser/xml.lux +++ b/stdlib/source/lux/control/parser/xml.lux @@ -3,7 +3,7 @@ [abstract [monad (#+ do)]] [control - ["." try (#+ Try)] + ["." try (#+ Try) ("#\." functor)] ["." exception (#+ exception:)]] [data ["." name ("#\." equivalence codec)] @@ -13,11 +13,11 @@ ["." list] ["." dictionary]] [format - ["/" xml (#+ Attribute Tag XML)]]]] + ["/" xml (#+ Attribute Attrs Tag XML)]]]] ["." //]) (type: #export (Parser a) - (//.Parser (List XML) a)) + (//.Parser [Attrs (List XML)] a)) (exception: #export empty_input) (exception: #export unexpected_input) @@ -36,9 +36,24 @@ (exception.report ["Inputs" (exception.enumerate (\ /.codec encode) inputs)])) +(def: (run' parser attrs documents) + (All [a] (-> (Parser a) Attrs (List XML) (Try a))) + (case (//.run parser [attrs documents]) + (#try.Success [[attrs' remaining] output]) + (if (list.empty? remaining) + (#try.Success output) + (exception.throw ..unconsumed_inputs remaining)) + + (#try.Failure error) + (#try.Failure error))) + +(def: #export (run parser documents) + (All [a] (-> (Parser a) (List XML) (Try a))) + (..run' parser /.attributes documents)) + (def: #export text (Parser Text) - (function (_ documents) + (function (_ [attrs documents]) (case documents #.Nil (exception.throw ..empty_input []) @@ -46,31 +61,14 @@ (#.Cons head tail) (case head (#/.Text value) - (#try.Success [tail value]) + (#try.Success [[attrs tail] value]) (#/.Node _) (exception.throw ..unexpected_input []))))) -(def: #export (node expected) - (-> Tag (Parser Any)) - (function (_ documents) - (case documents - #.Nil - (exception.throw ..empty_input []) - - (#.Cons head _) - (case head - (#/.Text _) - (exception.throw ..unexpected_input []) - - (#/.Node actual _attributes _children) - (if (name\= expected actual) - (#try.Success [documents []]) - (exception.throw ..wrong_tag [expected actual])))))) - (def: #export tag (Parser Tag) - (function (_ documents) + (function (_ [attrs documents]) (case documents #.Nil (exception.throw ..empty_input []) @@ -80,43 +78,22 @@ (#/.Text _) (exception.throw ..unexpected_input []) - (#/.Node tag _attributes _children) - (#try.Success [documents tag]))))) + (#/.Node tag _ _) + (#try.Success [[attrs documents] tag]))))) (def: #export (attribute name) (-> Attribute (Parser Text)) - (function (_ documents) - (case documents - #.Nil - (exception.throw ..empty_input []) + (function (_ [attrs documents]) + (case (dictionary.get name attrs) + #.None + (exception.throw ..unknown_attribute [name (dictionary.keys attrs)]) - (#.Cons head _) - (case head - (#/.Text _) - (exception.throw ..unexpected_input []) - - (#/.Node tag attributes children) - (case (dictionary.get name attributes) - #.None - (exception.throw ..unknown_attribute [name (dictionary.keys attributes)]) - - (#.Some value) - (#try.Success [documents value])))))) + (#.Some value) + (#try.Success [[attrs documents] value])))) -(def: #export (run parser documents) - (All [a] (-> (Parser a) (List XML) (Try a))) - (case (//.run parser documents) - (#try.Success [remaining output]) - (if (list.empty? remaining) - (#try.Success output) - (exception.throw ..unconsumed_inputs remaining)) - - (#try.Failure error) - (#try.Failure error))) - -(def: #export (children parser) - (All [a] (-> (Parser a) (Parser a))) - (function (_ documents) +(def: #export (node expected parser) + (All [a] (-> Tag (Parser a) (Parser a))) + (function (_ [attrs documents]) (case documents #.Nil (exception.throw ..empty_input []) @@ -126,29 +103,31 @@ (#/.Text _) (exception.throw ..unexpected_input []) - (#/.Node _tag _attributes children) - (do try.monad - [output (..run parser children)] - (wrap [tail output])))))) + (#/.Node actual attrs' children) + (if (name\= expected actual) + (|> children + (..run' parser attrs') + (try\map (|>> [[attrs tail]]))) + (exception.throw ..wrong_tag [expected actual])))))) (def: #export ignore (Parser Any) - (function (_ documents) + (function (_ [attrs documents]) (case documents #.Nil (exception.throw ..empty_input []) (#.Cons head tail) - (#try.Success [tail []])))) + (#try.Success [[attrs tail] []])))) (exception: #export nowhere) (def: #export (somewhere parser) (All [a] (-> (Parser a) (Parser a))) - (function (recur input) - (case (//.run parser input) - (#try.Success [remaining output]) - (#try.Success [remaining output]) + (function (recur [attrs input]) + (case (//.run parser [attrs input]) + (#try.Success [[attrs remaining] output]) + (#try.Success [[attrs remaining] output]) (#try.Failure error) (case input @@ -157,6 +136,6 @@ (#.Cons head tail) (do try.monad - [[tail' output] (recur tail)] - (wrap [(#.Cons head tail') + [[[attrs tail'] output] (recur [attrs tail])] + (wrap [[attrs (#.Cons head tail')] output])))))) diff --git a/stdlib/source/lux/world/program.lux b/stdlib/source/lux/world/program.lux index 6d916c466..c64f9ffa7 100644 --- a/stdlib/source/lux/world/program.lux +++ b/stdlib/source/lux/world/program.lux @@ -23,7 +23,7 @@ ["." array (#+ Array)] ["." dictionary (#+ Dictionary)] ["." list ("#\." functor)]]] - [macro + ["." macro ["." template]] [math [number @@ -198,7 +198,26 @@ ["#::." (homedir [] #io Path)]) - (import: (require [ffi.String] Any))) + (template [<name> <path>] + [(def: (<name> _) + (-> [] (Maybe (-> ffi.String Any))) + (ffi.constant (-> ffi.String Any) <path>))] + + [normal_require [require]] + [global_require [global require]] + [process_load [global process mainModule constructor _load]] + ) + + (def: (require _) + (-> [] (-> ffi.String Any)) + (case [(normal_require []) (global_require []) (process_load [])] + (^or [(#.Some require) _ _] + [_ (#.Some require) _] + [_ _ (#.Some require)]) + require + + _ + (undefined)))) @.python (as_is (import: os ["#::." (#static getcwd [] #io ffi.String) @@ -362,7 +381,7 @@ (for {@.old <jvm> @.jvm <jvm> @.js (if ffi.on_node_js? - (|> (..require "os") + (|> (..require [] "os") (:as NodeJs_OS) (NodeJs_OS::homedir [])) <default>) diff --git a/stdlib/source/program/aedifex/artifact/snapshot.lux b/stdlib/source/program/aedifex/artifact/snapshot.lux index 836365fed..89897316d 100644 --- a/stdlib/source/program/aedifex/artifact/snapshot.lux +++ b/stdlib/source/program/aedifex/artifact/snapshot.lux @@ -49,10 +49,9 @@ (def: local_copy_parser (Parser Any) - (do <>.monad - [_ (<xml>.node ..<local_copy>)] - (<xml>.children (<text>.embed (<text>.this ..local_copy_value) - <xml>.text)))) + (<| (<xml>.node ..<local_copy>) + (<text>.embed (<text>.this ..local_copy_value)) + <xml>.text)) (def: #export (format snapshot) (-> Snapshot XML) @@ -66,7 +65,6 @@ (def: #export parser (Parser Snapshot) - (do <>.monad - [_ (<xml>.node <snapshot>)] - (<xml>.children (<>.or ..local_copy_parser - /stamp.parser)))) + (<| (<xml>.node <snapshot>) + (<>.or ..local_copy_parser + /stamp.parser))) diff --git a/stdlib/source/program/aedifex/artifact/snapshot/build.lux b/stdlib/source/program/aedifex/artifact/snapshot/build.lux index d9a8b729e..cd87c283e 100644 --- a/stdlib/source/program/aedifex/artifact/snapshot/build.lux +++ b/stdlib/source/program/aedifex/artifact/snapshot/build.lux @@ -36,8 +36,6 @@ (def: #export parser (Parser Build) - (do <>.monad - [_ (<xml>.node ..tag)] - (<text>.embed (<>.codec nat.decimal - (<text>.many <text>.decimal)) - (<xml>.children <xml>.text)))) + (<| (<xml>.node ..tag) + (<text>.embed (<>.codec nat.decimal (<text>.many <text>.decimal))) + <xml>.text)) diff --git a/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux b/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux index f321e11c1..2d127af21 100644 --- a/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux +++ b/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux @@ -44,10 +44,9 @@ (def: time_parser (Parser Time) - (do <>.monad - [_ (<xml>.node <timestamp>)] - (<text>.embed //time.parser - (<xml>.children <xml>.text)))) + (<| (<xml>.node <timestamp>) + (<text>.embed //time.parser) + <xml>.text)) (def: #export parser (Parser Stamp) diff --git a/stdlib/source/program/aedifex/artifact/snapshot/version.lux b/stdlib/source/program/aedifex/artifact/snapshot/version.lux index 905523bd0..806d2b261 100644 --- a/stdlib/source/program/aedifex/artifact/snapshot/version.lux +++ b/stdlib/source/program/aedifex/artifact/snapshot/version.lux @@ -50,19 +50,14 @@ (..format_text ..<value> value) (..format_text ..<updated> (///time.format updated))))) -(def: (sub tag parser) - (All [a] (-> xml.Tag (Parser a) (Parser a))) - (do <>.monad - [_ (<xml>.node tag)] - (<xml>.children parser))) - (def: (text tag) (-> xml.Tag (Parser Text)) - (..sub tag <xml>.text)) + (<| (<xml>.node tag) + <xml>.text)) (def: #export parser (Parser Version) - (<| (..sub ..<snapshot_version>) + (<| (<xml>.node ..<snapshot_version>) ($_ <>.and (<xml>.somewhere (..text ..<extension>)) (<xml>.somewhere (..text ..<value>)) diff --git a/stdlib/source/program/aedifex/artifact/versioning.lux b/stdlib/source/program/aedifex/artifact/versioning.lux index a16d92796..be192e9a5 100644 --- a/stdlib/source/program/aedifex/artifact/versioning.lux +++ b/stdlib/source/program/aedifex/artifact/versioning.lux @@ -69,29 +69,24 @@ (list\map //snapshot/version.format) (#xml.Node ..<snapshot_versions> xml.attributes))))) -(def: (sub tag parser) - (All [a] (-> xml.Tag (Parser a) (Parser a))) - (do <>.monad - [_ (<xml>.node tag)] - (<xml>.children parser))) - (def: (text tag) (-> xml.Tag (Parser Text)) - (..sub tag <xml>.text)) + (<| (<xml>.node tag) + <xml>.text)) (def: last_updated_parser (Parser //time.Time) - (<text>.embed //time.parser - (..text ..<last_updated>))) + (<| (<text>.embed //time.parser) + (..text ..<last_updated>))) (def: #export parser (Parser Versioning) - (<| (..sub ..<versioning>) + (<| (<xml>.node ..<versioning>) ($_ <>.and (<>.default #//snapshot.Local (<xml>.somewhere //snapshot.parser)) (<>.default //time.epoch (<xml>.somewhere ..last_updated_parser)) (<| (<>.default (list)) <xml>.somewhere - (..sub ..<snapshot_versions>) + (<xml>.node ..<snapshot_versions>) (<>.some //snapshot/version.parser)) ))) diff --git a/stdlib/source/program/aedifex/metadata/artifact.lux b/stdlib/source/program/aedifex/metadata/artifact.lux index 7150efbab..50f228e50 100644 --- a/stdlib/source/program/aedifex/metadata/artifact.lux +++ b/stdlib/source/program/aedifex/metadata/artifact.lux @@ -105,15 +105,10 @@ (list (..format_versions (get@ #versions value)) (..format_last_updated (get@ #last_updated value))))))) -(def: (sub tag parser) - (All [a] (-> xml.Tag (Parser a) (Parser a))) - (do <>.monad - [_ (<xml>.node tag)] - (<xml>.children parser))) - (def: (text tag) (-> xml.Tag (Parser Text)) - (..sub tag <xml>.text)) + (<| (<xml>.node tag) + <xml>.text)) (def: date_parser (<text>.Parser Date) @@ -147,18 +142,17 @@ (def: #export parser (Parser Metadata) - (<| (..sub ..<metadata>) + (<| (<xml>.node ..<metadata>) ($_ <>.and (<xml>.somewhere (..text ..<group>)) (<xml>.somewhere (..text ..<name>)) - (<| (..sub ..<versioning>) + (<| (<xml>.node ..<versioning>) ($_ <>.and (<| <xml>.somewhere - (..sub ..<versions>) + (<xml>.node ..<versions>) (<>.many (..text ..<version>))) (<xml>.somewhere ..last_updated_parser) - )) - ))) + ))))) (def: #export equivalence (Equivalence Metadata) diff --git a/stdlib/source/program/aedifex/metadata/snapshot.lux b/stdlib/source/program/aedifex/metadata/snapshot.lux index 518e0404a..41a0d9986 100644 --- a/stdlib/source/program/aedifex/metadata/snapshot.lux +++ b/stdlib/source/program/aedifex/metadata/snapshot.lux @@ -77,19 +77,14 @@ (..format_version version) (///artifact/versioning.format versioning))))) -(def: (sub tag parser) - (All [a] (-> xml.Tag (Parser a) (Parser a))) - (do <>.monad - [_ (<xml>.node tag)] - (<xml>.children parser))) - (def: (text tag) (-> xml.Tag (Parser Text)) - (..sub tag <xml>.text)) + (<| (<xml>.node tag) + <xml>.text)) (def: #export parser (Parser Metadata) - (<| (..sub ..<metadata>) + (<| (<xml>.node ..<metadata>) (do {! <>.monad} [group (<xml>.somewhere (..text ..<group>)) name (<xml>.somewhere (..text ..<name>)) diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux index 0d468d5f2..8f45dda36 100644 --- a/stdlib/source/program/aedifex/pom.lux +++ b/stdlib/source/program/aedifex/pom.lux @@ -29,6 +29,7 @@ ## https://maven.apache.org/pom.html (def: project_tag "project") +(def: dependency_tag "dependency") (def: dependencies_tag "dependencies") (def: repositories_tag "repositories") (def: repository_tag "repository") @@ -78,7 +79,7 @@ (def: (dependency value) (-> Dependency XML) - (#_.Node ["" "dependency"] + (#_.Node ["" ..dependency_tag] _.attributes (list\compose (..artifact (get@ #//dependency.artifact value)) (list (..property "type" (get@ #//dependency.type value)))))) @@ -151,14 +152,18 @@ (def: parse_property (Parser [Tag Text]) - (<>.and <xml>.tag - (<xml>.children <xml>.text))) + (do {! <>.monad} + [tag <xml>.tag] + (<| (<xml>.node tag) + (\ ! map (|>> [tag])) + <xml>.text))) (def: (parse_dependency own_version parent_version) (-> Text Text (Parser Dependency)) (do {! <>.monad} [properties (\ ! map (dictionary.from_list name.hash) - (<xml>.children (<>.some ..parse_property)))] + (<| (<xml>.node ["" ..dependency_tag]) + (<>.some ..parse_property)))] (<| <>.lift try.from_maybe (do maybe.monad @@ -177,54 +182,46 @@ (def: (parse_dependencies own_version parent_version) (-> Text Text (Parser (List Dependency))) - (do {! <>.monad} - [_ (<xml>.node ["" ..dependencies_tag])] - (<xml>.children (<>.some (..parse_dependency own_version parent_version))))) + (<| (<xml>.node ["" ..dependencies_tag]) + (<>.some (..parse_dependency own_version parent_version)))) (def: parse_repository (Parser Address) - (do {! <>.monad} - [_ (<xml>.node ["" ..repository_tag])] - (<xml>.children - (do ! - [_ (<xml>.node ["" ..url_tag])] - (<xml>.children <xml>.text))))) + (<| (<xml>.node ["" ..repository_tag]) + (<xml>.node ["" ..url_tag]) + <xml>.text)) (def: parse_repositories (Parser (List Address)) - (do {! <>.monad} - [_ (<xml>.node ["" ..repositories_tag])] - (<xml>.children (<>.some ..parse_repository)))) + (<| (<xml>.node ["" ..repositories_tag]) + (<>.some ..parse_repository))) (def: own_version (Parser Text) - (do <>.monad - [_ (<xml>.node ["" ..version_tag])] - (<xml>.children <xml>.text))) + (<| (<xml>.node ["" ..version_tag]) + <xml>.text)) (def: parent_version (Parser Text) - (do <>.monad - [_ (<xml>.node ["" "parent"])] - ..own_version)) + (<| (<xml>.node ["" "parent"]) + ..own_version)) (def: #export parser (Parser /.Profile) (do {! <>.monad} [own_version (<>.default "" (<xml>.somewhere ..own_version)) - parent_version (<>.default "" (<xml>.somewhere ..parent_version)) - _ (<xml>.node ["" ..project_tag])] - (<xml>.children - (do ! - [dependencies (|> (..parse_dependencies own_version parent_version) - <xml>.somewhere - (<>.default (list))) - repositories (|> ..parse_repositories - <xml>.somewhere - (<>.default (list))) - _ (<>.some <xml>.ignore)] - (wrap (|> (\ /.monoid identity) - (update@ #/.dependencies (function (_ empty) - (list\fold set.add empty dependencies))) - (update@ #/.repositories (function (_ empty) - (list\fold set.add empty repositories))))))))) + parent_version (<>.default "" (<xml>.somewhere ..parent_version))] + (<| (<xml>.node ["" ..project_tag]) + (do ! + [dependencies (|> (..parse_dependencies own_version parent_version) + <xml>.somewhere + (<>.default (list))) + repositories (|> ..parse_repositories + <xml>.somewhere + (<>.default (list))) + _ (<>.some <xml>.ignore)] + (wrap (|> (\ /.monoid identity) + (update@ #/.dependencies (function (_ empty) + (list\fold set.add empty dependencies))) + (update@ #/.repositories (function (_ empty) + (list\fold set.add empty repositories))))))))) diff --git a/stdlib/source/test/lux/control/parser/xml.lux b/stdlib/source/test/lux/control/parser/xml.lux index 116f948da..435e3f4d3 100644 --- a/stdlib/source/test/lux/control/parser/xml.lux +++ b/stdlib/source/test/lux/control/parser/xml.lux @@ -84,51 +84,31 @@ (do {! random.monad} [expected ..random_tag] (_.cover [/.node] - (|> (/.run (do //.monad - [_ (/.node expected)] - /.ignore) + (|> (/.run (/.node expected (//\wrap [])) (list (#xml.Node expected (dictionary.new name.hash) (list)))) (!expect (#try.Success []))))) (!failure /.wrong_tag - [[(/.node ["" expected]) + [[(/.node ["" expected] (//\wrap [])) (#xml.Node [expected ""] (dictionary.new name.hash) (list))]]) (do {! random.monad} [expected_tag ..random_tag expected_attribute ..random_attribute expected_value (random.ascii/alpha 1)] (_.cover [/.attribute] - (|> (/.run (do //.monad - [_ (/.node expected_tag) - _ (/.attribute expected_attribute)] - /.ignore) + (|> (/.run (<| (/.node expected_tag) + (//.after (/.attribute expected_attribute)) + (//\wrap [])) (list (#xml.Node expected_tag (|> (dictionary.new name.hash) (dictionary.put expected_attribute expected_value)) (list)))) (!expect (#try.Success []))))) (!failure /.unknown_attribute - [[(do //.monad - [_ (/.attribute ["" expected])] - /.ignore) + [[(/.attribute ["" expected]) (#xml.Node [expected expected] (|> (dictionary.new name.hash) (dictionary.put [expected ""] expected)) (list))]]) - (do {! random.monad} - [expected ..random_tag] - (_.cover [/.children] - (|> (/.run (do {! //.monad} - [_ (/.node expected)] - (/.children - (do ! - [_ (/.node expected)] - /.ignore))) - (list (#xml.Node expected - (dictionary.new name.hash) - (list (#xml.Node expected - (dictionary.new name.hash) - (list)))))) - (!expect (#try.Success []))))) (!failure /.empty_input [[(do //.monad [_ /.ignore] @@ -140,43 +120,27 @@ (#xml.Text expected)] [(do //.monad [_ /.ignore] - (/.node [expected expected])) + (/.node [expected expected] + (//\wrap []))) (#xml.Node [expected expected] (dictionary.new name.hash) (list))] [(do //.monad [_ /.ignore] - (/.node [expected expected])) + (/.node [expected expected] + (/.attribute [expected expected]))) (#xml.Node [expected expected] (|> (dictionary.new name.hash) (dictionary.put [expected expected] expected)) - (list))] - [(do //.monad - [_ /.ignore] - (/.children - (/.node [expected expected]))) - (#xml.Node [expected expected] - (dictionary.new name.hash) - (list (#xml.Node [expected expected] - (dictionary.new name.hash) - (list))))]]) + (list))]]) (!failure /.unexpected_input [[/.text (#xml.Node [expected expected] (dictionary.new name.hash) (list))] - [(do //.monad - [_ (/.node [expected expected])] - /.ignore) - (#xml.Text expected)] - [(do //.monad - [_ (/.attribute [expected expected])] - /.ignore) + [(/.node [expected expected] + (//\wrap [])) (#xml.Text expected)] - [(do {! //.monad} - [_ (/.node [expected expected])] - (/.children - (do ! - [_ (/.node [expected expected])] - /.ignore))) + [(/.node [expected expected] + (/.attribute [expected expected])) (#xml.Text expected)]]) (do {! random.monad} [#let [node (: (-> xml.Tag (List xml.XML) xml.XML) @@ -186,11 +150,13 @@ right ..random_tag wrong (random.filter (|>> (name\= right) not) ..random_tag) - #let [parser (/.children - (do //.monad - [_ (/.somewhere (/.node right)) - _ (//.some /.ignore)] - (wrap [])))] + #let [parser (<| (/.node parent) + (do //.monad + [_ (<| /.somewhere + (/.node right) + (//\wrap [])) + _ (//.some /.ignore)] + (wrap [])))] repetitions (\ ! map (n.% 10) random.nat)] ($_ _.and (_.cover [/.somewhere] diff --git a/stdlib/source/test/lux/data/text/unicode/set.lux b/stdlib/source/test/lux/data/text/unicode/set.lux index 0fc394a63..631d3b511 100644 --- a/stdlib/source/test/lux/data/text/unicode/set.lux +++ b/stdlib/source/test/lux/data/text/unicode/set.lux @@ -85,6 +85,7 @@ [/.ascii/alpha_num] [/.ascii/lower] [/.ascii/upper] + [/.ascii/numeric] [/.character] [/.non_character] [/.full] diff --git a/stdlib/source/test/lux/debug.lux b/stdlib/source/test/lux/debug.lux index 29e4493f8..5c0a950dc 100644 --- a/stdlib/source/test/lux/debug.lux +++ b/stdlib/source/test/lux/debug.lux @@ -228,31 +228,38 @@ (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] - (with_expansions [<no_parameters> (for {@.js (~~ (as_is))} - (~~ (as_is (/.here))))] - (`` (exec - <no_parameters> - (/.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)) - ))) + (do random.monad + [message (random.ascii/lower 5)] + ($_ _.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] + (with_expansions [<no_parameters> (for {@.js (~~ (as_is))} + (~~ (as_is (/.here))))] + (`` (exec + <no_parameters> + (/.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)) + (_.cover [/.log!] + (exec + (/.log! (format (%.name (name_of /.log!)) + " works: " (%.text message))) + true)) + )))) diff --git a/stdlib/source/test/lux/ffi.js.lux b/stdlib/source/test/lux/ffi.js.lux index 57a8332e2..e2c699dbd 100644 --- a/stdlib/source/test/lux/ffi.js.lux +++ b/stdlib/source/test/lux/ffi.js.lux @@ -6,6 +6,7 @@ [control ["." try]] [data + ["." bit ("#\." equivalence)] ["." text ("#\." equivalence)]] [math ["." random (#+ Random)] @@ -53,33 +54,76 @@ ## I64s get compiled as JavaScript objects with a specific structure. object random.nat] (<| (_.covering /._) - ($_ _.and - (_.cover [/.on_browser? /.on_node_js? /.on_nashorn?] - (or /.on_nashorn? - /.on_node_js? - /.on_browser?)) - (_.cover [/.type_of] - (and (text\= "boolean" (/.type_of boolean)) - (text\= "number" (/.type_of number)) - (text\= "string" (/.type_of string)) - (text\= "function" (/.type_of function)) - (text\= "object" (/.type_of object)))) - (_.cover [/.import:] - (let [encoding "utf8"] - (text\= string - (cond /.on_nashorn? - (let [binary (java/lang/String::getBytes [encoding] (:as java/lang/String string))] - (|> (java/lang/String::new [binary encoding]) - (:as Text))) - - /.on_node_js? - (|> (Buffer::from [string encoding]) - (Buffer::toString [encoding])) - - ## On the browser - (let [binary (|> (TextEncoder::new [encoding]) - (TextEncoder::encode [string]))] - (|> (TextDecoder::new [encoding]) - (TextDecoder::decode [binary]))) - )))) - )))) + (`` ($_ _.and + (~~ (template [<type> <value>] + [(_.cover [<type>] + (exec + (: <type> <value>) + true))] + + [/.Boolean boolean] + [/.Number number] + [/.String string] + )) + (_.for [/.Object] + ($_ _.and + (~~ (template [<type>] + [(_.cover [<type>] + (exec + (: (Ex [a] (/.Object a)) + (: <type> + (:assume []))) + true))] + + [/.Function] + [/.Symbol] + [/.Null] + [/.Undefined] + )) + )) + (_.cover [/.constant] + (|> (/.constant /.Function [parseFloat]) + "js object null?" + not)) + (_.cover [/.closure] + (|> (/.closure [input/0] input/0) + "js object null?" + not)) + (_.cover [/.on_browser? /.on_node_js? /.on_nashorn?] + (and (or /.on_nashorn? + /.on_node_js? + /.on_browser?) + (bit\= /.on_nashorn? + (not (or /.on_node_js? + /.on_browser?))) + (bit\= /.on_node_js? + (not (or /.on_nashorn? + /.on_browser?))) + (bit\= /.on_browser? + (not (or /.on_nashorn? + /.on_node_js?))))) + (_.cover [/.type_of] + (and (text\= "boolean" (/.type_of boolean)) + (text\= "number" (/.type_of number)) + (text\= "string" (/.type_of string)) + (text\= "function" (/.type_of function)) + (text\= "object" (/.type_of object)))) + (_.cover [/.import:] + (let [encoding "utf8"] + (text\= string + (cond /.on_nashorn? + (let [binary (java/lang/String::getBytes [encoding] (:as java/lang/String string))] + (|> (java/lang/String::new [binary encoding]) + (:as Text))) + + /.on_node_js? + (|> (Buffer::from [string encoding]) + (Buffer::toString [encoding])) + + ## On the browser + (let [binary (|> (TextEncoder::new [encoding]) + (TextEncoder::encode [string]))] + (|> (TextDecoder::new [encoding]) + (TextDecoder::decode [binary]))) + )))) + ))))) |