aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/control/applicative.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/lux/control/applicative.lux')
-rw-r--r--stdlib/source/lux/control/applicative.lux33
1 files changed, 33 insertions, 0 deletions
diff --git a/stdlib/source/lux/control/applicative.lux b/stdlib/source/lux/control/applicative.lux
new file mode 100644
index 000000000..5d4cad0c0
--- /dev/null
+++ b/stdlib/source/lux/control/applicative.lux
@@ -0,0 +1,33 @@
+## Copyright (c) Eduardo Julian. All rights reserved.
+## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+## If a copy of the MPL was not distributed with this file,
+## You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+ lux
+ (.. ["F" functor]))
+
+(sig: #export (Applicative f)
+ (: (F;Functor f)
+ functor)
+ (: (All [a]
+ (-> a (f a)))
+ wrap)
+ (: (All [a b]
+ (-> (f (-> a b)) (f a) (f b)))
+ apply))
+
+(def: #export (compA Applicative<F> Applicative<G>)
+ (All [F G] (-> (Applicative F) (Applicative G) (Applicative (All [a] (F (G a))))))
+ (struct (def: functor (F;compF (get@ #functor Applicative<F>)
+ (get@ #functor Applicative<G>)))
+ (def: wrap
+ (|>. (:: Applicative<G> wrap) (:: Applicative<F> wrap)))
+ (def: (apply fgf fgx)
+ (let [applyF (:: Applicative<F> apply)
+ applyG (:: Applicative<G> apply)]
+ ($_ applyF
+ (:: Applicative<F> wrap applyG)
+ fgf
+ fgx)))
+ ))