aboutsummaryrefslogtreecommitdiff
path: root/stdlib/test
diff options
context:
space:
mode:
authorEduardo Julian2017-04-06 20:19:54 -0400
committerEduardo Julian2017-04-06 20:19:54 -0400
commit0c0ae6e4334677595bda5e7e67a0687532aff7d7 (patch)
tree9e10431540862f1b23c6803edeae8698460ecfb1 /stdlib/test
parent6aa989b62f71179bdbad2d9d04110ee3d010c838 (diff)
- Added XML support.
Diffstat (limited to 'stdlib/test')
-rw-r--r--stdlib/test/test/lux/data/format/xml.lux66
-rw-r--r--stdlib/test/tests.lux3
2 files changed, 68 insertions, 1 deletions
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]