blob: a827a06d3ecdb503f520aae69c9697b0ea281a1f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
(.module:
lux
(// [functor #+ Functor]))
(sig: #export (Applicative f)
{#.doc "Applicative functors."}
(: (Functor f)
functor)
(: (All [a]
(-> a (f a)))
wrap)
(: (All [a b]
(-> (f (-> a b)) (f a) (f b)))
apply))
(struct: #export (compose Applicative<F> Applicative<G>)
{#.doc "Applicative functor composition."}
(All [F G] (-> (Applicative F) (Applicative G) (Applicative (All [a] (F (G a))))))
(def: functor (functor.compose (get@ #functor Applicative<F>)
(get@ #functor Applicative<G>)))
(def: wrap
(|>> (:: Applicative<G> wrap) (:: Applicative<F> wrap)))
(def: (apply fgf fgx)
## TODO: Switch from this version to the one below (in comments) ASAP.
(let [fgf' (:: Applicative<F> apply
(:: Applicative<F> wrap (:: Applicative<G> apply))
fgf)]
(:: Applicative<F> apply fgf' fgx))
## (let [applyF (:: Applicative<F> apply)
## applyG (:: Applicative<G> apply)]
## ($_ applyF
## (:: Applicative<F> wrap applyG)
## fgf
## fgx))
))
|
