aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--stdlib/source/lux/codata/env.lux2
-rw-r--r--stdlib/source/lux/codata/state.lux9
-rw-r--r--stdlib/source/lux/data/log.lux3
-rw-r--r--stdlib/source/lux/data/maybe.lux2
-rw-r--r--stdlib/source/lux/data/struct/list.lux2
-rw-r--r--stdlib/test/test/lux/codata/env.lux16
-rw-r--r--stdlib/test/test/lux/codata/state.lux18
-rw-r--r--stdlib/test/test/lux/data/log.lux15
-rw-r--r--stdlib/test/test/lux/data/maybe.lux11
-rw-r--r--stdlib/test/test/lux/data/struct/list.lux12
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)))
+ ))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 17:40:47 +0000