diff options
Diffstat (limited to 'stdlib/test/test/lux/effect.lux')
-rw-r--r-- | stdlib/test/test/lux/effect.lux | 77 |
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)))))) + )))) |