aboutsummaryrefslogtreecommitdiff
path: root/stdlib/test/test/lux/effect.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/test/test/lux/effect.lux')
-rw-r--r--stdlib/test/test/lux/effect.lux77
1 files changed, 77 insertions, 0 deletions
diff --git a/stdlib/test/test/lux/effect.lux b/stdlib/test/test/lux/effect.lux
new file mode 100644
index 000000000..275e1e66a
--- /dev/null
+++ b/stdlib/test/test/lux/effect.lux
@@ -0,0 +1,77 @@
+## Copyright (c) Eduardo Julian. All rights reserved.
+## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+## If a copy of the MPL was not distributed with this file,
+## You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+ lux
+ (lux [io "IO/" Monad<IO>]
+ (control monad
+ functor)
+ (data [text]
+ text/format)
+ [macro]
+ ["R" random]
+ pipe
+ effect)
+ lux/test)
+
+(do-template [<effect> <op> <field>]
+ [(effect: <effect>
+ (<op> [Nat Text] Bool)
+ (<field> Nat))]
+
+ [EffA opA fieldA]
+ [EffB opB fieldB]
+ [EffC opC fieldC]
+ )
+
+(do-template [<effect> <op> <op-test> <field> <field-value>]
+ [(handler: _
+ (=> <effect> [io;IO io;Monad<IO>])
+ (def: (<op> size sample)
+ (IO/wrap (<op-test> size (text;size sample))))
+
+ (def: <field> (IO/wrap <field-value>)))]
+
+ [EffA opA n.< fieldA +10]
+ [EffB opB n.= fieldB +20]
+ [EffC opC n.> fieldC +30]
+ )
+
+(type: EffABC (|E EffA EffB EffC))
+
+(def: Functor<EffABC>
+ (Functor EffABC)
+ (|F Functor<EffA> Functor<EffB> Functor<EffC>))
+
+(def: Handler<EffABC,IO>
+ (Handler EffABC io;IO)
+ (|H io;Monad<IO>
+ Handler<EffA,IO> Handler<EffB,IO> Handler<EffC,IO>))
+
+## [Tests]
+(test: "Algebraic effects"
+ (let% [<single-effect-tests> (do-template [<op> <op-size> <field> <field-value>]
+ [(io;run (with-handler Handler<EffABC,IO>
+ (doE Functor<EffABC>
+ []
+ (lift (<op> <op-size> "YOLO")))))
+ (n.= <field-value> (io;run (with-handler Handler<EffABC,IO>
+ (doE Functor<EffABC>
+ []
+ (lift <field>)))))]
+
+ [opA +10 fieldA +10]
+ [opB +4 fieldB +20]
+ [opC +2 fieldC +30])]
+ (assert "Can handle effects using handlers."
+ (and <single-effect-tests>
+
+ (n.= +60 (io;run (with-handler Handler<EffABC,IO>
+ (doE Functor<EffABC>
+ [a (lift fieldA)
+ b (lift fieldB)
+ c (lift fieldC)]
+ (wrap ($_ n.+ a b c))))))
+ ))))