Local Open Scope functor_scope.
(** Adjunctions form a category Adj where objects are categories and an arrow from C to D is a pair of adjoint funtors F : C → D : G. *)
Section Adjunct_Id.
Context (C : Category).
Program Definition Adjunct_Id : (Functor_id C) ⊣ (Functor_id C) :=
{|
adj_unit := NatTrans_id _
|}.
End Adjunct_Id.
Section Adjunct_Compose.
Context {C D E : Category}
{F : C –≻ D} {G : D –≻ C} (adj : F ⊣ G)
{F' : D –≻ E} {G' : E –≻ D} (adj' : F' ⊣ G').
Program Definition Adjunct_Compose : ((F' ∘ F) ⊣ (G ∘ G')) :=
{|
adj_unit :=
{|Trans := fun c => (G _a ((Trans (adj_unit adj') (F _o c)))
∘ (Trans (adj_unit adj) c))%morphism |};
adj_morph_ex := fun _ _ f => adj_morph_ex adj' (adj_morph_ex adj f)
|}.
Next Obligation.
Next Obligation.
Next Obligation.
Local Obligation Tactic := idtac.
Next Obligation.
End Adjunct_Compose.
Section Adjunct_Compose_assoc.
Context {B C D E : Category}
{F : B –≻ C} {G : C –≻ B} (adj : F ⊣ G)
{F' : C –≻ D} {G' : D –≻ C} (adj' : F' ⊣ G')
{F'' : D –≻ E} {G'' : E –≻ D} (adj'' : F'' ⊣ G'').

(* Specifications: *)
Theorem Adjunct_Compose_assoc :
match (Functor_assoc F F' F'') in _ = Y return Adjunct Y _ with
eq_refl =>
match eq_sym (Functor_assoc G'' G' G) in _ = Y return Adjunct _ Y with
eq_refl =>
Adjunct_Compose adj (Adjunct_Compose adj' adj'')
end
end
= Adjunct_Compose (Adjunct_Compose adj adj') adj''.