aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/test/test.lux1
-rw-r--r--stdlib/test/test/lux.lux9
-rw-r--r--stdlib/test/test/lux/control/apply.lux69
-rw-r--r--stdlib/test/test/lux/control/functor.lux56
-rw-r--r--stdlib/test/test/lux/control/monad.lux54
-rw-r--r--stdlib/test/test/lux/io.lux55
6 files changed, 220 insertions, 24 deletions
diff --git a/stdlib/test/test.lux b/stdlib/test/test.lux
index 53efb1c05..a28c38ce5 100644
--- a/stdlib/test/test.lux
+++ b/stdlib/test/test.lux
@@ -83,7 +83,6 @@
## TODO: Must have 100% coverage on tests.
[/
["/." lux
- ## [io (#+)]
## [time
## [instant (#+)]
## [duration (#+)]
diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux
index 0470be339..665a11e89 100644
--- a/stdlib/test/test/lux.lux
+++ b/stdlib/test/test/lux.lux
@@ -12,6 +12,7 @@
["_" test (#+ Test)]]
[/
["/." cli]
+ ["/." io]
["/." host
["/." jvm]]])
@@ -232,11 +233,13 @@
..template)
(<| (_.context "Cross-platform support.")
..cross-platform-support)
- (<| (_.context "/cli")
+ (<| (_.context "/cli Command-Line Interface.")
/cli.test)
- (<| (_.context "/host")
+ (<| (_.context "/io I/O (input/output)")
+ /io.test)
+ (<| (_.context "/host Host-platform interoperation")
($_ _.and
/host.test
- (<| (_.context "/jvm")
+ (<| (_.context "/jvm JVM (Java Virtual Machine)")
/jvm.test)))
))
diff --git a/stdlib/test/test/lux/control/apply.lux b/stdlib/test/test/lux/control/apply.lux
new file mode 100644
index 000000000..01fb33797
--- /dev/null
+++ b/stdlib/test/test/lux/control/apply.lux
@@ -0,0 +1,69 @@
+(.module:
+ [lux #*
+ [control
+ [monad (#+ do)]]
+ ["." function]
+ [math
+ ["r" random]]
+ ["_" test (#+ Test)]]
+ {1
+ ["." / (#+ Apply)]}
+ [//
+ [functor (#+ Injection Comparison)]])
+
+(def: (identity (^open "_/.") injection comparison)
+ (All [f] (-> (Apply f) (Injection f) (Comparison f) Test))
+ (do r.monad
+ [sample (:: @ map injection r.nat)]
+ (_.test "Identity."
+ ((comparison n/=)
+ (_/apply (injection function.identity) sample)
+ sample))))
+
+(def: (homomorphism (^open "_/.") injection comparison)
+ (All [f] (-> (Apply f) (Injection f) (Comparison f) Test))
+ (do r.monad
+ [sample r.nat
+ increase (:: @ map n/+ r.nat)]
+ (_.test "Homomorphism."
+ ((comparison n/=)
+ (_/apply (injection increase) (injection sample))
+ (injection (increase sample))))))
+
+(def: (interchange (^open "_/.") injection comparison)
+ (All [f] (-> (Apply f) (Injection f) (Comparison f) Test))
+ (do r.monad
+ [sample r.nat
+ increase (:: @ map n/+ r.nat)]
+ (_.test "Interchange."
+ ((comparison n/=)
+ (_/apply (injection increase) (injection sample))
+ (_/apply (injection (function (_ f) (f sample))) (injection increase))))))
+
+(def: (composition (^open "_/.") injection comparison)
+ (All [f] (-> (Apply f) (Injection f) (Comparison f) Test))
+ (do r.monad
+ [sample r.nat
+ increase (:: @ map n/+ r.nat)
+ decrease (:: @ map n/- r.nat)]
+ (_.test "Composition."
+ ((comparison n/=)
+ (_$ _/apply
+ (injection function.compose)
+ (injection increase)
+ (injection decrease)
+ (injection sample))
+ ($_ _/apply
+ (injection increase)
+ (injection decrease)
+ (injection sample))))))
+
+(def: #export (laws apply injection comparison)
+ (All [f] (-> (Apply f) (Injection f) (Comparison f) Test))
+ (_.context "Apply laws."
+ ($_ _.and
+ (..identity apply injection comparison)
+ (..homomorphism apply injection comparison)
+ (..interchange apply injection comparison)
+ (..composition apply injection comparison)
+ )))
diff --git a/stdlib/test/test/lux/control/functor.lux b/stdlib/test/test/lux/control/functor.lux
new file mode 100644
index 000000000..a93edc291
--- /dev/null
+++ b/stdlib/test/test/lux/control/functor.lux
@@ -0,0 +1,56 @@
+(.module:
+ [lux #*
+ [control
+ [monad (#+ do)]]
+ ["." function]
+ [math
+ ["r" random]]
+ ["_" test (#+ Test)]]
+ {1
+ ["." / (#+ Functor)]})
+
+(type: #export (Injection f)
+ (All [a] (-> a (f a))))
+
+(type: #export (Comparison f)
+ (All [a]
+ (-> (-> a a Bit)
+ (-> (f a) (f a) Bit))))
+
+(def: (identity (^open "_/.") injection comparison)
+ (All [f] (-> (Functor f) (Injection f) (Comparison f) Test))
+ (do r.monad
+ [sample (:: @ map injection r.nat)]
+ (_.test "Identity."
+ ((comparison n/=)
+ (_/map function.identity sample)
+ sample))))
+
+(def: (homomorphism (^open "_/.") injection comparison)
+ (All [f] (-> (Functor f) (Injection f) (Comparison f) Test))
+ (do r.monad
+ [sample r.nat
+ increase (:: @ map n/+ r.nat)]
+ (_.test "Homomorphism."
+ ((comparison n/=)
+ (_/map increase (injection sample))
+ (injection (increase sample))))))
+
+(def: (composition (^open "_/.") injection comparison)
+ (All [f] (-> (Functor f) (Injection f) (Comparison f) Test))
+ (do r.monad
+ [sample (:: @ map injection r.nat)
+ increase (:: @ map n/+ r.nat)
+ decrease (:: @ map n/- r.nat)]
+ (_.test "Composition."
+ ((comparison n/=)
+ (|> sample (_/map increase) (_/map decrease))
+ (|> sample (_/map (|>> increase decrease)))))))
+
+(def: #export (laws functor injection comparison)
+ (All [f] (-> (Functor f) (Injection f) (Comparison f) Test))
+ (_.context "Functor laws."
+ ($_ _.and
+ (..identity functor injection comparison)
+ (..homomorphism functor injection comparison)
+ (..composition functor injection comparison))))
diff --git a/stdlib/test/test/lux/control/monad.lux b/stdlib/test/test/lux/control/monad.lux
new file mode 100644
index 000000000..412f3ab94
--- /dev/null
+++ b/stdlib/test/test/lux/control/monad.lux
@@ -0,0 +1,54 @@
+(.module:
+ [lux #*
+ ["." function]
+ [math
+ ["r" random]]
+ ["_" test (#+ Test)]]
+ {1
+ ["." / (#+ Monad do)]}
+ [//
+ [functor (#+ Injection Comparison)]])
+
+(def: (left-identity (^open "_/.") injection comparison)
+ (All [f] (-> (Monad f) (Injection f) (Comparison f) Test))
+ (do r.monad
+ [sample r.nat
+ morphism (:: @ map (function (_ diff)
+ (|>> (n/+ diff) _/wrap))
+ r.nat)]
+ (_.test "Left identity."
+ ((comparison n/=)
+ (|> (injection sample) (_/map morphism) _/join)
+ (morphism sample)))))
+
+(def: (right-identity (^open "_/.") injection comparison)
+ (All [f] (-> (Monad f) (Injection f) (Comparison f) Test))
+ (do r.monad
+ [sample r.nat]
+ (_.test "Right identity."
+ ((comparison n/=)
+ (|> (injection sample) (_/map _/wrap) _/join)
+ (injection sample)))))
+
+(def: (associativity (^open "_/.") injection comparison)
+ (All [f] (-> (Monad f) (Injection f) (Comparison f) Test))
+ (do r.monad
+ [sample r.nat
+ increase (:: @ map (function (_ diff)
+ (|>> (n/+ diff) _/wrap))
+ r.nat)
+ decrease (:: @ map (function (_ diff)
+ (|>> (n/- diff) _/wrap))
+ r.nat)]
+ (_.test "Associativity."
+ ((comparison n/=)
+ (|> (injection sample) (_/map increase) _/join (_/map decrease) _/join)
+ (|> (injection sample) (_/map (|>> increase (_/map decrease) _/join)) _/join)))))
+
+(def: #export (laws monad injection comparison)
+ (All [f] (-> (Monad f) (Injection f) (Comparison f) Test))
+ (_.context "Monad laws."
+ ($_ _.and
+ (..left-identity monad injection comparison)
+ (..right-identity monad injection comparison)
+ (..associativity monad injection comparison))))
diff --git a/stdlib/test/test/lux/io.lux b/stdlib/test/test/lux/io.lux
index 86143fe27..a14a240cb 100644
--- a/stdlib/test/test/lux/io.lux
+++ b/stdlib/test/test/lux/io.lux
@@ -1,24 +1,39 @@
(.module:
[lux #*
- ["&" io]
[control
- ["M" monad (#+ do Monad)]]
- [data
- [number]
- [text ("text/." equivalence)
- format]]]
- lux/test)
+ [monad (#+ do)]
+ {[0 #test]
+ [/
+ [".T" functor (#+ Injection Comparison)]
+ [".T" apply]
+ [".T" monad]]}]
+ ["." function]
+ [math
+ ["r" random]]
+ ["_" test (#+ Test)]]
+ {1
+ ["." / (#+ IO)]})
-(context: "I/O"
- ($_ seq
- (test "" (text/= "YOLO" (&.run (&.io "YOLO"))))
- (test "" (i/= +11 (&.run (:: &.functor map inc (&.io +10)))))
- (test "" (i/= +10 (&.run (:: &.monad wrap +10))))
- (test "" (i/= +30 (&.run (let [(^open "&/.") &.apply
- (^open "&/.") &.monad]
- (&/apply (&/wrap (i/+ +10)) (&/wrap +20))))))
- (test "" (i/= +30 (&.run (do &.monad
- [f (wrap i/+)
- x (wrap +10)
- y (wrap +20)]
- (wrap (f x y))))))))
+(def: injection
+ (Injection IO)
+ (|>> /.io))
+
+(def: comparison
+ (Comparison IO)
+ (function (_ == left right)
+ (== (/.run left) (/.run right))))
+
+(def: #export test
+ Test
+ (do r.monad
+ [sample r.nat
+ exit-code r.int]
+ ($_ _.and
+ (_.test "Can execute computations designated as I/O computations."
+ (n/= sample (/.run (/.io sample))))
+ (_.test "I/O operations won't execute unless they are explicitly run."
+ (exec (/.exit exit-code)
+ true))
+ (functorT.laws /.functor ..injection ..comparison)
+ (applyT.laws /.apply ..injection ..comparison)
+ (monadT.laws /.monad ..injection ..comparison))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 04:42:50 +0000