aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/abstract/functor.lux
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))))