aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/abstract/apply.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/lux/abstract/apply.lux')
-rw-r--r--stdlib/source/lux/abstract/apply.lux36
1 files changed, 36 insertions, 0 deletions
diff --git a/stdlib/source/lux/abstract/apply.lux b/stdlib/source/lux/abstract/apply.lux
new file mode 100644
index 000000000..5eb42b63d
--- /dev/null
+++ b/stdlib/source/lux/abstract/apply.lux
@@ -0,0 +1,36 @@
+(.module:
+ lux
+ [//
+ ["." functor (#+ Functor)]
+ [monad (#+ Monad)]])
+
+(signature: #export (Apply f)
+ {#.doc "Applicative functors."}
+ (: (Functor f)
+ &functor)
+ (: (All [a b]
+ (-> (f (-> a b)) (f a) (f b)))
+ apply))
+
+(structure: #export (compose f-monad f-apply g-apply)
+ {#.doc "Applicative functor composition."}
+ (All [F G]
+ (-> (Monad F) (Apply F) (Apply G)
+ ## TODO: Replace (All [a] (F (G a))) with (functor.Then F G)
+ (Apply (All [a] (F (G a))))))
+
+ (def: &functor (functor.compose (get@ #&functor f-apply) (get@ #&functor g-apply)))
+
+ (def: (apply fgf fgx)
+ ## TODO: Switch from this version to the one below (in comments) ASAP.
+ (let [fgf' (:: f-apply apply
+ (:: f-monad wrap (:: g-apply apply))
+ fgf)]
+ (:: f-apply apply fgf' fgx))
+ ## (let [applyF (:: f-apply apply)
+ ## applyG (:: g-apply apply)]
+ ## ($_ applyF
+ ## (:: f-monad wrap applyG)
+ ## fgf
+ ## fgx))
+ ))