From 4474a2a3ba6b345cb5d369ad5654bf11481d0393 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 19 Sep 2017 19:16:11 -0400
Subject: - XML parsing.

---
 stdlib/test/test/lux/data/format/xml.lux | 49 ++++++++++++++++++++++++++++++--
 1 file changed, 46 insertions(+), 3 deletions(-)

(limited to 'stdlib/test')

diff --git a/stdlib/test/test/lux/data/format/xml.lux b/stdlib/test/test/lux/data/format/xml.lux
index 1910caf3e..382659ab0 100644
--- a/stdlib/test/test/lux/data/format/xml.lux
+++ b/stdlib/test/test/lux/data/format/xml.lux
@@ -2,13 +2,15 @@
   lux
   (lux [io]
        (control [monad #+ do Monad]
+                ["p" parser]
                 pipe)
-       (data [text "Text/" Monoid<Text>]
+       (data [text "text/" Eq<Text>]
              text/format
              [ident]
+             ["R" result]
              (format ["&" xml])
              (coll [dict]
-                   [list]))
+                   [list "L/" Functor<List>]))
        ["r" math/random "r/" Monad<Random>]
        test)
   )
@@ -52,7 +54,7 @@
                         (r;dict ident;Hash<Ident> size xml-identifier^ (xml-text^ +0 +10))
                         (r;list size gen-xml)))))))
 
-(context: "XML"
+(context: "XML."
   [sample gen-xml
    #let [(^open "&/") &;Eq<XML>
          (^open "&/") &;Codec<Text,XML>]]
@@ -68,3 +70,44 @@
                        (#;Left error)
                        false)))
       ))
+
+(context: "Parsing."
+  [text (xml-text^ +1 +10)
+   num-children (|> r;nat (:: @ map (n.% +5)))
+   children (r;list num-children (xml-text^ +1 +10))
+   tag xml-identifier^
+   attr xml-identifier^
+   value (xml-text^ +1 +10)
+   #let [node (#&;Node tag
+                       (dict;put attr value &;attrs)
+                       (L/map (|>. #&;Text) children))]]
+  ($_ seq
+      (test "Can parse text."
+            (R;default false
+              (do R;Monad<Result>
+                [output (&;run (#&;Text text)
+                               &;text)]
+                (wrap (text/= text output)))))
+      (test "Can parse attributes."
+            (R;default false
+              (do R;Monad<Result>
+                [output (|> (&;attr attr)
+                            (p;before &;ignore)
+                            (&;run node))]
+                (wrap (text/= value output)))))
+      (test "Can parse nodes."
+            (R;default false
+              (do R;Monad<Result>
+                [_ (|> (&;node tag)
+                       (p;before &;ignore)
+                       (&;run node))]
+                (wrap true))))
+      (test "Can parse children."
+            (R;default false
+              (do R;Monad<Result>
+                [outputs (|> (&;children (p;some &;text))
+                             (&;run node))]
+                (wrap (:: (list;Eq<List> text;Eq<Text>) =
+                          children
+                          outputs)))))
+      ))
-- 
cgit v1.2.3