Improved the XML parsing library.

8 files changed, 65 insertions, 94 deletions

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)))))))))