aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/data
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test/lux/data')
-rw-r--r--stdlib/source/test/lux/data/collection.lux2
-rw-r--r--stdlib/source/test/lux/data/collection/tree/finger.lux133
2 files changed, 135 insertions, 0 deletions
diff --git a/stdlib/source/test/lux/data/collection.lux b/stdlib/source/test/lux/data/collection.lux
index 497123614..bcbda46b9 100644
--- a/stdlib/source/test/lux/data/collection.lux
+++ b/stdlib/source/test/lux/data/collection.lux
@@ -17,6 +17,7 @@
["#/." multi]
["#/." ordered]]
["#." tree
+ ["#/." finger]
["#/." zipper]]])
(def: dictionary
@@ -46,6 +47,7 @@
Test
($_ _.and
/tree.test
+ /tree/finger.test
/tree/zipper.test
))
diff --git a/stdlib/source/test/lux/data/collection/tree/finger.lux b/stdlib/source/test/lux/data/collection/tree/finger.lux
new file mode 100644
index 000000000..a0dfabb54
--- /dev/null
+++ b/stdlib/source/test/lux/data/collection/tree/finger.lux
@@ -0,0 +1,133 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [data
+ ["." maybe ("#@." functor)]
+ ["." text ("#@." equivalence monoid)]
+ [number
+ ["n" nat]]]
+ [math
+ ["." random]]
+ [type (#+ :by-example)]]
+ {1
+ ["." /]})
+
+(def: builder
+ (/.builder text.monoid))
+
+(def: :@:
+ (:by-example [@]
+ {(/.Builder @ Text)
+ ..builder}
+ @))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.with-cover [/.Tree])
+ (do {! random.monad}
+ [tag-left (random.ascii/alpha-num 1)
+ tag-right (random.filter (|>> (text@= tag-left) not)
+ (random.ascii/alpha-num 1))
+ expected-left random.nat
+ expected-right random.nat]
+ ($_ _.and
+ (_.cover [/.Builder /.builder]
+ (exec (/.builder text.monoid)
+ true))
+ (_.cover [/.tag]
+ (and (text@= tag-left
+ (/.tag (:: ..builder leaf tag-left expected-left)))
+ (text@= (text@compose tag-left tag-right)
+ (/.tag (:: ..builder branch
+ (:: ..builder leaf tag-left expected-left)
+ (:: ..builder leaf tag-right expected-right))))))
+ (_.cover [/.root]
+ (and (case (/.root (:: ..builder leaf tag-left expected-left))
+ (#.Left actual)
+ (n.= expected-left actual)
+
+ (#.Right _)
+ false)
+ (case (/.root (:: ..builder branch
+ (:: ..builder leaf tag-left expected-left)
+ (:: ..builder leaf tag-right expected-right)))
+ (#.Left _)
+ false
+
+ (#.Right [left right])
+ (case [(/.root left)
+ (/.root right)]
+ [(#.Left actual-left) (#.Left actual-right)]
+ (and (n.= expected-left actual-left)
+ (n.= expected-right actual-right))
+
+ _
+ false))))
+ (_.cover [/.value]
+ (and (n.= expected-left
+ (/.value (:: ..builder leaf tag-left expected-left)))
+ (n.= expected-left
+ (/.value (:: ..builder branch
+ (:: ..builder leaf tag-left expected-left)
+ (:: ..builder leaf tag-right expected-right))))))
+ (_.cover [/.search]
+ (let [can-find-correct-one!
+ (|> (:: ..builder leaf tag-left expected-left)
+ (/.search (text.contains? tag-left))
+ (maybe@map (n.= expected-left))
+ (maybe.default false))
+
+ cannot-find-incorrect-one!
+ (|> (:: ..builder leaf tag-right expected-right)
+ (/.search (text.contains? tag-left))
+ (maybe@map (n.= expected-left))
+ (maybe.default false)
+ not)
+
+ can-find-left!
+ (|> (:: ..builder branch
+ (:: ..builder leaf tag-left expected-left)
+ (:: ..builder leaf tag-right expected-right))
+ (/.search (text.contains? tag-left))
+ (maybe@map (n.= expected-left))
+ (maybe.default false))
+
+ can-find-right!
+ (|> (:: ..builder branch
+ (:: ..builder leaf tag-left expected-left)
+ (:: ..builder leaf tag-right expected-right))
+ (/.search (text.contains? tag-right))
+ (maybe@map (n.= expected-right))
+ (maybe.default false))]
+ (and can-find-correct-one!
+ cannot-find-incorrect-one!
+ can-find-left!
+ can-find-right!)))
+ (_.cover [/.found?]
+ (let [can-find-correct-one!
+ (/.found? (text.contains? tag-left)
+ (:: ..builder leaf tag-left expected-left))
+
+ cannot-find-incorrect-one!
+ (not (/.found? (text.contains? tag-left)
+ (:: ..builder leaf tag-right expected-right)))
+
+ can-find-left!
+ (/.found? (text.contains? tag-left)
+ (:: ..builder branch
+ (:: ..builder leaf tag-left expected-left)
+ (:: ..builder leaf tag-right expected-right)))
+
+ can-find-right!
+ (/.found? (text.contains? tag-right)
+ (:: ..builder branch
+ (:: ..builder leaf tag-left expected-left)
+ (:: ..builder leaf tag-right expected-right)))]
+ (and can-find-correct-one!
+ cannot-find-incorrect-one!
+ can-find-left!
+ can-find-right!)))
+ ))))