From c85654fe58058eb1b5529e6c392b1bc55bd05862 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 18 Dec 2016 11:42:20 -0400
Subject: - Fixed a bug in the way effect-handling worked. - Added tests for
 lux/control/effect.

---
 stdlib/test/test/lux/control/effect.lux | 77 +++++++++++++++++++++++++++++++++
 stdlib/test/tests.lux                   |  2 +-
 2 files changed, 78 insertions(+), 1 deletion(-)
 create mode 100644 stdlib/test/test/lux/control/effect.lux

(limited to 'stdlib/test')

diff --git a/stdlib/test/test/lux/control/effect.lux b/stdlib/test/test/lux/control/effect.lux
new file mode 100644
index 000000000..cffdbd561
--- /dev/null
+++ b/stdlib/test/test/lux/control/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 (codata [io "IO/" Monad<IO>])
+       (control monad
+                functor)
+       (data [text]
+             text/format)
+       [macro]
+       (math ["R" random])
+       pipe
+       (control 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))))))
+                 ))))
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index ebb6c6999..fba3e139f 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -26,6 +26,7 @@
                           [frp]
                           ["_;" promise]
                           [stm])
+             (control [effect])
              (data [bit]
                    [bool]
                    [char]
@@ -66,7 +67,6 @@
              ["_;" type]
              (type ["_;" check]
                    ["_;" auto])
-             ## (control [effect])
              )
         ))
 
-- 
cgit v1.2.3