From 0df1d8855ab54abea8c729a3575b30c8499cc7e0 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 18 Dec 2016 18:40:28 -0400 Subject: - Added tests for the monad transformers for Error, Maybe, State, List and Env. --- stdlib/source/lux/codata/env.lux | 2 +- stdlib/source/lux/codata/state.lux | 9 ++++++++- stdlib/source/lux/data/log.lux | 3 +-- stdlib/source/lux/data/maybe.lux | 2 +- stdlib/source/lux/data/struct/list.lux | 2 +- stdlib/test/test/lux/codata/env.lux | 16 +++++++++++++++- stdlib/test/test/lux/codata/state.lux | 18 +++++++++++++++++- stdlib/test/test/lux/data/log.lux | 15 ++++++++++++++- stdlib/test/test/lux/data/maybe.lux | 11 +++++++++++ stdlib/test/test/lux/data/struct/list.lux | 12 ++++++++++++ 10 files changed, 81 insertions(+), 9 deletions(-) (limited to 'stdlib') 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) - (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 (get@ #M;applicative Monad))) (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) - (All [M s] (-> (Monad M) (Monad (All [a] (-> s (M [s a])))))) + (All [M s] (-> (Monad M) (Monad (State' M s)))) (def: applicative (Applicative Monad)) (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 [[l1 Mla] (: (($ +1) (Log ($ +0) (($ +1) (Log ($ +0) ($ +2))))) MlMla) - [l2 a] (: (($ +1) (Log ($ +0) ($ +2))) - Mla)] + [l2 a] Mla] (wrap [(:: Monoid append l1 l2) a])))) (def: #export (lift-log Monoid Monad) 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) (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 [lMla MlMla lla (: (($ +0) (List (List ($ +1)))) - (mapM @ join lMla))] + (seqM @ lMla))] (wrap (concat lla))))) (def: #export (lift-list Monad) 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] + (assert "Can add env functionality to any monad." + (|> (do (&;EnvT io;Monad) + [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) + (^open "io/") io;Monad] + (assert "Can add state functionality to any monad." + (|> (: (&;State' io;IO Text Int) + (do (&;StateT io;Monad) + [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 Eq] [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 io;Monad) + (^open "io/") io;Monad] + (assert "Can add log functionality to any monad." + (|> (io;run (do (&;LogT text;Monoid io;Monad) + [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) + (^open "io/") io;Monad] + (assert "Can add maybe functionality to any monad." + (|> (io;run (do (&;MaybeT io;Monad) + [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) + (^open "io/") io;Monad] + (assert "Can add list functionality to any monad." + (|> (io;run (do (&;ListT io;Monad) + [a (lift (io/wrap 123)) + b (wrap 456)] + (wrap (i.+ a b)))) + (case> (^ (list 579)) true + _ false))) + )) -- cgit v1.2.3