-
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
-
69
-
70
-
71
-
72
-
73
-
74
-
75
-
76
-
77
-
78
-
79
-
80
-
81
-
82
-
83
-
84
-
85
-
86
-
87
-
88
-
89
-
90
-
91
-
92
-
93
-
94
-
95
-
96
-
97
-
98
-
99
-
100
-
101
-
102
-
103
-
104
-
105
-
106
-
107
-
108
-
109
-
110
-
111
-
112
-
113
-
114
-
115
-
116
-
117
-
118
-
119
-
120
-
121
-
122
-
123
-
124
-
125
-
126
-
127
-
128
-
129
-
130
-
131
-
132
-
133
-
134
-
135
-
136
-
137
-
138
-
139
-
140
-
141
-
142
-- https://github.com/BartoszMilewski/DaoFP
import Mathlib
-- universe u
def absurd' {C : Sort u} : Empty → C := Empty.rec
#check absurd'
#check id
-- Universes sad
-- #eval id id
-- Naturality condition
inductive Bool'
| true' (a : Unit) : Bool'
| false' (a : Unit) : Bool'
#check Bool'.true' = Bool'.false'
-- def f
-- | 0 => 1
-- | x + 1 => (x + 1) * f x
#eval f 69
def third {α β γ} (x : α × β × γ) :=
let (_, _, c) := x
c
universe v
-- class Natural (f : (Type u → Type v) → Type u → Type v) : Type (max (u + 1) v) where
-- Oops it's not a typeclass
def id' {α} (x : α) := x
#check id'
def yoneda {α} (m : Type u → Type v) [Functor m] (g : {β : Type u} → (α → β) → m β) : m α := g id
def yoneda' {α} (m : Type u → Type v) [Functor m] (y : m α) : {β : Type u} → (α → β) → m β := (· <$> y)
-- def map_to_T (x : String) : Type :=
-- if x = "0" then
-- Nat
-- else
-- String
-- def natOrStringThree (b : Bool) : if b then Nat else String :=
-- match b with
-- | true => (3 : Nat)
-- | false => "three"
-- abbrev map_to_T (x : String) : Type :=
-- if x = "0" then Nat else String
-- def map_to (x : String) : map_to_T x :=
-- match decide (x = "0") with
-- | true => (42 : Nat)
-- | false => x
-- def map_to (x : String) : map_to_T x :=
-- if h : x = "0" then by
-- simp [map_to_T, h]
-- exact 42
-- else by
-- simp [map_to_T, h]
-- exact x
def ap [Monad m] (fs : m (α → β)) (as : m α) : m β := do
-- fs >>= λ f ↦ as >>= λ a ↦ pure (f a)
-- fs >>= (· <$> as)
return (← fs) (← as)
class Monad' (m : Type → Type) where
fish : (β → m γ) → (α → m β) → (α → m γ)
join : (a : m (m α)) → m α := fish id id
namespace Ch18
class Profunctor (p : Type u → Type u → Type (u + 1)) where
dimap : (s → a) → (b → t) → (p a b → p s t)
inductive Procompose p q [Profunctor p] [Profunctor q] a b
| mk : q a x → p x b → Procompose p q a b
def mapOut [Profunctor p] [Profunctor q] (pc : Procompose p q a b) (f : {x : Type} → q a x → p x b → c) :=
match pc with
| ⟨qax, pxb⟩ => f qax pxb
instance [Profunctor p] [Profunctor q] : Profunctor (Procompose p q) where
dimap l r
| ⟨qax, pxb⟩ => ⟨Profunctor.dimap l id qax, Profunctor.dimap id r pxb⟩
def End p [Profunctor p] := ∀ x, p x x
def Coend p [Profunctor p] := Σ x, p x x
inductive ProPair q p [Profunctor p] [Profunctor q] a b x y
| mk : q a y → p x b → ProPair q p a b x y
instance [Profunctor p] [Profunctor q] : Profunctor (ProPair q p a b) where
dimap l r
| ⟨qax, pxb⟩ => ⟨Profunctor.dimap id r qax, Profunctor.dimap l id pxb⟩
inductive CoEndCompose p q [Profunctor p] [Profunctor q] a b
| mk : Coend (ProPair q p a b) → CoEndCompose p q a b
instance [Profunctor p] [Profunctor q] : Profunctor (CoEndCompose p q) where
dimap l r
| ⟨x, ⟨qay, pxb⟩⟩ => ⟨x, ⟨Profunctor.dimap l id qay,Profunctor.dimap id r pxb⟩⟩
inductive Yo f [Functor f] a x y
| mk : ((a → x) → f y) → Yo f a x y
instance [Functor f] : Profunctor (Yo f a)
def yoneda f [Functor f] : (End (Yo f a)) → f a
| ⟨x, g⟩ => g id
inductive LensE s a
| mk : (s → (c × a)) → (c × a → s) → LensE s a
def toGet : LensE s a → (s → a)
| ⟨l, _⟩ => (l · |>.2)
def toSet : LensE s a → (s → a → s)
| ⟨l, r⟩ => fun s a ↦ r ((l s).1, a)
def getResidue : LensE s a → c
| ⟨l, _⟩ => (l _).1
end Ch18