aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/lux/control/codec.lux2
-rw-r--r--stdlib/source/test/lux/data.lux15
-rw-r--r--stdlib/source/test/lux/data/format/json.lux145
-rw-r--r--stdlib/source/test/lux/data/format/xml.lux169
4 files changed, 140 insertions, 191 deletions
diff --git a/stdlib/source/test/lux/control/codec.lux b/stdlib/source/test/lux/control/codec.lux
index e061f9e36..f8159838b 100644
--- a/stdlib/source/test/lux/control/codec.lux
+++ b/stdlib/source/test/lux/control/codec.lux
@@ -18,7 +18,7 @@
(do r.monad
[expected generator]
(<| (_.context (%name (name-of /.Codec)))
- (_.test "Reflexivity."
+ (_.test "Isomorphism."
(case (|> expected /@encode /@decode)
(#error.Success actual)
(/@= expected actual)
diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux
index 907082d99..9175d970e 100644
--- a/stdlib/source/test/lux/data.lux
+++ b/stdlib/source/test/lux/data.lux
@@ -22,9 +22,11 @@
["#." text
["#/." lexer]
["#/." regex]]
- ])
+ [format
+ ["#." json]
+ ["#." xml]]])
-(def: #export number
+(def: number
Test
($_ _.and
/i64.test
@@ -36,13 +38,19 @@
/complex.test
))
-(def: #export text
+(def: text
($_ _.and
/text.test
/text/lexer.test
/text/regex.test
))
+(def: format
+ ($_ _.and
+ /json.test
+ /xml.test
+ ))
+
(def: #export test
Test
($_ _.and
@@ -57,4 +65,5 @@
/sum.test
..number
..text
+ ..format
))
diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux
index cdaeb5d31..11bed07da 100644
--- a/stdlib/source/test/lux/data/format/json.lux
+++ b/stdlib/source/test/lux/data/format/json.lux
@@ -1,20 +1,24 @@
(.module:
[lux #*
+ data/text/format
+ ["_" test (#+ Test)]
[control
- [monad (#+ do Monad)]
+ pipe
codec
+ [monad (#+ do Monad)]
[equivalence (#+ Equivalence)]
- pipe
- ["p" parser]]
+ ["p" parser]
+ {[0 #test]
+ [/
+ ["$." equivalence]
+ ["$." codec]]}]
[data
["." error]
["." bit]
["." maybe]
- ["." number]
- ["." text
- format]
- [format
- ["@" json]]
+ ["." text]
+ [number
+ ["." frac]]
[collection
[row (#+ row)]
["d" dictionary]
@@ -26,58 +30,40 @@
[type
["." unit]]
[math
- ["r" random]]
+ ["r" random (#+ Random)]]
[time
["ti" instant]
["tda" date]
## ["tdu" duration]
- ]
- test]
+ ]]
[test
[lux
[time
["_." instant]
## ["_." duration]
["_." date]]]]
+ {1
+ ["." / (#+ JSON)]}
)
-(def: gen-json
- (r.Random @.JSON)
- (r.rec (function (_ gen-json)
+(def: #export json
+ (Random JSON)
+ (r.rec (function (_ json)
(do r.monad
[size (:: @ map (n/% 2) r.nat)]
($_ r.or
(:: @ wrap [])
r.bit
- (|> r.frac (:: @ map (f/* +1,000,000.0)))
+ r.frac
(r.unicode size)
- (r.row size gen-json)
- (r.dictionary text.hash size (r.unicode size) gen-json)
+ (r.row size json)
+ (r.dictionary text.hash size (r.unicode size) json)
)))))
-(context: "JSON"
- (<| (times 100)
- (do @
- [sample gen-json
- #let [(^open "@/.") @.equivalence
- (^open "@/.") @.codec]]
- ($_ seq
- (test "Every JSON is equal to itself."
- (@/= sample sample))
-
- (test "Can encode/decode JSON."
- (|> sample @/encode @/decode
- (case> (#.Right result)
- (@/= sample result)
-
- (#.Left _)
- #0)))
- ))))
-
(type: Variant
- (#Case0 Bit)
- (#Case1 Text)
- (#Case2 Frac))
+ (#Bit Bit)
+ (#Text Text)
+ (#Frac Frac))
(type: #rec Recursive
(#Number Frac)
@@ -89,9 +75,9 @@
#text Text
#maybe (Maybe Frac)
#list (List Frac)
- #dict (d.Dictionary Text Frac)
- ## #variant Variant
- ## #tuple [Bit Frac Text]
+ #dictionary (d.Dictionary Text Frac)
+ #variant Variant
+ #tuple [Bit Frac Text]
#recursive Recursive
## #instant ti.Instant
## #duration tdu.Duration
@@ -100,19 +86,19 @@
})
(def: gen-recursive
- (r.Random Recursive)
+ (Random Recursive)
(r.rec (function (_ gen-recursive)
(r.or r.frac
(r.and r.frac gen-recursive)))))
-(derived: (poly/equivalence.Equivalence<?> Recursive))
+(derived: recursive-equivalence (poly/equivalence.equivalence Recursive))
(def: qty
- (All [unit] (r.Random (unit.Qty unit)))
+ (All [unit] (Random (unit.Qty unit)))
(|> r.int (:: r.monad map unit.in)))
(def: gen-record
- (r.Random Record)
+ (Random Record)
(do r.monad
[size (:: @ map (n/% 2) r.nat)]
($_ r.and
@@ -122,8 +108,8 @@
(r.maybe r.frac)
(r.list size r.frac)
(r.dictionary text.hash size (r.unicode size) r.frac)
- ## ($_ r.or r.bit (r.unicode size) r.frac)
- ## ($_ r.and r.bit r.frac (r.unicode size))
+ ($_ r.or r.bit (r.unicode size) r.frac)
+ ($_ r.and r.bit r.frac (r.unicode size))
gen-recursive
## _instant.instant
## _duration.duration
@@ -131,53 +117,16 @@
qty
)))
-(derived: (poly/json.codec Record))
-
-(structure: _ (Equivalence Record)
- (def: (= recL recR)
- (let [variant/= (function (_ left right)
- (case [left right]
- [(#Case0 left') (#Case0 right')]
- (:: bit.equivalence = left' right')
-
- [(#Case1 left') (#Case1 right')]
- (:: text.equivalence = left' right')
-
- [(#Case2 left') (#Case2 right')]
- (f/= left' right')
-
- _
- #0))]
- (and (:: bit.equivalence = (get@ #bit recL) (get@ #bit recR))
- (f/= (get@ #frac recL) (get@ #frac recR))
- (:: text.equivalence = (get@ #text recL) (get@ #text recR))
- (:: (maybe.equivalence number.equivalence) = (get@ #maybe recL) (get@ #maybe recR))
- (:: (list.equivalence number.equivalence) = (get@ #list recL) (get@ #list recR))
- (:: (d.equivalence number.equivalence) = (get@ #dict recL) (get@ #dict recR))
- ## (variant/= (get@ #variant recL) (get@ #variant recR))
- ## (let [[tL0 tL1 tL2] (get@ #tuple recL)
- ## [tR0 tR1 tR2] (get@ #tuple recR)]
- ## (and (:: bit.equivalence = tL0 tR0)
- ## (f/= tL1 tR1)
- ## (:: text.equivalence = tL2 tR2)))
- (:: equivalence = (get@ #recursive recL) (get@ #recursive recR))
- ## (:: ti.equivalence = (get@ #instant recL) (get@ #instant recR))
- ## (:: tdu.equivalence = (get@ #duration recL) (get@ #duration recR))
- (:: tda.equivalence = (get@ #date recL) (get@ #date recR))
- (:: unit.equivalence = (get@ #grams recL) (get@ #grams recR))
- ))))
-
-(context: "Polytypism"
- (<| (seed 14562075782602945288)
- ## (times 100)
- (do @
- [sample gen-record
- #let [(^open "@/.") ..equivalence
- (^open "@/.") ..codec]]
- (test "Can encode/decode arbitrary types."
- (|> sample @/encode @/decode
- (case> (#error.Success result)
- (@/= sample result)
-
- (#error.Failure error)
- #0))))))
+(derived: equivalence (poly/equivalence.equivalence Record))
+(derived: codec (poly/json.codec Record))
+
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /.JSON)))
+ ($_ _.and
+ ($equivalence.spec /.equivalence ..json)
+ ($codec.spec /.equivalence /.codec ..json)
+ (<| (_.context "Polytypism.")
+ (<| (_.seed 14562075782602945288)
+ ($codec.spec ..equivalence ..codec gen-record)))
+ )))
diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux
index 35e7dc4a1..221edba97 100644
--- a/stdlib/source/test/lux/data/format/xml.lux
+++ b/stdlib/source/test/lux/data/format/xml.lux
@@ -1,23 +1,27 @@
(.module:
- [lux #*
+ [lux (#- char)
+ data/text/format
+ ["_" test (#+ Test)]
[control
+ pipe
[monad (#+ Monad do)]
["p" parser]
- pipe]
+ {[0 #test]
+ [/
+ ["$." equivalence]
+ ["$." codec]]}]
[data
["." name]
["E" error]
["." maybe]
- ["." text ("#;." equivalence)
- format]
- [format
- ["&" xml]]
+ ["." text ("#@." equivalence)]
[collection
- ["dict" dictionary]
- ["." list ("#;." functor)]]]
+ ["." dictionary]
+ ["." list ("#@." functor)]]]
[math
- ["r" random ("#;." monad)]]]
- lux/test)
+ ["r" random (#+ Random) ("#@." monad)]]]
+ {1
+ ["." / (#+ XML)]})
(def: char-range
Text
@@ -25,97 +29,84 @@
"abcdefghijklmnopqrstuvwxyz"
"ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
-(def: xml-char^
- (r.Random Nat)
+(def: char
+ (Random Nat)
(do r.monad
[idx (|> r.nat (:: @ map (n/% (text.size char-range))))]
(wrap (maybe.assume (text.nth idx char-range)))))
-(def: (size^ bottom top)
- (-> Nat Nat (r.Random Nat))
+(def: (size bottom top)
+ (-> Nat Nat (Random Nat))
(let [constraint (|>> (n/% top) (n/max bottom))]
- (r;map constraint r.nat)))
+ (r@map constraint r.nat)))
-(def: (xml-text^ bottom top)
- (-> Nat Nat (r.Random Text))
+(def: (text bottom top)
+ (-> Nat Nat (Random Text))
(do r.monad
- [size (size^ bottom top)]
- (r.text xml-char^ size)))
+ [size (..size bottom top)]
+ (r.text ..char size)))
(def: xml-identifier^
- (r.Random Name)
- (r.and (xml-text^ 0 10)
- (xml-text^ 1 10)))
+ (Random Name)
+ (r.and (..text 0 10)
+ (..text 1 10)))
-(def: gen-xml
- (r.Random &.XML)
- (r.rec (function (_ gen-xml)
- (r.or (xml-text^ 1 10)
+(def: #export xml
+ (Random XML)
+ (r.rec (function (_ xml)
+ (r.or (..text 1 10)
(do r.monad
- [size (size^ 0 2)]
+ [size (..size 0 2)]
($_ r.and
xml-identifier^
- (r.dictionary name.hash size xml-identifier^ (xml-text^ 0 10))
- (r.list size gen-xml)))))))
+ (r.dictionary name.hash size xml-identifier^ (..text 0 10))
+ (r.list size xml)))))))
-(context: "XML."
- (<| (times 100)
- (do @
- [sample gen-xml
- #let [(^open "&;.") &.equivalence
- (^open "&;.") &.codec]]
- ($_ seq
- (test "Every XML is equal to itself."
- (&;= sample sample))
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /.XML)))
+ ($_ _.and
+ ($equivalence.spec /.equivalence ..xml)
+ ($codec.spec /.equivalence /.codec ..xml)
- (test "Can encode/decode XML."
- (|> sample &;encode &;decode
- (case> (#.Right result)
- (&;= sample result)
-
- (#.Left error)
- #0)))
- ))))
-
-(context: "Parsing."
- (<| (times 100)
- (do @
- [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)
- (list;map (|>> #&.Text) children))]]
- ($_ seq
- (test "Can parse text."
- (E.default #0
- (do E.monad
- [output (&.run (#&.Text text)
- &.text)]
- (wrap (text;= text output)))))
- (test "Can parse attributes."
- (E.default #0
- (do E.monad
- [output (|> (&.attr attr)
- (p.before &.ignore)
- (&.run node))]
- (wrap (text;= value output)))))
- (test "Can parse nodes."
- (E.default #0
- (do E.monad
- [_ (|> (&.node tag)
- (p.before &.ignore)
- (&.run node))]
- (wrap #1))))
- (test "Can parse children."
- (E.default #0
- (do E.monad
- [outputs (|> (&.children (p.some &.text))
- (&.run node))]
- (wrap (:: (list.equivalence text.equivalence) =
- children
- outputs)))))
- ))))
+ (do r.monad
+ [text (..text 1 10)
+ num-children (|> r.nat (:: @ map (n/% 5)))
+ children (r.list num-children (..text 1 10))
+ tag xml-identifier^
+ attr xml-identifier^
+ value (..text 1 10)
+ #let [node (#/.Node tag
+ (dictionary.put attr value /.attrs)
+ (list@map (|>> #/.Text) children))]]
+ ($_ _.and
+ (_.test "Can parse text."
+ (E.default #0
+ (do E.monad
+ [output (/.run (#/.Text text)
+ /.text)]
+ (wrap (text@= text output)))))
+ (_.test "Can parse attributes."
+ (E.default #0
+ (do E.monad
+ [output (|> (/.attr attr)
+ (p.before /.ignore)
+ (/.run node))]
+ (wrap (text@= value output)))))
+ (_.test "Can parse nodes."
+ (E.default #0
+ (do E.monad
+ [_ (|> (/.node tag)
+ (p.before /.ignore)
+ (/.run node))]
+ (wrap #1))))
+ (_.test "Can parse children."
+ (E.default #0
+ (do E.monad
+ [outputs (|> (/.children (p.some /.text))
+ (/.run node))]
+ (wrap (:: (list.equivalence text.equivalence) =
+ children
+ outputs)))))
+ ))
+ )))