aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2017-04-10 23:31:07 -0400
committerEduardo Julian2017-04-10 23:31:07 -0400
commitd5ecf2657e9e9c6fb8d0daee675e1a72627d3014 (patch)
tree8f3d51b0e91509e75ed223b9685431903328e7f2
parenta1b2a8120921ccca79e95b8bd35b475b34dd9780 (diff)
- Move the structures for the Free monad into lux/control/monad.
-rw-r--r--stdlib/source/lux/control/effect.lux53
-rw-r--r--stdlib/source/lux/control/monad.lux65
2 files changed, 59 insertions, 59 deletions
diff --git a/stdlib/source/lux/control/effect.lux b/stdlib/source/lux/control/effect.lux
index 1f0046fce..6c432c47b 100644
--- a/stdlib/source/lux/control/effect.lux
+++ b/stdlib/source/lux/control/effect.lux
@@ -26,59 +26,6 @@
handle))
## [Values]
-(struct: #export (Functor<Free> dsl)
- (All [F] (-> (F;Functor F) (F;Functor (Free F))))
- (def: (map f ea)
- (case ea
- (#M;Pure a)
- (#M;Pure (f a))
-
- (#M;Effect value)
- (#M;Effect (:: dsl map (map f) value)))))
-
-(struct: #export (Applicative<Free> dsl)
- (All [F] (-> (F;Functor F) (Applicative (Free F))))
- (def: functor (Functor<Free> dsl))
-
- (def: (wrap a)
- (#M;Pure a))
-
- (def: (apply ef ea)
- (case [ef ea]
- [(#M;Pure f) (#M;Pure a)]
- (#M;Pure (f a))
-
- [(#M;Pure f) (#M;Effect fa)]
- (#M;Effect (:: dsl map
- (:: (Functor<Free> dsl) map f)
- fa))
-
- [(#M;Effect ff) _]
- (#M;Effect (:: dsl map
- (function [f] (apply f ea))
- ff))
- )))
-
-(struct: #export (Monad<Free> dsl)
- (All [F] (-> (F;Functor F) (Monad (Free F))))
- (def: applicative (Applicative<Free> dsl))
-
- (def: (join efefa)
- (case efefa
- (#M;Pure efa)
- (case efa
- (#M;Pure a)
- (#M;Pure a)
-
- (#M;Effect fa)
- (#M;Effect fa))
-
- (#M;Effect fefa)
- (#M;Effect (:: dsl map
- (:: (Monad<Free> dsl) join)
- fefa))
- )))
-
(type: #hidden (|@ L R)
(All [a] (| (L a) (R a))))
diff --git a/stdlib/source/lux/control/monad.lux b/stdlib/source/lux/control/monad.lux
index bfbe55c77..22be3fcd5 100644
--- a/stdlib/source/lux/control/monad.lux
+++ b/stdlib/source/lux/control/monad.lux
@@ -48,12 +48,6 @@
(-> (m (m a)) (m a)))
join))
-## [Types]
-(type: #export (Free F a)
- {#;doc "The Free Monad."}
- (#Pure a)
- (#Effect (F (Free F a))))
-
## [Syntax]
(def: _cursor Cursor ["" +0 +0])
@@ -146,3 +140,62 @@
(do Monad<M>
[a ma]
(wrap (f a)))))
+
+## [Free Monads]
+(type: #export (Free F a)
+ {#;doc "The Free Monad."}
+ (#Pure a)
+ (#Effect (F (Free F a))))
+
+(struct: #export (Functor<Free> dsl)
+ (All [F] (-> (F;Functor F) (F;Functor (Free F))))
+ (def: (map f ea)
+ (case ea
+ (#Pure a)
+ (#Pure (f a))
+
+ (#Effect value)
+ (#Effect (:: dsl map (map f) value)))))
+
+(struct: #export (Applicative<Free> dsl)
+ (All [F] (-> (F;Functor F) (A;Applicative (Free F))))
+ (def: functor (Functor<Free> dsl))
+
+ (def: (wrap a)
+ (#Pure a))
+
+ (def: (apply ef ea)
+ (case [ef ea]
+ [(#Pure f) (#Pure a)]
+ (#Pure (f a))
+
+ [(#Pure f) (#Effect fa)]
+ (#Effect (:: dsl map
+ (:: (Functor<Free> dsl) map f)
+ fa))
+
+ [(#Effect ff) _]
+ (#Effect (:: dsl map
+ (function [f] (apply f ea))
+ ff))
+ )))
+
+(struct: #export (Monad<Free> dsl)
+ (All [F] (-> (F;Functor F) (Monad (Free F))))
+ (def: applicative (Applicative<Free> dsl))
+
+ (def: (join efefa)
+ (case efefa
+ (#Pure efa)
+ (case efa
+ (#Pure a)
+ (#Pure a)
+
+ (#Effect fa)
+ (#Effect fa))
+
+ (#Effect fefa)
+ (#Effect (:: dsl map
+ (:: (Monad<Free> dsl) join)
+ fefa))
+ )))