blob: 03c10eaafd6ec5f3be2ad69a08166ed4ec1c0056 (
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
|
(.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))))
|