From 2431e767a09894c2f685911ba7f1ba0b7de2a165 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 13 Jul 2021 02:41:45 -0400
Subject: Improved the XML parsing library.
---
stdlib/source/lux/control/parser/xml.lux | 113 +++++++++------------
stdlib/source/lux/world/program.lux | 25 ++++-
.../source/program/aedifex/artifact/snapshot.lux | 14 ++-
.../program/aedifex/artifact/snapshot/build.lux | 8 +-
.../program/aedifex/artifact/snapshot/stamp.lux | 7 +-
.../program/aedifex/artifact/snapshot/version.lux | 11 +-
.../source/program/aedifex/artifact/versioning.lux | 17 ++--
.../source/program/aedifex/metadata/artifact.lux | 18 ++--
.../source/program/aedifex/metadata/snapshot.lux | 11 +-
stdlib/source/program/aedifex/pom.lux | 73 +++++++------
stdlib/source/test/lux/control/parser/xml.lux | 78 ++++----------
stdlib/source/test/lux/data/text/unicode/set.lux | 1 +
stdlib/source/test/lux/debug.lux | 63 +++++++-----
stdlib/source/test/lux/ffi.js.lux | 104 +++++++++++++------
14 files changed, 265 insertions(+), 278 deletions(-)
(limited to 'stdlib')
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])))
+ ))))
+ )))))
--
cgit v1.2.3