blob: 944bf13964c8ef79eb30ef857acc47e703248425 (
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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
{-# LANGUAGE NoImplicitPrelude #-}
module Bifunctor where
import Prelude (($), id, (.))
class Bifunctor p where
{-# MINIMAL bimap | first, second #-}
bimap :: (a -> b)
-> (c -> d)
-> p a c
-> p b d
bimap f g = first f . second g
first :: (a -> b) -> p a c -> p b c
first f = bimap f id
second :: (b -> c) -> p a b -> p a c
second = bimap id
-- 1
data Deux a b = Deux a b
instance Bifunctor Deux where
first f (Deux a c) = Deux (f a) c
second f (Deux a b) = Deux a (f b)
-- 2
data Const a b = Const a
instance Bifunctor Const where
first f (Const a) = Const (f a)
second f (Const a) = Const a
-- 3
data Drei a b c = Drei a b c
instance Bifunctor (Drei a) where
first f (Drei a b c) = Drei a (f b) c
second f (Drei a b c) = Drei a b (f c)
-- 4
data SuperDrei a b c = SuperDrei a b
instance Bifunctor (SuperDrei a) where
first f (SuperDrei a b) = SuperDrei a (f b)
second f (SuperDrei a b) = SuperDrei a b
-- 5
data SemiDrei a b c = SemiDrei a
instance Bifunctor (SemiDrei a) where
first f (SemiDrei a) = SemiDrei a
second f (SemiDrei a) = SemiDrei a
-- 6
data Quadriceps a b c d = Quadzzz a b c d
instance Bifunctor (Quadriceps a b) where
first f (Quadzzz a b c d) = Quadzzz a b (f c) d
second f (Quadzzz a b c d) = Quadzzz a b c (f d)
-- 7
data Either a b = Left a | Right b
instance Bifunctor Either where
first f (Left a) = Left $ f a
second f (Right b) = Right $ f b
|
