blob: a9fc6796c0cf80d21aaf05ab94a3e12dbb416f49 (
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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
(.module: lux)
(signature: #export (Functor f)
(: (All [a b]
(-> (-> a b)
(-> (f a) (f b))))
map))
(type: #export (Fix f)
(f (Fix f)))
(type: #export (Or f g)
(All [a] (| (f a) (g a))))
(def: #export (sum (^open "f@.") (^open "g@."))
(All [F G] (-> (Functor F) (Functor G) (Functor (..Or F G))))
(structure
(def: (map f fa|ga)
(case fa|ga
(#.Left fa)
(#.Left (f@map f fa))
(#.Right ga)
(#.Right (g@map f ga))))))
(type: #export (And f g)
(All [a] (& (f a) (g a))))
(def: #export (product (^open "f@.") (^open "g@."))
(All [F G] (-> (Functor F) (Functor G) (Functor (..And F G))))
(structure
(def: (map f [fa ga])
[(f@map f fa)
(g@map f ga)])))
(type: #export (Then f g)
(All [a] (f (g a))))
(def: #export (compose (^open "f@.") (^open "g@."))
{#.doc "Functor composition."}
(All [F G] (-> (Functor F) (Functor G) (Functor (..Then F G))))
(structure
(def: (map f fga)
(f@map (g@map f) fga))))
(signature: #export (Contravariant f)
(: (All [a b]
(-> (-> b a)
(-> (f a) (f b))))
map-1))
|