Local Open Scope nattrans_scope.
Section Y_emb.
Context (C : Category).
(** The dual of the Yoneda embedding for category C – the curry of hom functor of C. *)
Definition CoYoneda : (C^op –≻ (Func_Cat C Type_Cat))%functor :=
Exp_Cat_morph_ex (Hom_Func C).
(** The Yoneda embedding for category C – the curry of hom functor of Cᵒᵖ. *)
Definition Yoneda : (C –≻ (Func_Cat (C^op) Type_Cat))%functor :=
Exp_Cat_morph_ex (Hom_Func (C^op)).
End Y_emb.
Section Y_Left_Right.
Context (C : Category).
(** The left hand side of the Yoneda lemma's isomorphism *)
Definition Y_left :
((C^op × (Func_Cat (C^op) Type_Cat)) –≻ Type_Cat)%functor
:=
((Hom_Func _)
∘ (Prod_Functor
((Yoneda C)^op) (Functor_id (Func_Cat (C^op) Type_Cat))))%functor.
(** The right hand side of the Yoneda lemma's isomorphism *)
Definition Y_right
: ((C^op × (Func_Cat (C^op) Type_Cat)) –≻ Type_Cat)%functor :=
((Exp_Cat_Eval (C^op) Type_Cat) ∘ (Twist_Func _ _))%functor.
End Y_Left_Right.
Local Obligation Tactic := idtac.
(** The left to right natural transformation of Yoneda lemma. *)
Program Definition Y_left_to_right (C : Category) : (Y_left C) –≻ (Y_right C) :=
{|
Trans := fun c_F => fun N => ((Trans N (fst c_F))) (id (fst c_F))
|}.
Next Obligation. (* Trnas_com *)
Next Obligation.
(** The natural transformation needed to make the right to left natural transformation of Yoneda lemma. *)
Program Definition Y_right_to_left_NT (C : Category) (c : Obj)
(F : (C^op –≻ Type_Cat)%functor) (h : (F _o c)%object)
:
((Yoneda _) _o c)%object –≻ F :=
{|
Trans := fun c' => fun g => (F _a g)%morphism h
|}.
Next Obligation. (* Trnas_com *)
Next Obligation.
(** The right to left natural transformation of Yoneda lemma. *)
Program Definition Y_right_to_left (C : Category) : (Y_right C) –≻ (Y_left C) :=
{|
Trans := fun c_F => fun h => Y_right_to_left_NT C (fst c_F) (snd c_F) h
|}.
Next Obligation. (* Trans_com *)
Next Obligation.
(** The Yoneda Lemma*)
Program Definition Yoneda_Lemma (C : Category) :
((Y_left C) ≃ (Y_right C))%natiso :=
NatIso _ _ (Y_left_to_right C) (Y_right_to_left C) _ _.
Next Obligation.
Next Obligation.
simpl; intros C [c F]; FunExt.
apply NatTrans_eq_simplify.
FunExt.
cbn in *.
match goal with
[|- ?W = _] =>
match W with
?X (?Y ?Z) =>
change W with ((X ∘ Y) Z)%morphism
end
end.
rewrite <- Trans_com; cbn.
auto.
Qed.

(* Specifications: *)
(** Yoneda embedding is faithful. *)
Lemma Yoneda_Faithful (C : Category) : Faithful_Func (Yoneda C).
(** Yoneda embedding is full. *)
Lemma Yoneda_Full (C : Category) : Full_Func (Yoneda C).
Definition Yoneda_Emb (C : Category) : Embedding C (Func_Cat (C^op) Type_Cat) :=
{|
Emb_Func := Yoneda C;
Emb_Faithful := Yoneda_Faithful C;
Emb_Full := Yoneda_Full C
|}.