From 0c0ae6e4334677595bda5e7e67a0687532aff7d7 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 6 Apr 2017 20:19:54 -0400
Subject: - Added XML support.

---
 stdlib/test/test/lux/data/format/xml.lux | 66 ++++++++++++++++++++++++++++++++
 stdlib/test/tests.lux                    |  3 +-
 2 files changed, 68 insertions(+), 1 deletion(-)
 create mode 100644 stdlib/test/test/lux/data/format/xml.lux

(limited to 'stdlib/test')

diff --git a/stdlib/test/test/lux/data/format/xml.lux b/stdlib/test/test/lux/data/format/xml.lux
new file mode 100644
index 000000000..0479cb561
--- /dev/null
+++ b/stdlib/test/test/lux/data/format/xml.lux
@@ -0,0 +1,66 @@
+(;module:
+  lux
+  (lux [io]
+       (control monad
+                pipe)
+       (data [char]
+             [text "Text/" Monoid<Text>]
+             text/format
+             [ident]
+             (format ["&" xml])
+             (coll [dict]
+                   [list]))
+       ["R" math/random "R/" Monad<Random>]
+       test)
+  )
+
+(def: (valid-xml-char? char)
+  (text;contains? (char;as-text char)
+                  (format "_"
+                          "abcdefghijklmnopqrstuvwxyz"
+                          "ABCDEFGHIJKLMNOPQRSTUVWXYZ")))
+
+(def: (size^ bottom top)
+  (-> Nat Nat (R;Random Nat))
+  (let [constraint (|>. (n.% top) (n.max bottom))]
+    (R/map constraint R;nat)))
+
+(def: (xml-text^ bottom top)
+  (-> Nat Nat (R;Random Text))
+  (do R;Monad<Random>
+    [size (size^ bottom top)]
+    (R;text' (R;filter valid-xml-char? R;char)
+             size)))
+
+(def: xml-identifier^
+  (R;Random Ident)
+  (R;seq (xml-text^ +0 +10)
+         (xml-text^ +1 +10)))
+
+(def: gen-xml
+  (R;Random &;XML)
+  (R;rec (lambda [gen-xml]
+           (R;alt (xml-text^ +1 +10)
+                  (do R;Monad<Random>
+                    [size (size^ +0 +2)]
+                    ($_ R;seq
+                        xml-identifier^
+                        (R;dict ident;Hash<Ident> size xml-identifier^ (xml-text^ +0 +10))
+                        (R;list size gen-xml)))))))
+
+(test: "XML"
+  [sample gen-xml
+   #let [(^open "&/") &;Eq<XML>
+         (^open "&/") &;Codec<Text,XML>]]
+  ($_ seq
+      (assert "Every XML is equal to itself."
+              (&/= sample sample))
+
+      (assert "Can encode/decode XML."
+              (|> sample &/encode &/decode
+                  (case> (#;Right result)
+                         (&/= sample result)
+
+                         (#;Left error)
+                         false)))
+      ))
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index 6b23caebd..08d73a430 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -36,7 +36,8 @@
                    ["_;" sum]
                    ["_;" text]
                    (error ["_;" exception])
-                   (format ["_;" json])
+                   (format ["_;" json]
+                           ["_;" xml])
                    (coll ["_;" array]
                          ["_;" dict]
                          ["_;" list]
-- 
cgit v1.2.3