- Added tests for the monad transformers for Error, Maybe, State, List and Env.

10 files changed, 81 insertions, 9 deletions

diff --git a/stdlib/source/lux/codata/env.lux b/stdlib/source/lux/codata/env.lux
index 8883b4a66..818dd8a7e 100644
--- a/stdlib/source/lux/codata/env.lux
+++ b/stdlib/source/lux/codata/env.lux
@@ -52,7 +52,7 @@
   (env-proc env))
 
 (struct: #export (EnvT Monad<M>)
-  (All [M e] (-> (Monad M) (Monad (All [a] (Env e (M a))))))
+  (All [M] (-> (Monad M) (All [e] (Monad (All [a] (Env e (M a)))))))
   (def: applicative (compA Applicative<Env> (get@ #M;applicative Monad<M>)))
   (def: (join eMeMa)
     (lambda [env]
diff --git a/stdlib/source/lux/codata/state.lux b/stdlib/source/lux/codata/state.lux
index 82e9b40fd..2ff0ea3a8 100644
--- a/stdlib/source/lux/codata/state.lux
+++ b/stdlib/source/lux/codata/state.lux
@@ -97,8 +97,15 @@
          [state a] (sFa state)]
         (wrap [state (f a)])))))
 
+(type: #export (State' M s a)
+  (-> s (M [s a])))
+
+(def: #export (run' state action)
+  (All [M s a] (-> s (State' M s a) (M [s a])))
+  (action state))
+
 (struct: #export (StateT Monad<M>)
-  (All [M s] (-> (Monad M) (Monad (All [a] (-> s (M [s a]))))))
+  (All [M s] (-> (Monad M) (Monad (State' M s))))
   (def: applicative (Applicative<StateT> Monad<M>))
   (def: (join sMsMa)
     (lambda [state]
diff --git a/stdlib/source/lux/data/log.lux b/stdlib/source/lux/data/log.lux
index 6b6cd2095..687f23478 100644
--- a/stdlib/source/lux/data/log.lux
+++ b/stdlib/source/lux/data/log.lux
@@ -50,8 +50,7 @@
     (do Monad<M>
       [[l1 Mla] (: (($ +1) (Log ($ +0) (($ +1) (Log ($ +0) ($ +2)))))
                    MlMla)
-       [l2 a] (: (($ +1) (Log ($ +0) ($ +2)))
-                 Mla)]
+       [l2 a] Mla]
       (wrap [(:: Monoid<l> append l1 l2) a]))))
 
 (def: #export (lift-log Monoid<l> Monad<M>)
diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux
index 16aa9e30a..bf853baf1 100644
--- a/stdlib/source/lux/data/maybe.lux
+++ b/stdlib/source/lux/data/maybe.lux
@@ -75,7 +75,7 @@
         (wrap #;None)
 
         (#;Some Mma)
-        (join Mma)))))
+        Mma))))
 
 (def: #export (lift-maybe Monad<M>)
   (All [M a] (-> (Monad M) (-> (M a) (M (Maybe a)))))
diff --git a/stdlib/source/lux/data/struct/list.lux b/stdlib/source/lux/data/struct/list.lux
index acd48d730..cd7323669 100644
--- a/stdlib/source/lux/data/struct/list.lux
+++ b/stdlib/source/lux/data/struct/list.lux
@@ -459,7 +459,7 @@
     (do Monad<M>
       [lMla MlMla
        lla (: (($ +0) (List (List ($ +1))))
-              (mapM @ join lMla))]
+              (seqM @ lMla))]
       (wrap (concat lla)))))
 
 (def: #export (lift-list Monad<M>)
diff --git a/stdlib/test/test/lux/codata/env.lux b/stdlib/test/test/lux/codata/env.lux
index a2a90a3af..4f5a37de9 100644
--- a/stdlib/test/test/lux/codata/env.lux
+++ b/stdlib/test/test/lux/codata/env.lux
@@ -11,7 +11,8 @@
              text/format
              [number])
        (codata function
-               ["&" env]))
+               ["&" env])
+       pipe)
   lux/test)
 
 (test: "Envs"
@@ -27,3 +28,16 @@
                                        x (wrap 10)
                                        y (wrap 20)]
                                       (wrap (f x y))))))))
+
+(test: "Monad transformer"
+  (let [(^open "io/") io;Monad<IO>]
+    (assert "Can add env functionality to any monad."
+            (|> (do (&;EnvT io;Monad<IO>)
+                  [a (&;lift-env (io/wrap 123))
+                   b (wrap 456)]
+                  (wrap (i.+ a b)))
+                (&;run "")
+                io;run
+                (case> 579 true
+                       _   false)))
+    ))
diff --git a/stdlib/test/test/lux/codata/state.lux b/stdlib/test/test/lux/codata/state.lux
index 4c4b808b3..79a458cc0 100644
--- a/stdlib/test/test/lux/codata/state.lux
+++ b/stdlib/test/test/lux/codata/state.lux
@@ -12,7 +12,8 @@
              [number]
              [product])
        (codata function
-               ["&" state]))
+               ["&" state])
+       pipe)
   lux/test)
 
 (test: "State"
@@ -37,3 +38,18 @@
                                                          y (wrap 20)]
                                                         (wrap (f x y))))))))
       ))
+
+(test: "Monad transformer"
+  (let [lift (&;lift-state io;Monad<IO>)
+        (^open "io/") io;Monad<IO>]
+    (assert "Can add state functionality to any monad."
+            (|> (: (&;State' io;IO Text Int)
+                   (do (&;StateT io;Monad<IO>)
+                     [a (lift (io/wrap 123))
+                      b (wrap 456)]
+                     (wrap (i.+ a b))))
+                (&;run' "")
+                io;run
+                (case> ["" 579] true
+                       _        false)))
+    ))
diff --git a/stdlib/test/test/lux/data/log.lux b/stdlib/test/test/lux/data/log.lux
index 2075e0232..dd94b1efa 100644
--- a/stdlib/test/test/lux/data/log.lux
+++ b/stdlib/test/test/lux/data/log.lux
@@ -11,7 +11,8 @@
              [text "Text/" Monoid<Text> Eq<Text>]
              [number]
              [product])
-       (codata function))
+       (codata function)
+       pipe)
   lux/test)
 
 (test: "Logs"
@@ -34,3 +35,15 @@
         (assert "Can log any value."
                 (Text/= "YOLO" (product;left (&;log "YOLO"))))
         )))
+
+(test: "Monad transformer"
+  (let [lift (&;lift-log text;Monoid<Text> io;Monad<IO>)
+        (^open "io/") io;Monad<IO>]
+    (assert "Can add log functionality to any monad."
+            (|> (io;run (do (&;LogT text;Monoid<Text> io;Monad<IO>)
+                          [a (lift (io/wrap 123))
+                           b (wrap 456)]
+                          (wrap (i.+ a b))))
+                (case> ["" 579] true
+                       _ false)))
+    ))
diff --git a/stdlib/test/test/lux/data/maybe.lux b/stdlib/test/test/lux/data/maybe.lux
index d5f20c489..b0f2b411c 100644
--- a/stdlib/test/test/lux/data/maybe.lux
+++ b/stdlib/test/test/lux/data/maybe.lux
@@ -48,3 +48,14 @@
                             b (wrap "lol")]
                            (wrap (f a b)))))
         )))
+
+(test: "Monad transformer"
+  (let [lift (&;lift-maybe io;Monad<IO>)
+        (^open "io/") io;Monad<IO>]
+    (assert "Can add maybe functionality to any monad."
+            (|> (io;run (do (&;MaybeT io;Monad<IO>)
+                          [a (lift (io/wrap 123))
+                           b (wrap 456)]
+                          (wrap (i.+ a b))))
+                (case> (#;Some 579) true
+                       _ false)))))
diff --git a/stdlib/test/test/lux/data/struct/list.lux b/stdlib/test/test/lux/data/struct/list.lux
index aa269988b..db0a14f56 100644
--- a/stdlib/test/test/lux/data/struct/list.lux
+++ b/stdlib/test/test/lux/data/struct/list.lux
@@ -212,3 +212,15 @@
                      (= sample
                         (&/map product;right enum-sample)))))
       ))
+
+(test: "Monad transformer"
+  (let [lift (&;lift-list io;Monad<IO>)
+        (^open "io/") io;Monad<IO>]
+    (assert "Can add list functionality to any monad."
+            (|> (io;run (do (&;ListT io;Monad<IO>)
+                          [a (lift (io/wrap 123))
+                           b (wrap 456)]
+                          (wrap (i.+ a b))))
+                (case> (^ (list 579)) true
+                       _              false)))
+    ))