import category_theory.adjunction.basic
import category_theory.limits.preserves.basic
import data.pfun

open category_theory category_theory.functor category_theory.limits
universes u v
variables (𝒞 : Type) [category.{0} 𝒞]

inductive bicompletion_aux : bool → Type 1
| of_cat_obj : 𝒞 → bicompletion_aux ff
| limit_obj {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux ff)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → bicompletion_aux tt) : bicompletion_aux ff
| colimit_obj {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux ff)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → bicompletion_aux tt) : bicompletion_aux ff
| of_cat_hom : Π {X Y : 𝒞}, (X ⟶ Y) → bicompletion_aux tt -- of_cat_obj X ⟶ of_cat_obj Y
| limit_cone_comp {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux ff)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → bicompletion_aux tt)
  (X : 𝒟) (Y : bicompletion_aux ff) (f : bicompletion_aux tt) : -- F_obj X ⟶ Y
  bicompletion_aux tt -- limit_obj F_obj F_hom ⟶ Y
| is_limit {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux ff)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → bicompletion_aux tt)
  (cone_obj : bicompletion_aux ff)
  (cone : Π (X : 𝒟), bicompletion_aux tt) : -- cone_obj ⟶ F_obj X
  bicompletion_aux tt -- cone_obj → limit_obj F_obj F_hom
| colimit_cocone_comp {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux ff)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → bicompletion_aux tt)
  (X : 𝒟) (Y : bicompletion_aux ff) (f : bicompletion_aux tt) : -- Y ⟶ F_obj X
  bicompletion_aux tt -- Y ⟶ colimit_obj F_obj F_hom
| is_colimit {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux ff)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → bicompletion_aux tt)
  (cocone_obj : bicompletion_aux ff)
  (cocone : Π (X : 𝒟), bicompletion_aux tt) : -- F_obj X ⟶ cocone_obj
  bicompletion_aux tt -- colimit_obj F_obj F_hom ⟶ cocone_obj

namespace bicompletion_aux

variable {𝒞}

@[simp] def dom : Π (X : bicompletion_aux 𝒞 tt), bicompletion_aux 𝒞 ff
| (@of_cat_hom _ _ X Y f) := of_cat_obj X
| (@limit_cone_comp _ _ 𝒟 _ F_obj F_hom X _ _) := by exactI limit_obj F_obj @F_hom
| (@is_limit _ _ 𝒟 _ F_obj F_hom cone_obj cone) := cone_obj
| (@colimit_cocone_comp _ _ 𝒟 _ F_obj F_hom X Y f) := Y
| (@is_colimit _ _ 𝒟 _ F_obj F_hom cocone_obj cocone) := by exactI colimit_obj F_obj @F_hom

@[simp] def cod : Π (X : bicompletion_aux 𝒞 tt), bicompletion_aux 𝒞 ff
| (@of_cat_hom _ _ X Y f) := of_cat_obj Y
| (@colimit_cocone_comp _ _ 𝒟 _ F_obj F_hom X _ _) := by exactI colimit_obj F_obj @F_hom
| (@is_colimit _ _ 𝒟 _ F_obj F_hom cocone_obj cocone) := cocone_obj
| (@limit_cone_comp _ _ 𝒟 _ F_obj F_hom X Y f) := Y
| (@is_limit _ _ 𝒟 _ F_obj F_hom cone_obj cone) := by exactI limit_obj F_obj @F_hom

variable (𝒞)

def obj₁ : Type 1 := bicompletion_aux 𝒞 ff

variable {𝒞}
variables {𝒟 : Type} [category.{0} 𝒟]

def hom₁ (X Y : obj₁ 𝒞) : Type 1 :=
{ f : bicompletion_aux 𝒞 tt // f.dom = X ∧ f.cod = Y }

@[simp] lemma coe_dom {X Y : obj₁ 𝒞} (f : hom₁ X Y) :
  (@coe { f : bicompletion_aux 𝒞 tt // f.dom = X ∧ f.cod = Y }
    (bicompletion_aux 𝒞 tt) _ f).dom = X := f.2.1

@[simp] lemma coe_cod {X Y : obj₁ 𝒞} (f : hom₁ X Y) :
  (@coe { f : bicompletion_aux 𝒞 tt // f.dom = X ∧ f.cod = Y }
    (bicompletion_aux 𝒞 tt) _ f).cod = Y := f.2.2

def of_cat_obj₁ (X : 𝒞) : obj₁ 𝒞 := of_cat_obj X

def limit_obj₁ (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y)) : obj₁ 𝒞 :=
limit_obj F_obj (λ X Y f, (F_hom f).1)

def colimit_obj₁ (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y)) : obj₁ 𝒞 :=
colimit_obj F_obj (λ X Y f, (F_hom f).1)

def of_cat_hom₁ {X Y : 𝒞} (f : X ⟶ Y) : hom₁ (of_cat_obj X) (of_cat_obj Y) :=
⟨of_cat_hom f, by simp⟩

def limit_cone_comp₁ (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y)) (X : 𝒟)
  {Y : obj₁ 𝒞} (f : hom₁ (F_obj X) Y) :
  hom₁ (limit_obj₁ F_obj @F_hom) Y :=
⟨limit_cone_comp F_obj (λ X Y f, (F_hom f).1) X Y f.1, by simp [limit_obj₁]⟩

def colimit_cocone_comp₁ (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y)) (X : 𝒟)
  {Y : obj₁ 𝒞} (f : hom₁ Y (F_obj X)) :
  hom₁ Y (colimit_obj₁ F_obj @F_hom) :=
⟨colimit_cocone_comp F_obj (λ X Y f, (F_hom f).1) X Y f.1, by simp [colimit_obj₁]⟩

def is_limit₁ (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (cone_obj : obj₁ 𝒞)
  (cone : Π (X : 𝒟), hom₁ cone_obj (F_obj X)) :
  hom₁ cone_obj (limit_obj₁ F_obj @F_hom) :=
⟨is_limit F_obj (λ X Y f, (F_hom f).1) cone_obj (λ X, (cone X).1), by simp [limit_obj₁]⟩

def is_colimit₁ (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (cocone_obj : obj₁ 𝒞)
  (cocone : Π (X : 𝒟), hom₁ (F_obj X) cocone_obj) :
  hom₁ (colimit_obj₁ F_obj @F_hom) cocone_obj  :=
⟨is_colimit F_obj (λ X Y f, (F_hom f).1) cocone_obj (λ X, (cocone X).1), by simp [colimit_obj₁]⟩

def id₁_aux (b : bool) (hb : b = ff) (X : bicompletion_aux 𝒞 b) :
  hom₁ (show bicompletion_aux 𝒞 ff, from eq.rec_on hb X)
       (show bicompletion_aux 𝒞 ff, from eq.rec_on hb X) :=
begin
  revert hb,
  refine bicompletion_aux.rec_on X _ _ _ _ _ _ _ _,
  { rintros X h,
    exact of_cat_hom₁ (𝟙 X) },
  { introsI 𝒟 _ F_obj F_hom ih₁ ih₂ _,
    exact ⟨is_limit F_obj @F_hom (limit_obj F_obj @F_hom)
      (λ D, limit_cone_comp F_obj @F_hom D (F_obj D) (ih₁ D rfl).1),
      by simp⟩ },
  { introsI 𝒟 _ F_obj F_hom ih₁ ih₂ _,
    exact ⟨is_colimit F_obj @F_hom (colimit_obj F_obj @F_hom)
      (λ D, colimit_cocone_comp F_obj @F_hom D (F_obj D) (ih₁ D rfl).1),
      by simp⟩ },
  all_goals { intros, contradiction }
end

def id₁ (X : obj₁ 𝒞) : hom₁ X X :=
id₁_aux ff rfl X

inductive valid_obj₁ : Π (X : obj₁ 𝒞), Prop
| of_cat_obj (X : 𝒞) : valid_obj₁ (of_cat_obj X)
| limit_obj {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (h : Π X : 𝒟, valid_obj₁ (F_obj X)) :
  valid_obj₁ (limit_obj₁ F_obj @F_hom)
| colimit_obj {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₁ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (h : Π X : 𝒟, valid_obj₁ (F_obj X)) :
  valid_obj₁ (colimit_obj₁ F_obj @F_hom)

def valid_obj₁_limit_obj
  {𝒟 : Type} [category.{0} 𝒟] {F_obj : 𝒟 → obj₁ 𝒞}
  {F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → bicompletion_aux 𝒞 tt}
  (h : valid_obj₁ (limit_obj F_obj @F_hom)) :
  Π (X : 𝒟), valid_obj₁ (F_obj X) :=
begin
  generalize hX : limit_obj F_obj @F_hom = X,
  rw hX at h,
  induction h,
  { simp * at * },
  { simp [limit_obj₁] at hX,
    rcases hX with ⟨hX₁, hX₂, hX₂, hX₄⟩,
    subst hX₁,
    simp at *,
    subst hX₂,
    assumption },
  { simp [*, colimit_obj₁] at * }
end

def valid_obj₁_colimit_obj
  {𝒟 : Type} [category.{0} 𝒟] {F_obj : 𝒟 → obj₁ 𝒞}
  {F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → bicompletion_aux 𝒞 tt}
  (h : valid_obj₁ (colimit_obj F_obj @F_hom)) :
  Π (X : 𝒟), valid_obj₁ (F_obj X) :=
begin
  generalize hX : colimit_obj F_obj @F_hom = X,
  rw hX at h,
  induction h,
  { simp * at * },
  { simp [*, limit_obj₁] at * },
  { simp [colimit_obj₁] at hX,
    rcases hX with ⟨hX₁, hX₂, hX₂, hX₄⟩,
    subst hX₁,
    simp at *,
    subst hX₂,
    assumption }
end

@[elab_as_eliminator] def hom_rec_on {motive : bicompletion_aux 𝒞 tt → Sort u}
  (f : bicompletion_aux 𝒞 tt)
  (of_cat_hom : Π {X Y : 𝒞} (f : X ⟶ Y), motive (of_cat_hom f))
  (limit_cone_comp : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux 𝒞 ff)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → bicompletion_aux 𝒞 tt) (X : 𝒟) (Y : bicompletion_aux 𝒞 ff)
    (f : bicompletion_aux 𝒞 tt),
    (Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f)) →
    motive f → motive (by exactI limit_cone_comp F_obj @F_hom X Y f))
  (is_limit : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux 𝒞 ff)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → bicompletion_aux 𝒞 tt) (cone_obj : bicompletion_aux 𝒞 ff)
    (cone : 𝒟 → bicompletion_aux 𝒞 tt),
    (Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f)) →
    (Π (X : 𝒟), motive (cone X)) → motive (by exactI is_limit F_obj @F_hom cone_obj cone))
  (colimit_cocone_comp : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux 𝒞 ff)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → bicompletion_aux 𝒞 tt) (X : 𝒟) (Y : bicompletion_aux 𝒞 ff)
    (f : bicompletion_aux 𝒞 tt),
    (Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f)) →
    motive f → motive (by exactI colimit_cocone_comp F_obj @F_hom X Y f))
  (is_colimit : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → bicompletion_aux 𝒞 ff)
   (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → bicompletion_aux 𝒞 tt) (cocone_obj : bicompletion_aux 𝒞 ff)
   (cocone : 𝒟 → bicompletion_aux 𝒞 tt),
     (Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f)) →
     (Π (X : 𝒟), motive (cocone X)) → motive (by exactI is_colimit F_obj @F_hom cocone_obj cocone)) :
  motive f :=
have ∀ b (f : bicompletion_aux 𝒞 b) (h : b = tt), motive (eq.rec_on h f) :=
  begin
    intros b f,
    refine bicompletion_aux.rec_on f _ _ _ _ _ _ _ _,
    { intros, simp at *, contradiction },
    { intros, simp at *, contradiction },
    { intros, simp at *, contradiction },
    { intros X Y f _,
      exact of_cat_hom f },
    { introsI 𝒟 _ F_obj F_hom X Y f ih₁ ih₂ ih₃ ih₄ _,
      exact limit_cone_comp F_obj @F_hom X Y f (λ X Y f, ih₂ f rfl) (ih₄ rfl) },
    { introsI 𝒟 _ F_obj F_hom cone_obj cone ih₁ ih₂ ih₃ ih₄ _,
      exact is_limit F_obj @F_hom cone_obj cone (λ X Y f, ih₂ f rfl) (λ X, ih₄ X rfl) },
    { introsI 𝒟 _ F_obj F_hom X Y f ih₁ ih₂ ih₃ ih₄ _,
      exact colimit_cocone_comp F_obj @F_hom X Y f (λ X Y f, ih₂ f rfl) (ih₄ rfl) },
    { introsI 𝒟 _ F_obj F_hom cone_obj cone ih₁ ih₂ ih₃ ih₄ _,
      exact is_colimit F_obj @F_hom cone_obj cone (λ X Y f, ih₂ f rfl) (λ X, ih₄ X rfl) },
  end,
this tt f rfl

inductive valid_hom₁ : Π {X Y : obj₁ 𝒞}, hom₁ X Y → Prop
| of_cat_hom {X Y : 𝒞} (f : X ⟶ Y) : valid_hom₁ (of_cat_hom₁ f)
| id (X : obj₁ 𝒞) : valid_hom₁ (id₁ X)
| limit_cone_comp {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₁ 𝒞)
  (obj_valid : ∀ X, valid_obj₁ (F_obj X))
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (X : 𝒟) {Y : obj₁ 𝒞} (f : hom₁ (F_obj X) Y)
  (F_hom_valid : Π {X Y : 𝒟} (f : X ⟶ Y), valid_hom₁ (F_hom f))
  (f_valid : valid_hom₁ f) :
  valid_hom₁ (limit_cone_comp₁ F_obj @F_hom X f)
| colimit_cocone_comp {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₁ 𝒞)
  (obj_valid : ∀ X, valid_obj₁ (F_obj X))
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (X : 𝒟) {Y : obj₁ 𝒞} (f : hom₁ Y (F_obj X))
  (F_hom_valid : Π {X Y : 𝒟} (f : X ⟶ Y), valid_hom₁ (F_hom f))
  (f_valid : valid_hom₁ f) :
  valid_hom₁ (colimit_cocone_comp₁ F_obj @F_hom X f)
| is_limit {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₁ 𝒞)
  (obj_valid : ∀ X, valid_obj₁ (F_obj X))
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (cone_obj : obj₁ 𝒞)
  (cone : Π (X : 𝒟), hom₁ cone_obj (F_obj X))
  (F_hom_valid : Π {X Y : 𝒟} (f : X ⟶ Y), valid_hom₁ (F_hom f))
  (cone_valid : Π (X : 𝒟), valid_hom₁ (cone X)) :
  valid_hom₁ (is_limit₁ F_obj @F_hom cone_obj cone)
| is_colimit {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₁ 𝒞)
  (obj_valid : ∀ X, valid_obj₁ (F_obj X))
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₁ (F_obj X) (F_obj Y))
  (cocone_obj : obj₁ 𝒞)
  (cocone : Π (X : 𝒟), hom₁ (F_obj X) cocone_obj)
  (F_hom_valid : Π {X Y : 𝒟} (f : X ⟶ Y), valid_hom₁ (F_hom f))
  (cocone_valid : Π (X : 𝒟), valid_hom₁ (cocone X)) :
  valid_hom₁ (is_colimit₁ F_obj @F_hom cocone_obj cocone)

variable (𝒞)

def obj₂ : Type 1 := { X : obj₁ 𝒞 // valid_obj₁ X }

variable {𝒞}

def hom₂ (X Y : obj₂ 𝒞) : Type 1 := { f : hom₁ X.1 Y.1 // valid_hom₁ f }

open valid_hom₁

def of_cat_obj₂ (X : 𝒞) : obj₂ 𝒞 :=
⟨of_cat_obj X, valid_obj₁.of_cat_obj _⟩

lemma of_cat_obj₂_injective : function.injective (@of_cat_obj₂ 𝒞 _) :=
begin
  intros X Y hXY,
  simp [of_cat_obj₂] at hXY,
  injection hXY,
end

def limit_obj₂ (F_obj : 𝒟 → obj₂ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)) : obj₂ 𝒞 :=
⟨limit_obj₁ (λ X, (F_obj X).1) (λ X Y f, (F_hom f).1), valid_obj₁.limit_obj _ _ (λ X, (F_obj X).2)⟩

lemma limit_obj₂_injective {𝒟₁ 𝒟₂ : Type} [i₁ : category 𝒟₁] [i₂ : category 𝒟₂]
  {F_obj₁ : 𝒟₁ → obj₂ 𝒞} {F_obj₂ : 𝒟₂ → obj₂ 𝒞}
  {F_hom₁ : Π {X Y : 𝒟₁}, (X ⟶ Y) → hom₂ (F_obj₁ X) (F_obj₁ Y)}
  {F_hom₂ : Π {X Y : 𝒟₂}, (X ⟶ Y) → hom₂ (F_obj₂ X) (F_obj₂ Y)}
  (h : limit_obj₂ F_obj₁ @F_hom₁ = limit_obj₂ F_obj₂ @F_hom₂) :
  𝒟₁ = 𝒟₂ ∧ i₁ == i₂ ∧ F_obj₁ == F_obj₂ ∧ @F_hom₁ == @F_hom₂ :=
begin
  simp [limit_obj₂, limit_obj₁] at h,
  injection h with h₁ h₂ h₃ h₄,
  unfreezingI { subst h₁ },
  rw heq_iff_eq at h₂,
  unfreezingI { subst h₂ },
  simp [heq_iff_eq, function.funext_iff, subtype.coe_injective.eq_iff] at h₃,
  rw [← function.funext_iff] at h₃,
  dsimp at h₃,
  subst h₃,
  simp [heq_iff_eq, function.funext_iff, subtype.coe_injective.eq_iff] at h₄,
  simp,
  ext,
  simp *
end

def colimit_obj₂ (F_obj : 𝒟 → obj₂ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)) : obj₂ 𝒞 :=
⟨colimit_obj₁ (λ X, (F_obj X).1) (λ X Y f, (F_hom f).1), valid_obj₁.colimit_obj _ _ (λ X, (F_obj X).2)⟩

lemma colimit_obj₂_injective {𝒟₁ 𝒟₂ : Type} [i₁ : category 𝒟₁] [i₂ : category 𝒟₂]
  {F_obj₁ : 𝒟₁ → obj₂ 𝒞} {F_obj₂ : 𝒟₂ → obj₂ 𝒞}
  {F_hom₁ : Π {X Y : 𝒟₁}, (X ⟶ Y) → hom₂ (F_obj₁ X) (F_obj₁ Y)}
  {F_hom₂ : Π {X Y : 𝒟₂}, (X ⟶ Y) → hom₂ (F_obj₂ X) (F_obj₂ Y)}
  (h : colimit_obj₂ F_obj₁ @F_hom₁ = colimit_obj₂ F_obj₂ @F_hom₂) :
  𝒟₁ = 𝒟₂ ∧ i₁ == i₂ ∧ F_obj₁ == F_obj₂ ∧ @F_hom₁ == @F_hom₂ :=
begin
  simp [colimit_obj₂, colimit_obj₁] at h,
  injection h with h₁ h₂ h₃ h₄,
  unfreezingI { subst h₁ },
  rw heq_iff_eq at h₂,
  unfreezingI { subst h₂ },
  simp [heq_iff_eq, function.funext_iff, subtype.coe_injective.eq_iff] at h₃,
  rw [← function.funext_iff] at h₃,
  dsimp at h₃,
  subst h₃,
  simp [heq_iff_eq, function.funext_iff, subtype.coe_injective.eq_iff] at h₄,
  simp,
  ext,
  simp *
end

def of_cat_hom₂ {X Y : 𝒞} (f : X ⟶ Y) : hom₂ (of_cat_obj₂ X) (of_cat_obj₂ Y) :=
⟨of_cat_hom₁ f, valid_hom₁.of_cat_hom _⟩

def limit_cone_comp₂ (F_obj : 𝒟 → obj₂ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)) (X : 𝒟)
  {Y : obj₂ 𝒞} (f : hom₂ (F_obj X) Y) :
  hom₂ (limit_obj₂ F_obj @F_hom) Y :=
⟨limit_cone_comp₁ (λ X, (F_obj X).1) (λ X Y f, (F_hom f).1) X f.1,
  valid_hom₁.limit_cone_comp _ (λ X, (F_obj X).2) _ _ _ (λ X Y f, (F_hom f).2) f.2⟩

def colimit_cocone_comp₂ (F_obj : 𝒟 → obj₂ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)) (X : 𝒟)
  {Y : obj₂ 𝒞} (f : hom₂ Y (F_obj X)):
  hom₂ Y (colimit_obj₂ F_obj @F_hom) :=
⟨colimit_cocone_comp₁ (λ X, (F_obj X).1) (λ X Y f, (F_hom f).1) X f.1,
  valid_hom₁.colimit_cocone_comp _ (λ X, (F_obj X).2) _ _ _ (λ X Y f, (F_hom f).2) f.2⟩

def is_limit₂ (F_obj : 𝒟 → obj₂ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
  (cone_obj : obj₂ 𝒞)
  (cone : Π (X : 𝒟), hom₂ cone_obj (F_obj X)) :
  hom₂ cone_obj (limit_obj₂ F_obj @F_hom) :=
⟨is_limit₁ (λ X, (F_obj X).1) (λ X Y f, (F_hom f).1) cone_obj.1 (λ X, (cone X).1),
  valid_hom₁.is_limit _ (λ X, (F_obj X).2) _ _ _ (λ X Y f, (F_hom f).2) (λ X, (cone X).2)⟩

def is_colimit₂ (F_obj : 𝒟 → obj₂ 𝒞)
  (F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
  (cocone_obj : obj₂ 𝒞)
  (cocone : Π (X : 𝒟), hom₂ (F_obj X) cocone_obj) :
  hom₂ (colimit_obj₂ F_obj @F_hom) cocone_obj  :=
⟨is_colimit₁ (λ X, (F_obj X).1) (λ X Y f, (F_hom f).1) cocone_obj.1 (λ X, (cocone X).1),
  valid_hom₁.is_colimit _ (λ X, (F_obj X).2) _ _ _ (λ X Y f, (F_hom f).2) (λ X, (cocone X).2)⟩

-- @[elab_as_eliminator] def rec₂_aux
--   {obj_motive : obj₂ 𝒞 → Sort u}
--   {hom_motive : Π {X Y : obj₂ 𝒞}, obj_motive X → obj_motive Y → hom₂ X Y → Sort v}
--   (of_cat_obj : Π (X : 𝒞), obj_motive (of_cat_obj₂ X))
--   (limit_obj : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
--     (ih_F_obj : Π (X : 𝒟), obj_motive (F_obj X))
--     (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
--     (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y),
--       hom_motive (ih_F_obj X) (ih_F_obj Y) (F_hom f)),
--     by exactI obj_motive (limit_obj₂ F_obj @F_hom))
--   (colimit_obj : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
--     (ih_F_obj : Π (X : 𝒟), obj_motive (F_obj X))
--     (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
--     (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y),
--       hom_motive (ih_F_obj X) (ih_F_obj Y) (F_hom f)),
--     by exactI obj_motive (colimit_obj₂ F_obj @F_hom))
--   (of_cat_hom : Π {X Y : 𝒞} (f : X ⟶ Y),
--     hom_motive (of_cat_obj X) (of_cat_obj Y) (of_cat_hom₂ f))
--   (limit_cone_comp : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
--     (ih_F_obj : Π (X : 𝒟), obj_motive (F_obj X))
--     (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
--     (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y),
--       hom_motive (ih_F_obj X) (ih_F_obj Y) (F_hom f))
--     (X : 𝒟) {Y : obj₂ 𝒞} (ih_Y : obj_motive Y) (f : hom₂ (F_obj X) Y)
--     (ih_f : hom_motive (ih_F_obj X) ih_Y f),
--       by exactI hom_motive (limit_obj F_obj ih_F_obj @F_hom @ih_F_hom) ih_Y
--         (by exactI limit_cone_comp₂ F_obj @F_hom X f))
--   (colimit_cocone_comp : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
--     (ih_F_obj : Π (X : 𝒟), obj_motive (F_obj X))
--     (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
--     (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y),
--       hom_motive (ih_F_obj X) (ih_F_obj Y) (F_hom f))
--     (X : 𝒟) {Y : obj₂ 𝒞} (ih_Y : obj_motive Y) (f : hom₂ Y (F_obj X))
--     (ih_f : hom_motive ih_Y (ih_F_obj X) f),
--       by exactI hom_motive ih_Y (colimit_obj F_obj ih_F_obj @F_hom @ih_F_hom)
--         (by exactI colimit_cocone_comp₂ F_obj @F_hom X f))
--   (is_limit : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
--     (ih_F_obj : Π (X : 𝒟), obj_motive (F_obj X))
--     (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
--     (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y),
--       hom_motive (ih_F_obj X) (ih_F_obj Y) (F_hom f))
--     (cone_obj : obj₂ 𝒞) (ih_cone_obj : obj_motive cone_obj)
--     (cone : Π (X : 𝒟), hom₂ cone_obj (F_obj X))
--     (ih_cone : Π (X : 𝒟), hom_motive ih_cone_obj (ih_F_obj X) (cone X)),
--       by exactI hom_motive ih_cone_obj (limit_obj F_obj ih_F_obj @F_hom @ih_F_hom)
--         (by exactI is_limit₂ F_obj @F_hom cone_obj cone))
--   (is_colimit : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
--     (ih_F_obj : Π (X : 𝒟), obj_motive (F_obj X))
--     (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
--     (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y),
--       hom_motive (ih_F_obj X) (ih_F_obj Y) (F_hom f))
--     (cocone_obj : obj₂ 𝒞) (ih_cocone_obj : obj_motive cocone_obj)
--     (cocone : Π (X : 𝒟), hom₂ (F_obj X) cocone_obj)
--     (ih_cocone : Π (X : 𝒟), hom_motive (ih_F_obj X) ih_cocone_obj (cocone X)),
--       by exactI hom_motive (colimit_obj F_obj ih_F_obj @F_hom @ih_F_hom) ih_cocone_obj
--         (is_colimit₂ F_obj @F_hom cocone_obj cocone))
--   (b : bool) (f : bicompletion_aux 𝒞 b) :
--   pprod (∀ (h : b = ff), let f' : bicompletion_aux 𝒞 ff := eq.rec_on h f in
--     ∀ (hv : valid_obj₁ f'), obj_motive ⟨f', hv⟩)
--   (∀ h : b = tt, let f' : bicompletion_aux 𝒞 tt := eq.rec_on h f in
--     ∀ (hv : valid_hom₁ ⟨f', rfl, rfl⟩)
--     (hv₁ : valid_obj₁ f'.dom)
--     (hv₂ : valid_obj₁ f'.cod)
--     (h₁ : obj_motive ⟨f'.dom, hv₁⟩)
--     (h₂ : obj_motive ⟨f'.cod, hv₂⟩),
--     hom_motive h₁ h₂ ⟨⟨f', rfl, rfl⟩, hv⟩) :=
-- begin
--   refine bicompletion_aux.rec_on f _ _ _ _ _ _ _ _,
--   { intros X,
--     exact ⟨λ _ hX, of_cat_obj X, λ _, by contradiction⟩ },
--   { introsI 𝒟 _ F_obj F_hom ih₁ ih₂,
--     refine ⟨λ _ hv, _, λ _, by contradiction⟩,
--     dsimp at *,
--     have valid_F_obj : ∀ X, valid_obj₁ (F_obj X),
--     { cases hv, assumption },
--     let F_obj' : 𝒟 → obj₂ 𝒞 := λ X, ⟨F_obj X, valid_F_obj X⟩,
--     have valid_F_hom : ∀ X Y f,
--       ∃ (h₁ : (@F_hom X Y f).dom = F_obj X)
--       (h₂ : (@F_hom X Y f).cod = F_obj Y),
--       valid_hom₁ ⟨@F_hom X Y f, h₁, h₂⟩,
--     { cases hv, simp,  },
--     let F_hom' : Π (X Y : 𝒟) (f : X ⟶ Y), hom₂ (F_obj' X) (F_obj' Y) :=
--       λ X Y f, ⟨⟨@F_hom X Y f, (valid_F_hom X Y f).fst, (valid_F_hom X Y f).snd.fst⟩,
--         (valid_F_hom X Y f).snd.snd⟩,
--     have := limit_obj F_obj' F_hom' _ _
--      },
--   { intros A B f X Y hX hY hfd hfc hf,
--     dsimp at hfd hfc, substs hfc hfd,
--     exact of_cat_hom f },
--   { introsI 𝒟 _ F_obj F_hom A B g ih₁ ih₂ X Y hX hY hfd hfc hf,
--     dsimp at hfd hfc, substs hfc hfd,
--     have valid_F_obj : ∀ X, valid_obj₁ (F_obj X),
--     { cases hf, assumption },
--     let F_obj' : 𝒟 → obj₂ 𝒞 := λ X, ⟨F_obj X, valid_F_obj X⟩,
--     have valid_F_hom : ∀ X Y f,
--       ∃ (h₁ : (@F_hom X Y f).dom = F_obj X)
--       (h₂ : (@F_hom X Y f).cod = F_obj Y),
--       valid_hom₁ ⟨@F_hom X Y f, h₁, h₂⟩,
--     { cases hf, simpa },
--      let F_hom' : Π (X Y : 𝒟) (f : X ⟶ Y), hom₂ (F_obj' X) (F_obj' Y) :=
--       λ X Y f, ⟨⟨@F_hom X Y f, (valid_F_hom X Y f).fst, (valid_F_hom X Y f).snd.fst⟩,
--         (valid_F_hom X Y f).snd.snd⟩,
--     have valid_g :
--       ∃ (h₁ : g.dom = F_obj A) (h₂ : g.cod = B),
--       valid_hom₁ ⟨g, h₁, h₂⟩,
--     { cases hf, simpa },
--     let g' : hom₂ (F_obj' A) ⟨B, hY⟩ :=
--       ⟨⟨g, valid_g.fst, valid_g.snd.fst⟩, valid_g.snd.snd⟩,
--     exact limit_cone_comp F_obj' F_hom'
--       (λ X Y f, ih₁ f (F_obj X) (F_obj Y) (valid_F_obj _) (valid_F_obj _)
--           (valid_F_hom _ _ f).fst (valid_F_hom _ _ f).snd.fst
--           (valid_F_hom _ _ f).snd.snd) A g'
--           (ih₂ (F_obj' A).1 B (F_obj' A).2 hY g'.1.2.1 g'.1.2.2 g'.2) },
--     { introsI 𝒟 _ F_obj F_hom cone_obj cone ih₁ ih₂ X Y hX hY hfd hfc hf,
--       dsimp at hfd hfc,
--       substs hfc hfd,
--       have valid_F_obj : ∀ X, valid_obj₁ (F_obj X),
--       { cases hf, assumption },
--       let F_obj' : 𝒟 → obj₂ 𝒞 := λ X, ⟨F_obj X, valid_F_obj X⟩,
--       have valid_F_hom : ∀ X Y f,
--         ∃ (h₁ : (@F_hom X Y f).dom = F_obj X)
--         (h₂ : (@F_hom X Y f).cod = F_obj Y),
--         valid_hom₁ ⟨@F_hom X Y f, h₁, h₂⟩,
--       { cases hf, simpa },
--       let F_hom' : Π (X Y : 𝒟) (f : X ⟶ Y), hom₂ (F_obj' X) (F_obj' Y) :=
--         λ X Y f, ⟨⟨@F_hom X Y f, (valid_F_hom X Y f).fst, (valid_F_hom X Y f).snd.fst⟩,
--           (valid_F_hom X Y f).snd.snd⟩,
--       let cone_obj' : obj₂ 𝒞 := ⟨cone_obj, hX⟩,
--       have valid_cone : ∀ (X : 𝒟), ∃ (h₁ : (cone X).dom = cone_obj'.1)
--         (h₂ : (cone X).cod = (F_obj' X).1),
--         valid_hom₁ ⟨cone X, h₁, h₂⟩,
--       { cases hf, simpa },
--       let cone' : Π (X : 𝒟), hom₂ cone_obj' (F_obj' X) :=
--         λ X, ⟨⟨cone X, (valid_cone X).fst, (valid_cone X).snd.fst⟩, (valid_cone X).snd.snd⟩,
--       exact is_limit F_obj' F_hom'
--         (λ A B f, ih₁ f (F_obj A) (F_obj B) (F_obj' A).2 (F_obj' B).2
--           (valid_F_hom _ _ f).fst (valid_F_hom _ _ f).snd.fst
--           (valid_F_hom _ _ f).snd.snd)
--           cone_obj' cone'
--           (λ X, ih₂ X cone_obj'.1 (F_obj' X).1 cone_obj'.2 (F_obj' X).2
--               (cone' X).1.2.1 (cone' X).1.2.2 (cone' X).2) },
--     { introsI 𝒟 _ F_obj F_hom A B g ih₁ ih₂ X Y hX hY hfd hfc hf,
--       dsimp at hfd hfc, substs hfc hfd,
--       have valid_F_obj : ∀ X, valid_obj₁ (F_obj X),
--       { cases hf, assumption },
--       let F_obj' : 𝒟 → obj₂ 𝒞 := λ X, ⟨F_obj X, valid_F_obj X⟩,
--       have valid_F_hom : ∀ X Y f,
--         ∃ (h₁ : (@F_hom X Y f).dom = F_obj X)
--         (h₂ : (@F_hom X Y f).cod = F_obj Y),
--         valid_hom₁ ⟨@F_hom X Y f, h₁, h₂⟩,
--       { cases hf, simpa },
--       have valid_g :
--         ∃ (h₁ : g.dom = B) (h₂ : g.cod = F_obj A),
--         valid_hom₁ ⟨g, h₁, h₂⟩,
--       { cases hf, simpa },
--       let g' : hom₂ ⟨B, hX⟩ (F_obj' A) :=
--         ⟨⟨g, valid_g.fst, valid_g.snd.fst⟩, valid_g.snd.snd⟩,
--       let F_hom' : Π (X Y : 𝒟) (f : X ⟶ Y), hom₂ (F_obj' X) (F_obj' Y) :=
--         λ X Y f, ⟨⟨@F_hom X Y f, (valid_F_hom X Y f).fst, (valid_F_hom X Y f).snd.fst⟩,
--           (valid_F_hom X Y f).snd.snd⟩,
--       exact colimit_cocone_comp F_obj' F_hom'
--         (λ X Y f, ih₁ f (F_obj X) (F_obj Y) (valid_F_obj _) (valid_F_obj _)
--             (valid_F_hom _ _ f).fst (valid_F_hom _ _ f).snd.fst
--             (valid_F_hom _ _ f).snd.snd) A g'
--             (ih₂ B (F_obj' A).1 hX (F_obj' A).2 g'.1.2.1 g'.1.2.2 g'.2) },
--     { introsI 𝒟 _ F_obj F_hom cocone_obj cocone ih₁ ih₂ X Y hX hY hfd hfc hf,
--       dsimp at hfd hfc,
--       substs hfc hfd,
--       have valid_F_obj : ∀ X, valid_obj₁ (F_obj X),
--       { cases hf, assumption },
--       let F_obj' : 𝒟 → obj₂ 𝒞 := λ X, ⟨F_obj X, valid_F_obj X⟩,
--       have valid_F_hom : ∀ X Y f,
--         ∃ (h₁ : (@F_hom X Y f).dom = F_obj X)
--         (h₂ : (@F_hom X Y f).cod = F_obj Y),
--         valid_hom₁ ⟨@F_hom X Y f, h₁, h₂⟩,
--       { cases hf, simpa },
--       let F_hom' : Π (X Y : 𝒟) (f : X ⟶ Y), hom₂ (F_obj' X) (F_obj' Y) :=
--         λ X Y f, ⟨⟨@F_hom X Y f, (valid_F_hom X Y f).fst, (valid_F_hom X Y f).snd.fst⟩,
--           (valid_F_hom X Y f).snd.snd⟩,
--       let cocone_obj' : obj₂ 𝒞 := ⟨cocone_obj, hY⟩,
--       have valid_cocone : ∀ (X : 𝒟), ∃ (h₁ : (cocone X).dom = (F_obj' X).1)
--         (h₂ : (cocone X).cod = cocone_obj'.1),
--         valid_hom₁ ⟨cocone X, h₁, h₂⟩,
--       { cases hf, simpa },
--       let cocone' : Π (X : 𝒟), hom₂ (F_obj' X) cocone_obj' :=
--         λ X, ⟨⟨cocone X, (valid_cocone X).fst, (valid_cocone X).snd.fst⟩, (valid_cocone X).snd.snd⟩,
--       exact is_colimit F_obj' F_hom'
--         (λ A B f, ih₁ f (F_obj A) (F_obj B) (F_obj' A).2 (F_obj' B).2
--           (valid_F_hom _ _ f).fst (valid_F_hom _ _ f).snd.fst
--           (valid_F_hom _ _ f).snd.snd)
--           cocone_obj' cocone'
--           (λ X, ih₂ X (F_obj' X).1 cocone_obj'.1 (F_obj' X).2 cocone_obj'.2
--               (cocone' X).1.2.1 (cocone' X).1.2.2 (cocone' X).2) }
-- end

-- @[elab_as_eliminator] protected def rec_on₂
--   {obj_motive : obj₂ 𝒞 → Sort u}
--   {hom_motive : Π {X Y : obj₂ 𝒞}, obj_motive X → obj_motive Y → hom₂ X Y → Sort v}
--   (of_cat_obj : Π (X : 𝒞), obj_motive (of_cat_obj₂ X))
--   (limit_obj : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
--     (ih_F_obj : Π (X : 𝒟), obj_motive (F_obj X))
--     (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
--     (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y),
--       hom_motive (ih_F_obj X) (ih_F_obj Y) (F_hom f)),
--     by exactI obj_motive (limit_obj₂ F_obj @F_hom))
--   (colimit_obj : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
--     (ih_F_obj : Π (X : 𝒟), obj_motive (F_obj X))
--     (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
--     (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y),
--       hom_motive (ih_F_obj X) (ih_F_obj Y) (F_hom f)),
--     by exactI obj_motive (colimit_obj₂ F_obj @F_hom))
--   (of_cat_hom : Π {X Y : 𝒞} (f : X ⟶ Y),
--     hom_motive (of_cat_obj X) (of_cat_obj Y) (of_cat_hom₂ f))
--   (limit_cone_comp : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
--     (ih_F_obj : Π (X : 𝒟), obj_motive (F_obj X))
--     (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
--     (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y),
--       hom_motive (ih_F_obj X) (ih_F_obj Y) (F_hom f))
--     (X : 𝒟) {Y : obj₂ 𝒞} (ih_Y : obj_motive Y) (f : hom₂ (F_obj X) Y)
--     (ih_f : hom_motive (ih_F_obj X) ih_Y f),
--       by exactI hom_motive (limit_obj F_obj ih_F_obj @F_hom @ih_F_hom) ih_Y
--         (by exactI limit_cone_comp₂ F_obj @F_hom X f))
--   (colimit_cocone_comp : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
--     (ih_F_obj : Π (X : 𝒟), obj_motive (F_obj X))
--     (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
--     (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y),
--       hom_motive (ih_F_obj X) (ih_F_obj Y) (F_hom f))
--     (X : 𝒟) {Y : obj₂ 𝒞} (ih_Y : obj_motive Y) (f : hom₂ Y (F_obj X))
--     (ih_f : hom_motive ih_Y (ih_F_obj X) f),
--       by exactI hom_motive ih_Y (colimit_obj F_obj ih_F_obj @F_hom @ih_F_hom)
--         (by exactI colimit_cocone_comp₂ F_obj @F_hom X f))
--   (is_limit : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
--     (ih_F_obj : Π (X : 𝒟), obj_motive (F_obj X))
--     (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
--     (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y),
--       hom_motive (ih_F_obj X) (ih_F_obj Y) (F_hom f))
--     (cone_obj : obj₂ 𝒞) (ih_cone_obj : obj_motive cone_obj)
--     (cone : Π (X : 𝒟), hom₂ cone_obj (F_obj X))
--     (ih_cone : Π (X : 𝒟), hom_motive ih_cone_obj (ih_F_obj X) (cone X)),
--       by exactI hom_motive ih_cone_obj (limit_obj F_obj ih_F_obj @F_hom @ih_F_hom)
--         (by exactI is_limit₂ F_obj @F_hom cone_obj cone))
--   (is_colimit : Π {𝒟 : Type} [category.{0} 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
--     (ih_F_obj : Π (X : 𝒟), obj_motive (F_obj X))
--     (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
--     (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y),
--       hom_motive (ih_F_obj X) (ih_F_obj Y) (F_hom f))
--     (cocone_obj : obj₂ 𝒞) (ih_cocone_obj : obj_motive cocone_obj)
--     (cocone : Π (X : 𝒟), hom₂ (F_obj X) cocone_obj)
--     (ih_cocone : Π (X : 𝒟), hom_motive (ih_F_obj X) ih_cocone_obj (cocone X)),
--       by exactI hom_motive (colimit_obj F_obj ih_F_obj @F_hom @ih_F_hom) ih_cocone_obj
--         (is_colimit₂ F_obj @F_hom cocone_obj cocone)) :
--   Σ' (obj_h : Π (X : obj₂ 𝒞), obj_motive X), Π (X Y : obj₂ 𝒞) (f : hom₂ X Y),
--     hom_motive (obj_h X) (obj_h Y) f :=
-- begin
--   have := @rec₂_aux 𝒞 _ @obj_motive @hom_motive
--       @of_cat_obj @limit_obj @colimit_obj
--       @of_cat_hom @limit_cone_comp @colimit_cocone_comp
--       @is_limit @is_colimit,
--    have obj_h : ∀ X, obj_motive X,
--   { intro X,
--     cases X with X hX, exact (this ff X).1 rfl hX },
--   split,
--   swap,
--   { exact obj_h },
--   { intros X Y f,
--     cases X with X hX,
--     cases Y with Y hY,
--     rcases f with ⟨⟨f, hf₁, hf₂⟩, hf⟩,
--     dsimp at hf₁ hf₂, substs hf₁ hf₂,
--     exact (this tt f).2 rfl hf hX hY (obj_h _) (obj_h _) }
-- end

@[elab_as_eliminator] protected def hom₂.rec_on
  {motive : Π {X Y : obj₂ 𝒞} (f : hom₂ X Y), Sort*} {X Y : obj₂ 𝒞} (f : hom₂ X Y)
  (of_cat_hom : Π {X Y : 𝒞} (f : X ⟶ Y), motive (of_cat_hom₂ f))
  (limit_cone_comp : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f))
    (X : 𝒟) {Y : obj₂ 𝒞} (f : hom₂ (F_obj X) Y)
    (ih_f : motive f),
      motive (by exactI limit_cone_comp₂ F_obj @F_hom X f))
  (colimit_cocone_comp : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f))
    (X : 𝒟) {Y : obj₂ 𝒞} (f : hom₂ Y (F_obj X))
    (ih_f : motive f),
      motive (by exactI colimit_cocone_comp₂ F_obj @F_hom X f))
  (is_limit : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f))
    (cone_obj : obj₂ 𝒞) (cone : Π (X : 𝒟), hom₂ cone_obj (F_obj X))
    (ih_cone : Π (X : 𝒟), motive (cone X)),
      motive (by exactI is_limit₂ F_obj @F_hom cone_obj cone))
  (is_colimit : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (ih_F_hom : Π {X Y : 𝒟} (f : by exactI X ⟶ Y), motive (F_hom f))
    (cocone_obj : obj₂ 𝒞) (cocone : Π (X : 𝒟), hom₂ (F_obj X) cocone_obj)
    (ih_cone : Π (X : 𝒟), motive (cocone X)),
      motive (by exactI is_colimit₂ F_obj @F_hom cocone_obj cocone)) :
  motive f :=
begin
  cases X with X hX, cases Y with Y hY,
  cases f with f hf,
  rcases f with ⟨f, hfd, hfc⟩,
  revert X Y hX hY,
  refine hom_rec_on f _ _ _ _ _,
  { intros A B f X Y hX hY hfd hfc hf,
    dsimp at hfd hfc, substs hfc hfd,
    exact of_cat_hom f },
  { introsI 𝒟 _ F_obj F_hom A B g ih₁ ih₂ X Y hX hY hfd hfc hf,
    dsimp at hfd hfc, substs hfc hfd,
    have valid_F_obj : ∀ X, valid_obj₁ (F_obj X),
    { cases hf, assumption },
    let F_obj' : 𝒟 → obj₂ 𝒞 := λ X, ⟨F_obj X, valid_F_obj X⟩,
    have valid_F_hom : ∀ X Y f,
      ∃ (h₁ : (@F_hom X Y f).dom = F_obj X)
      (h₂ : (@F_hom X Y f).cod = F_obj Y),
      valid_hom₁ ⟨@F_hom X Y f, h₁, h₂⟩,
    { cases hf, simpa },
     let F_hom' : Π (X Y : 𝒟) (f : X ⟶ Y), hom₂ (F_obj' X) (F_obj' Y) :=
      λ X Y f, ⟨⟨@F_hom X Y f, (valid_F_hom X Y f).fst, (valid_F_hom X Y f).snd.fst⟩,
        (valid_F_hom X Y f).snd.snd⟩,
    have valid_g :
      ∃ (h₁ : g.dom = F_obj A) (h₂ : g.cod = B),
      valid_hom₁ ⟨g, h₁, h₂⟩,
    { cases hf, simpa },
    let g' : hom₂ (F_obj' A) ⟨B, hY⟩ :=
      ⟨⟨g, valid_g.fst, valid_g.snd.fst⟩, valid_g.snd.snd⟩,
    exact limit_cone_comp F_obj' F_hom'
      (λ X Y f, ih₁ f (F_obj X) (F_obj Y) (valid_F_obj _) (valid_F_obj _)
          (valid_F_hom _ _ f).fst (valid_F_hom _ _ f).snd.fst
          (valid_F_hom _ _ f).snd.snd) A g'
          (ih₂ (F_obj' A).1 B (F_obj' A).2 hY g'.1.2.1 g'.1.2.2 g'.2) },
    { introsI 𝒟 _ F_obj F_hom cone_obj cone ih₁ ih₂ X Y hX hY hfd hfc hf,
      dsimp at hfd hfc,
      substs hfc hfd,
      have valid_F_obj : ∀ X, valid_obj₁ (F_obj X),
      { cases hf, assumption },
      let F_obj' : 𝒟 → obj₂ 𝒞 := λ X, ⟨F_obj X, valid_F_obj X⟩,
      have valid_F_hom : ∀ X Y f,
        ∃ (h₁ : (@F_hom X Y f).dom = F_obj X)
        (h₂ : (@F_hom X Y f).cod = F_obj Y),
        valid_hom₁ ⟨@F_hom X Y f, h₁, h₂⟩,
      { cases hf, simpa },
      let F_hom' : Π (X Y : 𝒟) (f : X ⟶ Y), hom₂ (F_obj' X) (F_obj' Y) :=
        λ X Y f, ⟨⟨@F_hom X Y f, (valid_F_hom X Y f).fst, (valid_F_hom X Y f).snd.fst⟩,
          (valid_F_hom X Y f).snd.snd⟩,
      let cone_obj' : obj₂ 𝒞 := ⟨cone_obj, hX⟩,
      have valid_cone : ∀ (X : 𝒟), ∃ (h₁ : (cone X).dom = cone_obj'.1)
        (h₂ : (cone X).cod = (F_obj' X).1),
        valid_hom₁ ⟨cone X, h₁, h₂⟩,
      { cases hf, simpa },
      let cone' : Π (X : 𝒟), hom₂ cone_obj' (F_obj' X) :=
        λ X, ⟨⟨cone X, (valid_cone X).fst, (valid_cone X).snd.fst⟩, (valid_cone X).snd.snd⟩,
      exact is_limit F_obj' F_hom'
        (λ A B f, ih₁ f (F_obj A) (F_obj B) (F_obj' A).2 (F_obj' B).2
          (valid_F_hom _ _ f).fst (valid_F_hom _ _ f).snd.fst
          (valid_F_hom _ _ f).snd.snd)
          cone_obj' cone'
          (λ X, ih₂ X cone_obj'.1 (F_obj' X).1 cone_obj'.2 (F_obj' X).2
              (cone' X).1.2.1 (cone' X).1.2.2 (cone' X).2) },
    { introsI 𝒟 _ F_obj F_hom A B g ih₁ ih₂ X Y hX hY hfd hfc hf,
      dsimp at hfd hfc, substs hfc hfd,
      have valid_F_obj : ∀ X, valid_obj₁ (F_obj X),
      { cases hf, assumption },
      let F_obj' : 𝒟 → obj₂ 𝒞 := λ X, ⟨F_obj X, valid_F_obj X⟩,
      have valid_F_hom : ∀ X Y f,
        ∃ (h₁ : (@F_hom X Y f).dom = F_obj X)
        (h₂ : (@F_hom X Y f).cod = F_obj Y),
        valid_hom₁ ⟨@F_hom X Y f, h₁, h₂⟩,
      { cases hf, simpa },
      have valid_g :
        ∃ (h₁ : g.dom = B) (h₂ : g.cod = F_obj A),
        valid_hom₁ ⟨g, h₁, h₂⟩,
      { cases hf, simpa },
      let g' : hom₂ ⟨B, hX⟩ (F_obj' A) :=
        ⟨⟨g, valid_g.fst, valid_g.snd.fst⟩, valid_g.snd.snd⟩,
      let F_hom' : Π (X Y : 𝒟) (f : X ⟶ Y), hom₂ (F_obj' X) (F_obj' Y) :=
        λ X Y f, ⟨⟨@F_hom X Y f, (valid_F_hom X Y f).fst, (valid_F_hom X Y f).snd.fst⟩,
          (valid_F_hom X Y f).snd.snd⟩,
      exact colimit_cocone_comp F_obj' F_hom'
        (λ X Y f, ih₁ f (F_obj X) (F_obj Y) (valid_F_obj _) (valid_F_obj _)
            (valid_F_hom _ _ f).fst (valid_F_hom _ _ f).snd.fst
            (valid_F_hom _ _ f).snd.snd) A g'
            (ih₂ B (F_obj' A).1 hX (F_obj' A).2 g'.1.2.1 g'.1.2.2 g'.2) },
    { introsI 𝒟 _ F_obj F_hom cocone_obj cocone ih₁ ih₂ X Y hX hY hfd hfc hf,
      dsimp at hfd hfc,
      substs hfc hfd,
      have valid_F_obj : ∀ X, valid_obj₁ (F_obj X),
      { cases hf, assumption },
      let F_obj' : 𝒟 → obj₂ 𝒞 := λ X, ⟨F_obj X, valid_F_obj X⟩,
      have valid_F_hom : ∀ X Y f,
        ∃ (h₁ : (@F_hom X Y f).dom = F_obj X)
        (h₂ : (@F_hom X Y f).cod = F_obj Y),
        valid_hom₁ ⟨@F_hom X Y f, h₁, h₂⟩,
      { cases hf, simpa },
      let F_hom' : Π (X Y : 𝒟) (f : X ⟶ Y), hom₂ (F_obj' X) (F_obj' Y) :=
        λ X Y f, ⟨⟨@F_hom X Y f, (valid_F_hom X Y f).fst, (valid_F_hom X Y f).snd.fst⟩,
          (valid_F_hom X Y f).snd.snd⟩,
      let cocone_obj' : obj₂ 𝒞 := ⟨cocone_obj, hY⟩,
      have valid_cocone : ∀ (X : 𝒟), ∃ (h₁ : (cocone X).dom = (F_obj' X).1)
        (h₂ : (cocone X).cod = cocone_obj'.1),
        valid_hom₁ ⟨cocone X, h₁, h₂⟩,
      { cases hf, simpa },
      let cocone' : Π (X : 𝒟), hom₂ (F_obj' X) cocone_obj' :=
        λ X, ⟨⟨cocone X, (valid_cocone X).fst, (valid_cocone X).snd.fst⟩, (valid_cocone X).snd.snd⟩,
      exact is_colimit F_obj' F_hom'
        (λ A B f, ih₁ f (F_obj A) (F_obj B) (F_obj' A).2 (F_obj' B).2
          (valid_F_hom _ _ f).fst (valid_F_hom _ _ f).snd.fst
          (valid_F_hom _ _ f).snd.snd)
          cocone_obj' cocone'
          (λ X, ih₂ X (F_obj' X).1 cocone_obj'.1 (F_obj' X).2 cocone_obj'.2
              (cocone' X).1.2.1 (cocone' X).1.2.2 (cocone' X).2) }
end

def hom₂_of_cat_obj_rec_on
  {motive : Π {X : 𝒞} {Y : obj₂ 𝒞} (f : hom₂ (of_cat_obj₂ X) Y), Sort*}
  {X : 𝒞} {Y : obj₂ 𝒞} (f : hom₂ (of_cat_obj₂ X) Y)
  (of_cat_hom : Π {Y : 𝒞} (f : X ⟶ Y), motive (of_cat_hom₂ f))
  (colimit_cocone_comp : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (X : 𝒟) {Y : 𝒞} (f : hom₂ (of_cat_obj₂ Y) (F_obj X))
    (ih_f : motive f),
      motive (by exactI colimit_cocone_comp₂ F_obj @F_hom X f))
  (is_limit : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (cone_obj : 𝒞) (cone : Π (X : 𝒟), hom₂ (of_cat_obj₂ cone_obj) (F_obj X))
    (ih_cone : Π (X : 𝒟), motive (cone X)),
      motive (by exactI is_limit₂ F_obj @F_hom (of_cat_obj₂ cone_obj) cone)) :
  motive f :=
@hom₂.rec_on 𝒞 _ (λ A B f, ∀ (h : A = of_cat_obj₂ X),
  motive (show hom₂ (of_cat_obj₂ X) B, from eq.rec_on h f))
  (of_cat_obj₂ X) Y f
  (λ A B g h, begin
      have := of_cat_obj₂_injective h,
      subst this,
      dsimp,
      exact of_cat_hom g
    end)
  begin
    intros,
    simp [limit_obj₂, of_cat_obj₂, limit_obj₁] at h,
    contradiction
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ A B g ih₂ h,
    subst h,
    exact colimit_cocone_comp _ _ _ _ (ih₂ rfl)
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ cone_obj cone ih₂ h,
    subst h,
    exact is_limit _ _ _ _ (λ A, ih₂ A rfl),
  end
  begin
    intros,
    simp [colimit_obj₂, of_cat_obj₂] at h,
    contradiction
  end
  rfl

def hom₂_limit_obj_rec_on
  {motive : Π {𝒟 : Type} [category 𝒟] {F_obj : 𝒟 → obj₂ 𝒞}
    {F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)} {Y : obj₂ 𝒞},
    hom₂ (by exactI limit_obj₂ F_obj @F_hom) Y → Sort*}
  {𝒟 : Type} [category 𝒟] {F_obj : 𝒟 → obj₂ 𝒞}
  {F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)} {Y : obj₂ 𝒞}
  (f : hom₂ (limit_obj₂ F_obj @F_hom) Y)
  (limit_cone_comp : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (X : 𝒟) {Y : obj₂ 𝒞} (f : hom₂ (F_obj X) Y),
      by exactI motive (limit_cone_comp₂ F_obj @F_hom X f))
  (colimit_cocone_comp : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (X : 𝒟)
    {ℰ : Type} [category ℰ] (G_obj : ℰ → obj₂ 𝒞)
    (G_hom : Π {X Y : ℰ}, (by exactI X ⟶ Y) → hom₂ (G_obj X) (G_obj Y))
    (f : hom₂ (by exactI limit_obj₂ G_obj @G_hom) (F_obj X))
    (ih_f : by exactI motive f),
      by exactI motive (colimit_cocone_comp₂ F_obj @F_hom X f))
  (is_limit : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    {ℰ : Type} [category ℰ] (G_obj : ℰ → obj₂ 𝒞)
    (G_hom : Π {X Y : ℰ}, (by exactI X ⟶ Y) → hom₂ (G_obj X) (G_obj Y))
    (cone : Π (X : 𝒟), hom₂ (by exactI limit_obj₂ G_obj @G_hom) (F_obj X))
    (ih_cone : Π (X : 𝒟), by exactI motive (cone X)),
      by exactI motive (is_limit₂ F_obj @F_hom (limit_obj₂ G_obj @G_hom) cone)) :
  motive f :=
@hom₂.rec_on 𝒞 _ (λ A B f, ∀ (h : A = limit_obj₂ F_obj @F_hom),
  motive (show hom₂ (limit_obj₂ F_obj @F_hom) B, from eq.rec_on h f))
  (limit_obj₂ F_obj @F_hom) Y f
  begin
    intros,
    simp [limit_obj₂, of_cat_obj₂, limit_obj₁] at h,
    contradiction
  end
  begin
    introsI ℰ _ G_obj G_hom ih₁ A B g ih₂ h,
    unfreezingI { rcases (limit_obj₂_injective h) with ⟨rfl, h₁, h₂, h₃⟩ },
    unfreezingI { subst h₁, subst h₂, subst h₃ },
    exact limit_cone_comp _ _ _ _
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ A B g ih₂ h,
    subst h,
    exact colimit_cocone_comp _ _ _ _ _ _ (ih₂ rfl)
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ cone_obj cone ih₂ h,
    subst h,
    exact is_limit _ _ _ _ _ (λ A, ih₂ A rfl),
  end
  begin
    intros,
    simp [colimit_obj₂, of_cat_obj₂, limit_obj₂] at h,
    contradiction
  end
  rfl

@[elab_as_eliminator] def hom₂_colimit_obj_rec_on
  {motive : Π {𝒟 : Type} [category 𝒟] {F_obj : 𝒟 → obj₂ 𝒞}
    {F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)} {Y : obj₂ 𝒞},
    hom₂ (by exactI colimit_obj₂ F_obj @F_hom) Y → Sort*}
  {𝒟 : Type} [category 𝒟] {F_obj : 𝒟 → obj₂ 𝒞}
  {F_hom : Π {X Y : 𝒟}, (X ⟶ Y) → hom₂ (F_obj X) (F_obj Y)} {Y : obj₂ 𝒞}
  (f : hom₂ (colimit_obj₂ F_obj @F_hom) Y)
  (colimit_cocone_comp : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (X : 𝒟)
    {ℰ : Type} [category ℰ] {G_obj : ℰ → obj₂ 𝒞}
    {G_hom : Π {X Y : ℰ}, (by exactI X ⟶ Y) → hom₂ (G_obj X) (G_obj Y)}
    (f : hom₂ (by exactI colimit_obj₂ G_obj @G_hom) (F_obj X))
    (ih_f : by exactI motive f),
      by exactI motive (by exactI colimit_cocone_comp₂ F_obj @F_hom X f))
  (is_limit : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    {ℰ : Type} [category ℰ] {G_obj : ℰ → obj₂ 𝒞}
    {G_hom : Π {X Y : ℰ}, (by exactI X ⟶ Y) → hom₂ (G_obj X) (G_obj Y)}
    (cone : Π (X : 𝒟), hom₂ (by exactI colimit_obj₂ G_obj @G_hom) (F_obj X))
    (ih_cone : Π (X : 𝒟), by exactI motive (cone X)),
      by exactI motive (by exactI is_limit₂ F_obj @F_hom _ cone))
  (is_colimit : Π {𝒟 : Type} [category 𝒟] (F_obj : 𝒟 → obj₂ 𝒞)
    (F_hom : Π {X Y : 𝒟}, (by exactI X ⟶ Y) → hom₂ (F_obj X) (F_obj Y))
    (cocone_obj : obj₂ 𝒞) (cocone : Π (X : 𝒟), hom₂ (F_obj X) cocone_obj),
      by exactI motive (is_colimit₂ F_obj @F_hom cocone_obj cocone)) :
  motive f :=
@hom₂.rec_on 𝒞 _ (λ A B f, ∀ (h : A = colimit_obj₂ F_obj @F_hom),
  motive (show hom₂ (colimit_obj₂ F_obj @F_hom) B, from eq.rec_on h f))
  (colimit_obj₂ F_obj @F_hom) Y f
  begin
    intros,
    simp [colimit_obj₂, of_cat_obj₂, colimit_obj₁] at h,
    contradiction
  end
  begin
    intros,
    simp [colimit_obj₂, of_cat_obj₂, colimit_obj₁, limit_obj₁, limit_obj₂] at h,
    contradiction
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ A B f ih₂ h,
    subst h,
    exact colimit_cocone_comp _ _ _ _ (ih₂ rfl)
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ cone_obj cone ih₂ h,
    subst h,
    exact is_limit _ _ _ (λ X, ih₂ X rfl)
  end
  begin
    introsI ℰ _ G_obj G_hom ih₁ cocone_obj cocone ih₂ h,
    unfreezingI { rcases (colimit_obj₂_injective h) with ⟨rfl, h₁, h₂, h₃⟩ },
    unfreezingI { subst h₁, subst h₂, subst h₃ },
    exact is_colimit _ _ _ _
  end
  rfl

def comp₂ {X Y : obj₂ 𝒞} (f : hom₂ X Y) : Π {Z : obj₂ 𝒞}, hom₂ Y Z → hom₂ X Z :=
hom₂.rec_on f
  begin
    intros X Y f Z g,
    refine hom₂_of_cat_obj_rec_on g _ _ _,
    { intros B g,
      exact of_cat_hom₂ (f ≫ g) },
    { introsI 𝒟 _ F_obj F_hom ih₁ B g ih₂,
      exact colimit_cocone_comp₂ F_obj _ _ ih₂ },
    { introsI 𝒟 _ F_obj F_hom ih₁ cone ih₂,
      exact is_limit₂ _ _ _ (λ X, ih₂ _) }
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ A B f ih₂ Z g,
    refine limit_cone_comp₂ _ _ _ (ih₂ g),
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ A B f ih₂ Z g,
    revert ih₂ A,
    refine hom₂_colimit_obj_rec_on g _ _ _,
    { introsI ℰ _ G_obj G_hom C ℱ _ H_obj H_hom ih₃ ih₄ A g ih₂,
      refine colimit_cocone_comp₂ _ _ _ (ih₄ _ g @ih₂) },
    { introsI ℰ _ G_obj G_hom ℱ _ H_obj H_hom ih₃ ih₄ A g ih₂,
      exact is_limit₂ _ _ _ (λ X, ih₄ _ _ g @ih₂) },
    { introsI ℰ _ G_obj G_hom cocone_obj cocone A g ih₂,
      exact ih₂ (cocone _) }
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ cone_obj cone ih₂ Z g,
    revert ih₂,
    refine hom₂_limit_obj_rec_on g _ _ _,
    { introsI ℰ _ G_obj G_hom A B g ih₂,
      exact ih₂ A g },
    { introsI ℰ _ F_obj F_hom A ℱ _ G_obj G_hom g ih₃ ih₂,
      exact colimit_cocone_comp₂ _ _ A (ih₃ @ih₂) },
    { introsI ℰ _ F_obj F_hom ℱ _ G_obj G_hom ih₃ ih₄ ih₂,
      exact is_limit₂ _ _ _ (λ X, ih₄ _ @ih₂) }
  end
  begin
    introsI 𝒟 _ F_obj F_hom ih₁ cocone_obj cocone ih₂ Z g,
    exact is_colimit₂ _ _ _ (λ A, ih₂ _ g)
  end

def UMP_obj {X Y : obj₂ 𝒞} (f : hom₂ X Y) (h : X = Y)
  (hf : show hom )

end bicompletion_aux


/-
Copyright (c) 2021 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import tactic.elementwise
import category_theory.limits.shapes.multiequalizer
import category_theory.limits.constructions.epi_mono
import category_theory.limits.preserves.limits
import category_theory.limits.shapes.types

/-!
# Gluing data

We define `glue_data` as a family of data needed to glue topological spaces, schemes, etc. We
provide the API to realize it as a multispan diagram, and also states lemmas about its
interaction with a functor that preserves certain pullbacks.

-/

noncomputable theory

open category_theory.limits
namespace category_theory

universes v u₁ u₂

variables (C : Type u₁) [category.{v} C] {C' : Type u₂} [category.{v} C']

/--
A gluing datum consists of
1. An index type `J`
2. An object `U i` for each `i : J`.
3. An object `V i j` for each `i j : J`.
4. A monomorphism `f i j : V i j ⟶ U i` for each `i j : J`.
5. A transition map `t i j : V i j ⟶ V j i` for each `i j : J`.
such that
6. `f i i` is an isomorphism.
7. `t i i` is the identity.
8. The pullback for `f i j` and `f i k` exists.
9. `V i j ×[U i] V i k ⟶ V i j ⟶ V j i` factors through `V j k ×[U j] V j i ⟶ V j i` via some
    `t' : V i j ×[U i] V i k ⟶ V j k ×[U j] V j i`.
10. `t' i j k ≫ t' j k i ≫ t' k i j = 𝟙 _`.
-/
@[nolint has_nonempty_instance]
structure glue_data :=
(J : Type v)
(U : J → C)
(V : J × J → C)
(f : Π i j, V (i, j) ⟶ U i)
(f_mono : ∀ i j, mono (f i j) . tactic.apply_instance)
(f_has_pullback : ∀ i j k, has_pullback (f i j) (f i k) . tactic.apply_instance)
(f_id : ∀ i, is_iso (f i i) . tactic.apply_instance)
(t : Π i j, V (i, j) ⟶ V (j, i))
(t_id : ∀ i, t i i = 𝟙 _)
(t' : Π i j k, pullback (f i j) (f i k) ⟶ pullback (f j k) (f j i))
(t_fac : ∀ i j k, t' i j k ≫ pullback.snd = pullback.fst ≫ t i j)
(cocycle : ∀ i j k , t' i j k ≫ t' j k i ≫ t' k i j = 𝟙 _)

attribute [simp] glue_data.t_id
attribute [instance] glue_data.f_id glue_data.f_mono glue_data.f_has_pullback
attribute [reassoc] glue_data.t_fac glue_data.cocycle

namespace glue_data

variables {C} (D : glue_data C)

@[simp] lemma t'_iij (i j : D.J) : D.t' i i j = (pullback_symmetry _ _).hom :=
begin
  have eq₁ := D.t_fac i i j,
  have eq₂ := (is_iso.eq_comp_inv (D.f i i)).mpr (@pullback.condition _ _ _ _ _ _ (D.f i j) _),
  rw [D.t_id, category.comp_id, eq₂] at eq₁,
  have eq₃ := (is_iso.eq_comp_inv (D.f i i)).mp eq₁,
  rw [category.assoc, ←pullback.condition, ←category.assoc] at eq₃,
  exact mono.right_cancellation _ _
    ((mono.right_cancellation _ _ eq₃).trans (pullback_symmetry_hom_comp_fst _ _).symm)
end

lemma t'_jii (i j : D.J) : D.t' j i i = pullback.fst ≫ D.t j i ≫ inv pullback.snd :=
by { rw [←category.assoc, ←D.t_fac], simp }

lemma t'_iji (i j : D.J) : D.t' i j i = pullback.fst ≫ D.t i j ≫ inv pullback.snd :=
by { rw [←category.assoc, ←D.t_fac], simp }

@[simp, reassoc, elementwise] lemma t_inv (i j : D.J) :
  D.t i j ≫ D.t j i = 𝟙 _ :=
begin
  have eq : (pullback_symmetry (D.f i i) (D.f i j)).hom = pullback.snd ≫ inv pullback.fst,
  { simp },
  have := D.cocycle i j i,
  rw [D.t'_iij, D.t'_jii, D.t'_iji, fst_eq_snd_of_mono_eq, eq] at this,
  simp only [category.assoc, is_iso.inv_hom_id_assoc] at this,
  rw [←is_iso.eq_inv_comp, ←category.assoc, is_iso.comp_inv_eq] at this,
  simpa using this,
end

lemma t'_inv (i j k : D.J) : D.t' i j k ≫ (pullback_symmetry _ _).hom ≫
  D.t' j i k ≫ (pullback_symmetry _ _).hom = 𝟙 _ :=
begin
  rw ← cancel_mono (pullback.fst : pullback (D.f i j) (D.f i k) ⟶ _),
  simp [t_fac, t_fac_assoc]
end

instance t_is_iso (i j : D.J) : is_iso (D.t i j) :=
⟨⟨D.t j i, D.t_inv _ _, D.t_inv _ _⟩⟩

instance t'_is_iso (i j k : D.J) : is_iso (D.t' i j k) :=
⟨⟨D.t' j k i ≫ D.t' k i j, D.cocycle _ _ _, (by simpa using D.cocycle _ _ _)⟩⟩

@[reassoc]
lemma t'_comp_eq_pullback_symmetry (i j k : D.J) :
  D.t' j k i ≫ D.t' k i j = (pullback_symmetry _ _).hom ≫
  D.t' j i k ≫ (pullback_symmetry _ _).hom :=
begin
  transitivity inv (D.t' i j k),
  { exact is_iso.eq_inv_of_hom_inv_id (D.cocycle _ _ _) },
  { rw ← cancel_mono (pullback.fst : pullback (D.f i j) (D.f i k) ⟶ _),
    simp [t_fac, t_fac_assoc] }
end

/-- (Implementation) The disjoint union of `U i`. -/
def sigma_opens [has_coproduct D.U] : C := ∐ D.U

/-- (Implementation) The diagram to take colimit of. -/
def diagram : multispan_index C :=
{ L := D.J × D.J, R := D.J,
  fst_from := _root_.prod.fst, snd_from := _root_.prod.snd,
  left := D.V, right := D.U,
  fst := λ ⟨i, j⟩, D.f i j,
  snd := λ ⟨i, j⟩, D.t i j ≫ D.f j i }

@[simp] lemma diagram_L : D.diagram.L = (D.J × D.J) := rfl
@[simp] lemma diagram_R : D.diagram.R = D.J := rfl
@[simp] lemma diagram_fst_from (i j : D.J) : D.diagram.fst_from ⟨i, j⟩ = i := rfl
@[simp] lemma diagram_snd_from (i j : D.J) : D.diagram.snd_from ⟨i, j⟩ = j := rfl
@[simp] lemma diagram_fst (i j : D.J) : D.diagram.fst ⟨i, j⟩ = D.f i j := rfl
@[simp] lemma diagram_snd (i j : D.J) : D.diagram.snd ⟨i, j⟩ = D.t i j ≫ D.f j i := rfl
@[simp] lemma diagram_left : D.diagram.left = D.V := rfl
@[simp] lemma diagram_right : D.diagram.right = D.U := rfl

section

variable [has_multicoequalizer D.diagram]

/-- The glued object given a family of gluing data. -/
def glued : C := multicoequalizer D.diagram

/-- The map `D.U i ⟶ D.glued` for each `i`. -/
def ι (i : D.J) : D.U i ⟶ D.glued :=
multicoequalizer.π D.diagram i

@[simp, elementwise]
lemma glue_condition (i j : D.J) :
  D.t i j ≫ D.f j i ≫ D.ι j = D.f i j ≫ D.ι i :=
(category.assoc _ _ _).symm.trans (multicoequalizer.condition D.diagram ⟨i, j⟩).symm

/-- The pullback cone spanned by `V i j ⟶ U i` and `V i j ⟶ U j`.
This will often be a pullback diagram. -/
 def V_pullback_cone (i j : D.J) : pullback_cone (D.ι i) (D.ι j) :=
 pullback_cone.mk (D.f i j) (D.t i j ≫ D.f j i) (by simp)

variables [has_colimits C]

/-- The projection `∐ D.U ⟶ D.glued` given by the colimit. -/
def π : D.sigma_opens ⟶ D.glued := multicoequalizer.sigma_π D.diagram

instance π_epi : epi D.π := by { unfold π, apply_instance }

end

lemma types_π_surjective (D : glue_data Type*) :
  function.surjective D.π := (epi_iff_surjective _).mp infer_instance

lemma types_ι_jointly_surjective (D : glue_data Type*) (x : D.glued) :
  ∃ i (y : D.U i), D.ι i y = x :=
begin
  delta category_theory.glue_data.ι,
  simp_rw ← multicoequalizer.ι_sigma_π D.diagram,
  rcases D.types_π_surjective x with ⟨x', rfl⟩,
  have := colimit.iso_colimit_cocone (types.coproduct_colimit_cocone _),
  rw ← (show (colimit.iso_colimit_cocone (types.coproduct_colimit_cocone _)).inv _ = x',
    from concrete_category.congr_hom
      ((colimit.iso_colimit_cocone (types.coproduct_colimit_cocone _)).hom_inv_id) x'),
  rcases (colimit.iso_colimit_cocone (types.coproduct_colimit_cocone _)).hom x' with ⟨i, y⟩,
  exact ⟨i, y, by { simpa [← multicoequalizer.ι_sigma_π, -multicoequalizer.ι_sigma_π] }⟩
end

variables (F : C ⥤ C') [H : ∀ i j k, preserves_limit (cospan (D.f i j) (D.f i k)) F]

include H

instance (i j k : D.J) : has_pullback (F.map (D.f i j)) (F.map (D.f i k)) :=
⟨⟨⟨_, is_limit_of_has_pullback_of_preserves_limit F (D.f i j) (D.f i k)⟩⟩⟩

/-- A functor that preserves the pullbacks of `f i j` and `f i k` can map a family of glue data. -/
@[simps] def map_glue_data :
  glue_data C' :=
{ J := D.J,
  U := λ i, F.obj (D.U i),
  V := λ i, F.obj (D.V i),
  f := λ i j, F.map (D.f i j),
  f_mono := λ i j, preserves_mono_of_preserves_limit _ _,
  f_id := λ i, infer_instance,
  t := λ i j, F.map (D.t i j),
  t_id := λ i, by { rw D.t_id i, simp },
  t' := λ i j k, (preserves_pullback.iso F (D.f i j) (D.f i k)).inv ≫
    F.map (D.t' i j k) ≫ (preserves_pullback.iso F (D.f j k) (D.f j i)).hom,
  t_fac := λ i j k, by simpa [iso.inv_comp_eq] using congr_arg (λ f, F.map f) (D.t_fac i j k),
  cocycle := λ i j k, by simp only [category.assoc, iso.hom_inv_id_assoc, ← functor.map_comp_assoc,
    D.cocycle, iso.inv_hom_id, category_theory.functor.map_id, category.id_comp] }

/--
The diagram of the image of a `glue_data` under a functor `F` is naturally isomorphic to the
original diagram of the `glue_data` via `F`.
-/
def diagram_iso : D.diagram.multispan ⋙ F ≅ (D.map_glue_data F).diagram.multispan :=
nat_iso.of_components
  (λ x, match x with
    | walking_multispan.left a := iso.refl _
    | walking_multispan.right b := iso.refl _
    end)
  (begin
    rintros (⟨_,_⟩|_) _ (_|_|_),
    { erw [category.comp_id, category.id_comp, functor.map_id], refl },
    { erw [category.comp_id, category.id_comp], refl },
    { erw [category.comp_id, category.id_comp, functor.map_comp], refl },
    { erw [category.comp_id, category.id_comp, functor.map_id], refl },
  end)

@[simp] lemma diagram_iso_app_left (i : D.J × D.J) :
  (D.diagram_iso F).app (walking_multispan.left i) = iso.refl _ := rfl

@[simp]

@[simp] lemma diagram_iso_hom_app_left (i : D.J × D.J) :
  (D.diagram_iso F).hom.app (walking_multispan.left i) = 𝟙 _ := rfl

@[simp] lemma diagram_iso_hom_app_right (i : D.J) :
  (D.diagram_iso F).hom.app (walking_multispan.right i) = 𝟙 _ := rfl

@[simp] lemma diagram_iso_inv_app_left (i : D.J × D.J) :
  (D.diagram_iso F).inv.app (walking_multispan.left i) = 𝟙 _ := rfl

@[simp] lemma diagram_iso_inv_app_right (i : D.J) :
  (D.diagram_iso F).inv.app (walking_multispan.right i) = 𝟙 _ := rfl

variables [has_multicoequalizer D.diagram] [preserves_colimit D.diagram.multispan F]

omit H

lemma has_colimit_multispan_comp : has_colimit (D.diagram.multispan ⋙ F) :=
⟨⟨⟨_,preserves_colimit.preserves (colimit.is_colimit _)⟩⟩⟩

include H

local attribute [instance] has_colimit_multispan_comp

lemma has_colimit_map_glue_data_diagram : has_multicoequalizer (D.map_glue_data F).diagram :=
has_colimit_of_iso (D.diagram_iso F).symm

local attribute [instance] has_colimit_map_glue_data_diagram

/-- If `F` preserves the gluing, we obtain an iso between the glued objects. -/
def glued_iso : F.obj D.glued ≅ (D.map_glue_data F).glued :=
preserves_colimit_iso F D.diagram.multispan ≪≫
  (limits.has_colimit.iso_of_nat_iso (D.diagram_iso F))

@[simp, reassoc]
lemma ι_glued_iso_hom (i : D.J) :
  F.map (D.ι i) ≫ (D.glued_iso F).hom = (D.map_glue_data F).ι i :=
by { erw ι_preserves_colimits_iso_hom_assoc, rw has_colimit.iso_of_nat_iso_ι_hom,
  erw category.id_comp, refl }

@[simp, reassoc]
lemma ι_glued_iso_inv (i : D.J) :
  (D.map_glue_data F).ι i ≫ (D.glued_iso F).inv = F.map (D.ι i) :=
by rw [iso.comp_inv_eq, ι_glued_iso_hom]

/-- If `F` preserves the gluing, and reflects the pullback of `U i ⟶ glued` and `U j ⟶ glued`,
then `F` reflects the fact that `V_pullback_cone` is a pullback. -/
def V_pullback_cone_is_limit_of_map (i j : D.J) [reflects_limit (cospan (D.ι i) (D.ι j)) F]
  (hc : is_limit ((D.map_glue_data F).V_pullback_cone i j)) :
  is_limit (D.V_pullback_cone i j) :=
begin
  apply is_limit_of_reflects F,
  apply (is_limit_map_cone_pullback_cone_equiv _ _).symm _,
  let e : cospan (F.map (D.ι i)) (F.map (D.ι j)) ≅
    cospan ((D.map_glue_data F).ι i) ((D.map_glue_data F).ι j),
  exact nat_iso.of_components
    (λ x, by { cases x, exacts [D.glued_iso F, iso.refl _] })
    (by rintros (_|_) (_|_) (_|_|_); simp),
  apply is_limit.postcompose_hom_equiv e _ _,
  apply hc.of_iso_limit,
  refine cones.ext (iso.refl _) _,
  { rintro (_|_|_),
    change _ = _ ≫ (_ ≫ _) ≫ _,
    all_goals { change _ = 𝟙 _ ≫ _ ≫ _, simpa } }
end

omit H

/-- If there is a forgetful functor into `Type` that preserves enough (co)limits, then `D.ι` will
be jointly surjective. -/
lemma ι_jointly_surjective (F : C ⥤ Type v) [preserves_colimit D.diagram.multispan F]
  [Π (i j k : D.J), preserves_limit (cospan (D.f i j) (D.f i k)) F] (x : F.obj (D.glued)) :
  ∃ i (y : F.obj (D.U i)), F.map (D.ι i) y = x :=
begin
  let e := D.glued_iso F,
  obtain ⟨i, y, eq⟩ := (D.map_glue_data F).types_ι_jointly_surjective (e.hom x),
  replace eq := congr_arg e.inv eq,
  change ((D.map_glue_data F).ι i ≫ e.inv) y = (e.hom ≫ e.inv) x at eq,
  rw [e.hom_inv_id, D.ι_glued_iso_inv] at eq,
  exact ⟨i, y, eq⟩
end

end glue_data

end category_theory


/-
Copyright (c) 2022 Joël Riou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joël Riou
-/

import category_theory.localization.construction
import for_mathlib.category_theory.morphism_property_misc

noncomputable theory

open category_theory category_theory.category

variables {C : Type*} [category C] (W : morphism_property C)
variables {D : Type*} [category D]

namespace category_theory

variables (D)

--@[derive category]
--def morphism_property.functors_inverting := full_subcategory (λ (F : C ⥤ D), W.is_inverted_by F)

variables {D W}

--def morphism_property.functors_inverting.mk (F : C ⥤ D) (hF : W.is_inverted_by F) :
--  W.functors_inverting D := ⟨F, hF⟩

variables (D W)
namespace morphism_property

--lemma Q_inverts : W.is_inverted_by W.Q :=
--λ X Y w hw, is_iso.of_iso (localization.construction.Wiso w hw)

end morphism_property

namespace localization

namespace construction

/-lemma nat_trans_hcomp_injective {F G : W.localization ⥤ D} (τ₁ τ₂ : F ⟶ G)
  (h : 𝟙 W.Q ◫ τ₁ = 𝟙 W.Q ◫ τ₂) : τ₁ = τ₂ :=
begin
  ext X,
  have eq := (obj_equiv W).right_inv X,
  simp only [obj_equiv] at eq,
  rw [← eq, ← nat_trans.id_hcomp_app, ← nat_trans.id_hcomp_app, h],
end

namespace whiskering_left_equivalence

@[simps]
def functor : (W.localization ⥤ D) ⥤ (W.functors_inverting D) :=
full_subcategory.lift _ ((whiskering_left _ _ D).obj W.Q)
  (λ F, morphism_property.is_inverted_by.of_comp W W.Q W.Q_inverts _)

@[simps]
def inverse : (W.functors_inverting D) ⥤ (W.localization ⥤ D) :=
{ obj := λ G, lift G.obj G.property,
  map := λ G₁ G₂ τ, nat_trans_extension (eq_to_hom (by rw fac) ≫ τ ≫ eq_to_hom (by rw fac)),
  map_id' := λ G, nat_trans_hcomp_injective begin
    rw nat_trans_extension_hcomp,
    ext X,
    simpa only [nat_trans.comp_app, eq_to_hom_app, eq_to_hom_refl, comp_id, id_comp,
      nat_trans.hcomp_id_app, nat_trans.id_app, functor.map_id],
  end,
  map_comp' := λ G₁ G₂ G₃ τ₁ τ₂, nat_trans_hcomp_injective begin
    ext X,
    simpa only [nat_trans_extension_hcomp, nat_trans.comp_app, eq_to_hom_app, eq_to_hom_refl,
      id_comp, comp_id, nat_trans.hcomp_app, nat_trans.id_app, functor.map_id,
      nat_trans_extension_app, nat_trans_extension.app_eq],
  end, }

@[simps]
lemma unit_iso : 𝟭 (W.localization ⥤ D) ≅ functor W D ⋙ inverse W D := eq_to_iso
begin
  refine functor.ext (λ G, _) (λ G₁ G₂ τ, _),
  { apply uniq,
    dsimp [functor],
    rw fac, },
  { apply nat_trans_hcomp_injective,
    ext X,
    simp only [functor.id_map, nat_trans.hcomp_app, comp_id, functor.comp_map,
      inverse_map, nat_trans.comp_app, eq_to_hom_app, eq_to_hom_refl, nat_trans_extension_app,
      nat_trans_extension.app_eq, functor_map_app, id_comp], },
end

@[simps]
lemma counit_iso : inverse W D ⋙ functor W D ≅ 𝟭 (W.functors_inverting D) := eq_to_iso
begin
  refine functor.ext _ _,
  { rintro ⟨G, hG⟩,
    ext1,
    apply fac, },
  { rintros ⟨G₁, hG₁⟩ ⟨G₂, hG₂⟩ f,
    ext X,
    apply nat_trans_extension.app_eq, },
end

end whiskering_left_equivalence

def whiskering_left_equivalence : (W.localization ⥤ D) ≌ W.functors_inverting D :=
{ functor := whiskering_left_equivalence.functor W D,
  inverse := whiskering_left_equivalence.inverse W D,
  unit_iso := whiskering_left_equivalence.unit_iso W D,
  counit_iso := whiskering_left_equivalence.counit_iso W D,
  functor_unit_iso_comp' := λ F, begin
    ext X,
    simpa only [eq_to_hom_app, whiskering_left_equivalence.unit_iso_hom,
      whiskering_left_equivalence.counit_iso_hom, eq_to_hom_map, eq_to_hom_trans,
      eq_to_hom_refl],
  end, }-/

end construction

end localization

end category_theory


/-
Copyright (c) 2021 Gabriel Ebner. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gabriel Ebner, Mario Carneiro
-/
import Std.Tactic.Basic
import Std.Tactic.RCases
import Std.Tactic.Ext.Attr

namespace Std.Tactic.Ext
open Lean Meta Elab Tactic

/--
Constructs the hypotheses for the extensionality lemma.
Calls the continuation `k` with the list of parameters to the structure,
two structure variables `x` and `y`, and a list of pairs `(field, ty)`
where `ty` is `x.field = y.field` or `HEq x.field y.field`.
-/
def withExtHyps (struct : Name)
    (k : Array Expr → (x y : Expr) → Array (Name × Expr) → MetaM α) : MetaM α := do
  unless isStructure (← getEnv) struct do throwError "not a structure: {struct}"
  let structC ← mkConstWithLevelParams struct
  forallTelescope (← inferType structC) fun params _ => do
  withNewBinderInfos (params.map (·.fvarId!, BinderInfo.implicit)) do
  withLocalDeclD `x (mkAppN structC params) fun x => do
  withLocalDeclD `y (mkAppN structC params) fun y => do
    let mut hyps := #[]
    for field in getStructureFieldsFlattened (← getEnv) struct (includeSubobjectFields := false) do
      let x_f ← mkProjection x field
      let y_f ← mkProjection y field
      if ← isProof x_f then
        pure ()
      else if ← isDefEq (← inferType x_f) (← inferType y_f) then
        hyps := hyps.push (field, ← mkEq x_f y_f)
      else
        hyps := hyps.push (field, ← mkHEq x_f y_f)
    k params x y hyps

/--
Creates the type of the extensionality lemma for the given structure,
elaborating to `x.1 = y.1 → x.2 = y.2 → x = y`, for example.
-/
scoped elab "ext_type%" struct:ident : term => do
  withExtHyps (← resolveGlobalConstNoOverloadWithInfo struct) fun params x y hyps => do
    let ty := hyps.foldr (init := ← mkEq x y) fun (f, h) ty =>
      mkForall f BinderInfo.default h ty
    mkForallFVars (params |>.push x |>.push y) ty

/-- Make an `Iff` application. -/
def mkIff (p q : Expr) : Expr := mkApp2 (mkConst ``Iff) p q

/-- Make an n-ary `And` application. `mkAndN []` returns `True`. -/
def mkAndN : List Expr → Expr
  | [] => mkConst ``True
  | [p] => p
  | p :: ps => mkAnd p (mkAndN ps)

/--
Creates the type of the iff-variant of the extensionality lemma for the given structure,
elaborating to `x = y ↔ x.1 = y.1 ∧ x.2 = y.2`, for example.
-/
scoped elab "ext_iff_type%" struct:ident : term => do
  withExtHyps (← resolveGlobalConstNoOverloadWithInfo struct) fun params x y hyps => do
    mkForallFVars (params |>.push x |>.push y) <|
      mkIff (← mkEq x y) <| mkAndN (hyps.map (·.2)).toList

macro_rules | `(declare_ext_theorems_for $struct:ident $[$prio]?) => do
  let names ← Macro.resolveGlobalName struct.getId.eraseMacroScopes
  let name ← match names.filter (·.2.isEmpty) with
    | [] => Macro.throwError s!"unknown constant {struct}"
    | [(name, _)] => pure name
    | _ => Macro.throwError s!"ambiguous name {struct}"
  let extName := mkIdentFrom struct (canonical := true) <| name.mkStr "ext"
  let extIffName := mkIdentFrom struct (canonical := true) <| name.mkStr "ext_iff"
  `(@[ext $[$prio]?] protected theorem $extName:ident : ext_type% $struct:ident :=
      fun {..} {..} => by intros; subst_eqs; rfl
    protected theorem $extIffName:ident : ext_iff_type% $struct:ident :=
      fun {..} {..} =>
        ⟨fun h => by cases h; split_ands <;> rfl,
         fun _ => by (repeat cases ‹_ ∧ _›); subst_eqs; rfl⟩)

/-- Apply a single extensionality lemma to `goal`. -/
def applyExtLemma (goal : MVarId) : MetaM (List MVarId) := goal.withContext do
  let tgt ← goal.getType'
  unless tgt.isAppOfArity ``Eq 3 do
    throwError "applyExtLemma only applies to equations, not{indentExpr tgt}"
  let ty := tgt.getArg! 0
  let s ← saveState
  for lem in ← getExtLemmas ty do
    try
      -- Note: We have to do this extra check to ensure that we don't apply e.g.
      -- funext to a goal `(?a₁ : ?b) = ?a₂` to produce `(?a₁ x : ?b') = ?a₂ x`,
      -- since this will loop.
      -- We require that the type of the equality is not changed by the `goal.apply c` line
      -- TODO: add flag to apply tactic to toggle unification vs. matching
      withNewMCtxDepth do
        let c ← mkConstWithFreshMVarLevels lem.declName
        let (_, _, declTy) ← withDefault <| forallMetaTelescopeReducing (← inferType c)
        guard (← isDefEq tgt declTy)
      return ← goal.apply (← mkConstWithFreshMVarLevels lem.declName)
    catch _ => s.restore
  throwError "no applicable extensionality lemma found for{indentExpr ty}"

/-- Apply a single extensionality lemma to the current goal. -/
elab "apply_ext_lemma" : tactic => liftMetaTactic applyExtLemma

/--
Postprocessor for `withExt` which runs `rintro` with the given patterns when the target is a
pi type.
-/
def tryIntros [Monad m] [MonadLiftT TermElabM m] (g : MVarId) (pats : List (TSyntax `rcasesPat))
    (k : MVarId → List (TSyntax `rcasesPat) → m Unit) : m Unit := do
  match pats with
  | [] => k (← (g.intros : TermElabM _)).2 []
  | p::ps =>
    if (← (g.withContext g.getType' : TermElabM _)).isForall then
      for g in ← RCases.rintro #[p] none g do
        k g ps
    else k g pats

/--
Applies a single extensionality lemma, using `pats` to introduce variables in the result.
Runs continuation `k` on each subgoal.
-/
def withExt1 [Monad m] [MonadLiftT TermElabM m] (g : MVarId) (pats : List (TSyntax `rcasesPat))
    (k : MVarId → List (TSyntax `rcasesPat) → m Unit) : m Unit := do
  for g in ← (applyExtLemma g : TermElabM _) do
    tryIntros g pats k

/--
Applies a extensionality lemmas recursively, using `pats` to introduce variables in the result.
Runs continuation `k` on each subgoal.
-/
def withExtN [Monad m] [MonadLiftT TermElabM m] [MonadExcept Exception m]
    (g : MVarId) (pats : List (TSyntax `rcasesPat))
    (k : MVarId → List (TSyntax `rcasesPat) → m Unit)
    (depth := 1000000) (failIfUnchanged := true) : m Unit :=
  match depth with
  | 0 => k g pats
  | depth+1 => do
    if failIfUnchanged then
      withExt1 g pats fun g pats => withExtN g pats k depth (failIfUnchanged := false)
    else try
      withExt1 g pats fun g pats => withExtN g pats k depth (failIfUnchanged := false)
    catch _ => k g pats

/--
Apply extensionality lemmas as much as possible, using `pats` to introduce the variables
in extensionality lemmas like `funext`. Returns a list of subgoals,
and the unconsumed patterns in each of those subgoals.
-/
def extCore (g : MVarId) (pats : List (TSyntax `rcasesPat))
  (depth := 1000000) (failIfUnchanged := true) :
  TermElabM (Array (MVarId × List (TSyntax `rcasesPat))) := do
  (·.2) <$> StateT.run (m := TermElabM) (s := #[])
    (withExtN g pats (fun g qs => modify (·.push (g, qs))) depth failIfUnchanged)

/--
* `ext pat*`: Apply extensionality lemmas as much as possible,
  using `pat*` to introduce the variables in extensionality lemmas like `funext`.
* `ext`: introduce anonymous variables whenever needed.
-/
syntax "ext" (colGt ppSpace rintroPat)* (" : " num)? : tactic
elab_rules : tactic
  | `(tactic| ext $pats* $[: $n]?) => do
    let pats := RCases.expandRIntroPats pats
    let depth := n.map (·.getNat) |>.getD 1000000
    let gs ← extCore (← getMainGoal) pats.toList depth
    replaceMainGoal <| gs.map (·.1) |>.toList

/--
`ext1 pat*` is like `ext pat*` except it only applies one extensionality lemma instead
of recursing as much as possible.
-/
macro "ext1" xs:(colGt ppSpace rintroPat)* : tactic =>
  if xs.isEmpty then `(tactic| apply_ext_lemma <;> intros)
  else `(tactic| apply_ext_lemma <;> rintro $xs*)

-- TODO
/-- `ext1? pat*` is like `ext1 pat*` but gives a suggestion on what pattern to use -/
syntax "ext1?" (colGt ppSpace rintroPat)* : tactic
/-- `ext? pat*` is like `ext pat*` but gives a suggestion on what pattern to use -/
syntax "ext?" (colGt ppSpace rintroPat)* (" : " num)? : tactic

end Std.Tactic.Ext

attribute [ext] funext propext

@[ext] protected theorem PUnit.ext (x y : PUnit) : x = y := rfl
protected theorem Unit.ext (x y : Unit) : x = y := rfl


example (h₁: m < n) (h₂: m.succ.pred < n) :
  (Fin.mk m h₁).succ = (Fin.mk m.succ.pred h₂).succ := by
  simp


/-
Copyright (c) 2020 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/

import tactic.norm_num
import tactic.linarith
import tactic.omega
import control.lawful_fix
import order.category.omega_complete_partial_order
import data.nat.basic

universes u_1 u_2

namespace roption.examples
open function has_fix omega_complete_partial_order

/-! `easy` is a trivial, non-recursive example -/

def easy.intl (easy : ℕ → ℕ → roption ℕ) : ℕ → ℕ → roption ℕ
| x y := pure x

def easy :=
fix easy.intl

-- automation coming soon
theorem easy.cont : continuous' easy.intl :=
pi.omega_complete_partial_order.flip₂_continuous' easy.intl
  (λ x, pi.omega_complete_partial_order.flip₂_continuous' _ (λ x_1, const_continuous' (pure x)))

-- automation coming soon
theorem easy.equations.eqn_1 (x y : ℕ) : easy x y = pure x :=
by rw [easy, lawful_fix.fix_eq' easy.cont]; refl

/-! division on natural numbers -/

def div.intl (div : ℕ → ℕ → roption ℕ) : ℕ → ℕ → roption ℕ
| x y :=
if y ≤ x ∧ y > 0
  then div (x - y) y
  else pure x

def div : ℕ → ℕ → roption ℕ :=
fix div.intl

-- automation coming soon
theorem div.cont : continuous' div.intl :=
pi.omega_complete_partial_order.flip₂_continuous' div.intl
  (λ (x : ℕ),
     pi.omega_complete_partial_order.flip₂_continuous' (λ (g : ℕ → ℕ → roption ℕ), div.intl g x)
       (λ (x_1 : ℕ),
            (continuous_hom.ite_continuous' (λ (x_2 : ℕ → ℕ → roption ℕ), x_2 (x - x_1) x_1)
               (λ (x_1 : ℕ → ℕ → roption ℕ), pure x)
               (pi.omega_complete_partial_order.flip₁_continuous'
                 (λ (v_1 : ℕ) (x_2 : ℕ → ℕ → roption ℕ), x_2 (x - x_1) v_1) _ $
                 pi.omega_complete_partial_order.flip₁_continuous'
                   (λ (v : ℕ) (g : ℕ → ℕ → roption ℕ) (x : ℕ), g v x) _ id_continuous')
               (const_continuous' (pure x)))))

-- automation coming soon
theorem div.equations.eqn_1 (x y : ℕ) : div x y = if y ≤ x ∧ y > 0 then div (x - y) y else pure x :=
by conv_lhs { rw [div, lawful_fix.fix_eq' div.cont] }; refl

inductive tree (α : Type*)
| nil {} : tree
| node (x : α) : tree → tree → tree

open roption.examples.tree

/-! `map` on a `tree` using monadic notation -/
def tree_map.intl {α β : Type*} (f : α → β) (tree_map : tree α → roption (tree β)) :
  tree α → roption (tree β)
| nil := pure nil
| (node x t₀ t₁) :=
do tt₀ ← tree_map t₀,
   tt₁ ← tree_map t₁,
   pure $ node (f x) tt₀ tt₁

-- automation coming soon
def tree_map {α : Type u_1} {β : Type u_2} (f : α → β) : tree α → roption (tree β) :=
fix (tree_map.intl f)

-- automation coming soon
theorem tree_map.cont :
  ∀ {α : Type u_1} {β : Type u_2} (f : α → β), continuous' (tree_map.intl f) :=
λ {α : Type u_1} {β : Type u_2} (f : α → β),
  pi.omega_complete_partial_order.flip₂_continuous' (tree_map.intl f)
    (λ (x : tree α),
       tree.cases_on x (id (const_continuous' (pure nil)))
         (λ (x_x : α) (x_a x_a_1 : tree α),
              (continuous_hom.bind_continuous' (λ (x : tree α → roption (tree β)), x x_a)
                 (λ (x : tree α → roption (tree β)) (tt₀ : tree β),
                    x x_a_1 >>= λ (tt₁ : tree β), pure (node (f x_x) tt₀ tt₁))
                 (pi.omega_complete_partial_order.flip₁_continuous' (λ (v : tree α) (x : tree α → roption (tree β)), x v) x_a id_continuous')
                 (pi.omega_complete_partial_order.flip₂_continuous'
                    (λ (x : tree α → roption (tree β)) (tt₀ : tree β),
                       x x_a_1 >>= λ (tt₁ : tree β), pure (node (f x_x) tt₀ tt₁))
                    (λ (x : tree β),
                       continuous_hom.bind_continuous' (λ (x : tree α → roption (tree β)), x x_a_1)
                         (λ (x_1 : tree α → roption (tree β)) (tt₁ : tree β), pure (node (f x_x) x tt₁))
                         (pi.omega_complete_partial_order.flip₁_continuous' (λ (v : tree α) (x : tree α → roption (tree β)), x v) x_a_1
                            id_continuous')
                         (pi.omega_complete_partial_order.flip₂_continuous'
                            (λ (x_1 : tree α → roption (tree β)) (tt₁ : tree β), pure (node (f x_x) x tt₁))
                            (λ (x_1 : tree β), const_continuous' (pure (node (f x_x) x x_1)))))))))

-- automation coming soon
theorem tree_map.equations.eqn_1 {α : Type u_1} {β : Type u_2} (f : α → β) :
  tree_map f nil = pure nil :=
by rw [tree_map,lawful_fix.fix_eq' (tree_map.cont f)]; refl

-- automation coming soon
theorem tree_map.equations.eqn_2 {α : Type u_1} {β : Type u_2} (f : α → β) (x : α)
  (t₀ t₁ : tree α) :
  tree_map f (node x t₀ t₁) = tree_map f t₀ >>= λ (tt₀ : tree β), tree_map f t₁ >>=
    λ (tt₁ : tree β), pure (node (f x) tt₀ tt₁) :=
by conv_lhs { rw [tree_map,lawful_fix.fix_eq' (tree_map.cont f)] }; refl

/-! `map` on a `tree` using applicative notation -/

def tree_map'.intl {α β} (f : α → β) (tree_map : tree α → roption (tree β)) :
  tree α → roption (tree β)
| nil := pure nil
| (node x t₀ t₁) :=
node (f x) <$> tree_map t₀ <*> tree_map t₁

-- automation coming soon
def tree_map' {α : Type u_1} {β : Type u_2} (f : α → β) : tree α → roption (tree β) :=
fix (tree_map'.intl f)

-- automation coming soon
theorem tree_map'.cont :
  ∀ {α : Type u_1} {β : Type u_2} (f : α → β), continuous' (tree_map'.intl f) :=
λ {α : Type u_1} {β : Type u_2} (f : α → β),
  pi.omega_complete_partial_order.flip₂_continuous' (tree_map'.intl f)
    (λ (x : tree α),
       tree.cases_on x (id (const_continuous' (pure nil)))
         (λ (x_x : α) (x_a x_a_1 : tree α),
              (continuous_hom.seq_continuous' (λ (x : tree α → roption (tree β)), node (f x_x) <$> x x_a)
                 (λ (x : tree α → roption (tree β)), x x_a_1)
                 (continuous_hom.map_continuous' (node (f x_x)) (λ (x : tree α → roption (tree β)), x x_a)
                    (pi.omega_complete_partial_order.flip₁_continuous' (λ (v : tree α) (x : tree α → roption (tree β)), x v) x_a id_continuous'))
                 (pi.omega_complete_partial_order.flip₁_continuous' (λ (v : tree α) (x : tree α → roption (tree β)), x v) x_a_1 id_continuous'))))

-- automation coming soon
theorem tree_map'.equations.eqn_1 {α : Type u_1} {β : Type u_2} (f : α → β) :
  tree_map' f nil = pure nil :=
by rw [tree_map',lawful_fix.fix_eq' (tree_map'.cont f)]; refl

-- automation coming soon
theorem tree_map'.equations.eqn_2 {α : Type u_1} {β : Type u_2} (f : α → β) (x : α) (t₀ t₁ : tree α) :
  tree_map' f (node x t₀ t₁) = node (f x) <$> tree_map' f t₀ <*> tree_map' f t₁ :=
by conv_lhs { rw [tree_map',lawful_fix.fix_eq' (tree_map'.cont f)] }; refl

/-! f91 is a function whose proof of termination cannot rely on the structural
ordering of its arguments and does not use the usual well-founded order
on natural numbers. It is an interesting candidate to show that `fix` lets us disentangle
the issue of termination from the definition of the function. -/

def f91.intl (f91 : ℕ → roption ℕ) (n : ℕ) : roption ℕ :=
if n > 100
  then pure $ n - 10
  else f91 (n + 11) >>= f91

-- automation coming soon
def f91 : ℕ → roption ℕ := fix f91.intl

-- automation coming soon
lemma f91.cont : continuous' f91.intl :=
pi.omega_complete_partial_order.flip₂_continuous' f91.intl
  (λ (x : ℕ),
     id
       (continuous_hom.ite_continuous' (λ (x_1 : ℕ → roption ℕ), pure (x - 10)) (λ (x_1 : ℕ → roption ℕ), x_1 (x + 11) >>= x_1)
          (const_continuous' (pure (x - 10)))
          (continuous_hom.bind_continuous' (λ (x_1 : ℕ → roption ℕ), x_1 (x + 11)) (λ (x : ℕ → roption ℕ), x)
             (pi.omega_complete_partial_order.flip₁_continuous' (λ (v : ℕ) (x : ℕ → roption ℕ), x v) (x + 11) id_continuous')
             (pi.omega_complete_partial_order.flip₂_continuous' (λ (x : ℕ → roption ℕ), x)
                (λ (x_1 : ℕ), pi.omega_complete_partial_order.flip₁_continuous' (λ (v : ℕ) (g : ℕ → roption ℕ), g v) x_1 id_continuous')))))
.
-- automation coming soon
theorem f91.equations.eqn_1 (n : ℕ) : f91 n = ite (n > 100) (pure (n - 10)) (f91 (n + 11) >>= f91) :=
by conv_lhs { rw [f91, lawful_fix.fix_eq' f91.cont] }; refl

lemma f91_spec (n : ℕ) : (∃ n', n < n' + 11 ∧ n' ∈ f91 n) :=
begin
  apply well_founded.induction (measure_wf $ λ n, 101 - n) n,
  clear n, dsimp [measure,inv_image], intros n ih,
  by_cases h' : n > 100,
  { rw [roption.examples.f91.equations.eqn_1,if_pos h'],
    existsi n - 10, rw nat.sub_add_eq_add_sub, norm_num [pure],
    apply le_of_lt, transitivity 100, norm_num, exact h' },
  { rw [roption.examples.f91.equations.eqn_1,if_neg h'],
    simp, rcases ih (n + 11) _ with ⟨n',hn₀,hn₁⟩,
    rcases ih (n') _ with ⟨n'',hn'₀,hn'₁⟩,
    refine ⟨n'',_,_,hn₁,hn'₁⟩,
    { clear ih hn₁ hn'₁, omega },
    { clear ih hn₁, omega },
    { clear ih, omega } },
end

lemma f91_dom (n : ℕ) : (f91 n).dom :=
by rw roption.dom_iff_mem; apply exists_imp_exists _ (f91_spec n); simp

def f91' (n : ℕ) : ℕ := (f91 n).get (f91_dom n)

run_cmd guard (f91' 109 = 99)

lemma f91_spec' (n : ℕ) : f91' n = if n > 100 then n - 10 else 91 :=
begin
  suffices : (∃ n', n' ∈ f91 n ∧ n' = if n > 100 then n - 10 else 91),
  { dsimp [f91'], rw roption.get_eq_of_mem,
    rcases this with ⟨n,_,_⟩, subst n, assumption },
  apply well_founded.induction (measure_wf $ λ n, 101 - n) n,
  clear n, dsimp [measure,inv_image], intros n ih,
  by_cases h' : n > 100,
  { rw [roption.examples.f91.equations.eqn_1,if_pos h',if_pos h'],
    simp [pure] },
  { rw [roption.examples.f91.equations.eqn_1,if_neg h',if_neg h'],
    simp, rcases ih (n + 11) _ with ⟨n',hn'₀,hn'₁⟩,
    split_ifs at hn'₁,
    { subst hn'₁, norm_num at hn'₀, refine ⟨_,hn'₀,_⟩,
      rcases ih (n+1) _ with ⟨n',hn'₀,hn'₁⟩,
      split_ifs at hn'₁,
      { subst n', convert hn'₀, clear hn'₀ hn'₀ ih, omega },
      { subst n', exact hn'₀ },
      { clear ih hn'₀, omega } },
    { refine ⟨_,hn'₀,_⟩, subst n',
      rcases ih 91 _ with ⟨n',hn'₀,hn'₁⟩,
      rw if_neg at hn'₁, subst n', exact hn'₀,
      { clear ih hn'₀ hn'₀, omega, },
      { clear ih hn'₀, omega, } },
    { clear ih, omega } }
end

end roption.examples


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.sheaves.sheaf
import Mathlib.category_theory.limits.preserves.shapes.products
import Mathlib.category_theory.limits.types
import Mathlib.PostPort

universes u₁ v u₂

namespace Mathlib

/-!
# Checking the sheaf condition on the underlying presheaf of types.

If `G : C ⥤ D` is a functor which reflects isomorphisms and preserves limits
(we assume all limits exist in both `C` and `D`),
then checking the sheaf condition for a presheaf `F : presheaf C X`
is equivalent to checking the sheaf condition for `F ⋙ G`.

The important special case is when
`C` is a concrete category with a forgetful functor
that preserves limits and reflects isomorphisms.
Then to check the sheaf condition it suffices
to check it on the underlying sheaf of types.

## References
* https://stacks.math.columbia.edu/tag/0073
-/

namespace Top

namespace presheaf

namespace sheaf_condition

/--
When `G` preserves limits, the sheaf condition diagram for `F` composed with `G` is
naturally isomorphic to the sheaf condition diagram for `F ⋙ G`.
-/
def diagram_comp_preserves_limits {C : Type u₁} [category_theory.category C]
    [category_theory.limits.has_limits C] {D : Type u₂} [category_theory.category D]
    [category_theory.limits.has_limits D] (G : C ⥤ D) [category_theory.limits.preserves_limits G]
    {X : Top} (F : presheaf C X) {ι : Type v} (U : ι → topological_space.opens ↥X) :
    sheaf_condition_equalizer_products.diagram F U ⋙ G ≅
        sheaf_condition_equalizer_products.diagram (F ⋙ G) U :=
  category_theory.nat_iso.of_components
    (fun (X_1 : category_theory.limits.walking_parallel_pair) =>
      category_theory.limits.walking_parallel_pair.cases_on X_1
        (category_theory.limits.preserves_product.iso G
          fun (i : ι) => category_theory.functor.obj F (opposite.op (U i)))
        (category_theory.limits.preserves_product.iso G
          fun (p : ι × ι) =>
            category_theory.functor.obj F (opposite.op (U (prod.fst p) ⊓ U (prod.snd p)))))
    sorry

/--
When `G` preserves limits, the image under `G` of the sheaf condition fork for `F`
is the sheaf condition fork for `F ⋙ G`,
postcomposed with the inverse of the natural isomorphism `diagram_comp_preserves_limits`.
-/
def map_cone_fork {C : Type u₁} [category_theory.category C] [category_theory.limits.has_limits C]
    {D : Type u₂} [category_theory.category D] [category_theory.limits.has_limits D] (G : C ⥤ D)
    [category_theory.limits.preserves_limits G] {X : Top} (F : presheaf C X) {ι : Type v}
    (U : ι → topological_space.opens ↥X) :
    category_theory.functor.map_cone G (sheaf_condition_equalizer_products.fork F U) ≅
        category_theory.functor.obj
          (category_theory.limits.cones.postcompose
            (category_theory.iso.inv (diagram_comp_preserves_limits G F U)))
          (sheaf_condition_equalizer_products.fork (F ⋙ G) U) :=
  category_theory.limits.cones.ext
    (category_theory.iso.refl
      (category_theory.limits.cone.X
        (category_theory.functor.map_cone G (sheaf_condition_equalizer_products.fork F U))))
    sorry

end sheaf_condition

/--
If `G : C ⥤ D` is a functor which reflects isomorphisms and preserves limits
(we assume all limits exist in both `C` and `D`),
then checking the sheaf condition for a presheaf `F : presheaf C X`
is equivalent to checking the sheaf condition for `F ⋙ G`.

The important special case is when
`C` is a concrete category with a forgetful functor
that preserves limits and reflects isomorphisms.
Then to check the sheaf condition it suffices to check it on the underlying sheaf of types.

Another useful example is the forgetful functor `TopCommRing ⥤ Top`.

See https://stacks.math.columbia.edu/tag/0073.
In fact we prove a stronger version with arbitrary complete target category.
-/
def sheaf_condition_equiv_sheaf_condition_comp {C : Type u₁} [category_theory.category C]
    {D : Type u₂} [category_theory.category D] (G : C ⥤ D) [category_theory.reflects_isomorphisms G]
    [category_theory.limits.has_limits C] [category_theory.limits.has_limits D]
    [category_theory.limits.preserves_limits G] {X : Top} (F : presheaf C X) :
    sheaf_condition F ≃ sheaf_condition (F ⋙ G) :=
  sorry

end Mathlib


/-
Copyright (c) 2022 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import morphisms.basic
import topology.local_at_target
import algebraic_geometry.misc

/-!

# Open immersions

A morphism is an open immersions if the underlying map of spaces is an open embedding
`f : X ⟶ U ⊆ Y`, and the sheaf map `Y(V) ⟶ f _* X(V)` is an iso for each `V ⊆ U`.

Most of the theories are developed in `algebraic_geometry/open_immersion`, and we provide the
remaining theorems analogous to other lemmas in `algebraic_geometry/morphisms/*`.

-/

noncomputable theory

open category_theory category_theory.limits opposite topological_space

universe u

namespace algebraic_geometry

variables {X Y Z : Scheme.{u}} (f : X ⟶ Y) (g : Y ⟶ Z)

lemma is_open_immersion_iff_stalk {f : X ⟶ Y} :
  is_open_immersion f ↔
    open_embedding f.1.base ∧ ∀ x, is_iso (PresheafedSpace.stalk_map f.1 x) :=
begin
  split,
  { intro h, exactI ⟨h.1, infer_instance⟩ },
  { rintro ⟨h₁, h₂⟩, exactI is_open_immersion.of_stalk_iso f h₁ }
end

lemma is_open_immersion_stable_under_composition :
  morphism_property.stable_under_composition @is_open_immersion :=
begin
  introsI X Y Z f g h₁ h₂, apply_instance
end

lemma is_open_immersion_respects_iso :
  morphism_property.respects_iso @is_open_immersion :=
begin
  apply is_open_immersion_stable_under_composition.respects_iso,
  intros _ _ _, apply_instance
end

lemma is_open_immersion_is_local_at_target : property_is_local_at_target @is_open_immersion :=
begin
  constructor,
  { exact is_open_immersion_respects_iso },
  { introsI, apply_instance },
  { intros X Y f 𝒰 H,
    rw is_open_immersion_iff_stalk,
    split,
    { apply (open_embedding_iff_open_embedding_of_supr_eq_top
        𝒰.supr_opens_range f.1.base.2).mpr,
      intro i,
      have := ((is_open_immersion_respects_iso.arrow_iso_iff
        (morphism_restrict_opens_range f (𝒰.map i))).mpr (H i)).1,
      rwa [arrow.mk_hom, morphism_restrict_val_base] at this },
    { intro x,
      have := arrow.iso_w (morphism_restrict_stalk_map f ((𝒰.map $ 𝒰.f $ f.1 x).opens_range)
        ⟨x, 𝒰.covers _⟩),
      dsimp only [arrow.mk_hom] at this,
      rw this,
      haveI : is_open_immersion (f ∣_ (𝒰.map $ 𝒰.f $ f.1 x).opens_range) :=
        (is_open_immersion_respects_iso.arrow_iso_iff
          (morphism_restrict_opens_range f (𝒰.map _))).mpr (H _),
      apply_instance } }
end

lemma is_open_immersion.open_cover_tfae {X Y : Scheme.{u}} (f : X ⟶ Y) :
  tfae [is_open_immersion f,
    ∃ (𝒰 : Scheme.open_cover.{u} Y), ∀ (i : 𝒰.J),
      is_open_immersion (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i),
    ∀ (𝒰 : Scheme.open_cover.{u} Y) (i : 𝒰.J),
      is_open_immersion (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i),
    ∀ (U : opens Y.carrier), is_open_immersion (f ∣_ U),
    ∀ {U : Scheme} (g : U ⟶ Y) [is_open_immersion g],
      is_open_immersion (pullback.snd : pullback f g ⟶ _),
    ∃ {ι : Type u} (U : ι → opens Y.carrier) (hU : supr U = ⊤),
      ∀ i, is_open_immersion (f ∣_ (U i))] :=
is_open_immersion_is_local_at_target.open_cover_tfae f

lemma is_open_immersion.open_cover_iff {X Y : Scheme.{u}}
  (𝒰 : Scheme.open_cover.{u} Y) (f : X ⟶ Y) :
  is_open_immersion f ↔ ∀ i, is_open_immersion (pullback.snd : pullback f (𝒰.map i) ⟶ _) :=
is_open_immersion_is_local_at_target.open_cover_iff f 𝒰

lemma is_open_immersion_stable_under_base_change :
  morphism_property.stable_under_base_change @is_open_immersion :=
morphism_property.stable_under_base_change.mk is_open_immersion_respects_iso $
  by { introsI X Y Z f g H, apply_instance }

end algebraic_geometry


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta
-/
import category_theory.limits.shapes.pullbacks
import category_theory.limits.shapes.strong_epi
import category_theory.limits.shapes.equalizers

/-!
# Definitions and basic properties of regular monomorphisms and epimorphisms.

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

A regular monomorphism is a morphism that is the equalizer of some parallel pair.

We give the constructions
* `is_split_mono → regular_mono` and
* `regular_mono → mono`
as well as the dual constructions for regular epimorphisms. Additionally, we give the construction
* `regular_epi ⟶ strong_epi`.

We also define classes `regular_mono_category` and `regular_epi_category` for categories in which
every monomorphism or epimorphism is regular, and deduce that these categories are
`strong_mono_category`s resp. `strong_epi_category`s.

-/

noncomputable theory

namespace category_theory
open category_theory.limits

universes v₁ u₁ u₂

variables {C : Type u₁} [category.{v₁} C]

variables {X Y : C}

/-- A regular monomorphism is a morphism which is the equalizer of some parallel pair. -/
class regular_mono (f : X ⟶ Y) :=
(Z : C)
(left right : Y ⟶ Z)
(w : f ≫ left = f ≫ right)
(is_limit : is_limit (fork.of_ι f w))

attribute [reassoc] regular_mono.w

/-- Every regular monomorphism is a monomorphism. -/
@[priority 100]
instance regular_mono.mono (f : X ⟶ Y) [regular_mono f] : mono f :=
mono_of_is_limit_fork regular_mono.is_limit

instance equalizer_regular (g h : X ⟶ Y) [has_limit (parallel_pair g h)] :
  regular_mono (equalizer.ι g h) :=
{ Z := Y,
  left := g,
  right := h,
  w := equalizer.condition g h,
  is_limit := fork.is_limit.mk _ (λ s, limit.lift _ s) (by simp) (λ s m w, by { ext1, simp [←w] }) }

/-- Every split monomorphism is a regular monomorphism. -/
@[priority 100]
instance regular_mono.of_is_split_mono (f : X ⟶ Y) [is_split_mono f] : regular_mono f :=
{ Z     := Y,
  left  := 𝟙 Y,
  right := retraction f ≫ f,
  w     := by tidy,
  is_limit := is_split_mono_equalizes f }

/-- If `f` is a regular mono, then any map `k : W ⟶ Y` equalizing `regular_mono.left` and
    `regular_mono.right` induces a morphism `l : W ⟶ X` such that `l ≫ f = k`. -/
def regular_mono.lift' {W : C} (f : X ⟶ Y) [regular_mono f] (k : W ⟶ Y)
  (h : k ≫ (regular_mono.left : Y ⟶ @regular_mono.Z _ _ _ _ f _) = k ≫ regular_mono.right) :
  {l : W ⟶ X // l ≫ f = k} :=
fork.is_limit.lift' regular_mono.is_limit _ h

/--
The second leg of a pullback cone is a regular monomorphism if the right component is too.

See also `pullback.snd_of_mono` for the basic monomorphism version, and
`regular_of_is_pullback_fst_of_regular` for the flipped version.
-/
def regular_of_is_pullback_snd_of_regular {P Q R S : C} {f : P ⟶ Q} {g : P ⟶ R} {h : Q ⟶ S}
  {k : R ⟶ S} [hr : regular_mono h] (comm : f ≫ h = g ≫ k)
  (t : is_limit (pullback_cone.mk _ _ comm)) :
regular_mono g :=
{ Z := hr.Z,
  left := k ≫ hr.left,
  right := k ≫ hr.right,
  w := by rw [← reassoc_of comm, ← reassoc_of comm, hr.w],
  is_limit :=
  begin
    apply fork.is_limit.mk' _ _,
    intro s,
    have l₁ : (fork.ι s ≫ k) ≫ regular_mono.left = (fork.ι s ≫ k) ≫ regular_mono.right,
      rw [category.assoc, s.condition, category.assoc],
    obtain ⟨l, hl⟩ := fork.is_limit.lift' hr.is_limit _ l₁,
    obtain ⟨p, hp₁, hp₂⟩ := pullback_cone.is_limit.lift' t _ _ hl,
    refine ⟨p, hp₂, _⟩,
    intros m w,
    have z : m ≫ g = p ≫ g := w.trans hp₂.symm,
    apply t.hom_ext,
    apply (pullback_cone.mk f g comm).equalizer_ext,
    { erw [← cancel_mono h, category.assoc, category.assoc, comm, reassoc_of z] },
    { exact z },
  end }

/--
The first leg of a pullback cone is a regular monomorphism if the left component is too.

See also `pullback.fst_of_mono` for the basic monomorphism version, and
`regular_of_is_pullback_snd_of_regular` for the flipped version.
-/
def regular_of_is_pullback_fst_of_regular {P Q R S : C} {f : P ⟶ Q} {g : P ⟶ R} {h : Q ⟶ S}
  {k : R ⟶ S} [hr : regular_mono k] (comm : f ≫ h = g ≫ k)
  (t : is_limit (pullback_cone.mk _ _ comm)) :
regular_mono f :=
regular_of_is_pullback_snd_of_regular comm.symm (pullback_cone.flip_is_limit t)

@[priority 100]
instance strong_mono_of_regular_mono (f : X ⟶ Y) [regular_mono f] : strong_mono f :=
strong_mono.mk' begin
  introsI A B z hz u v sq,
  have : v ≫ (regular_mono.left : Y ⟶ regular_mono.Z f) = v ≫ regular_mono.right,
  { apply (cancel_epi z).1,
    simp only [regular_mono.w, ← reassoc_of sq.w] },
  obtain ⟨t, ht⟩ := regular_mono.lift' _ _ this,
  refine comm_sq.has_lift.mk' ⟨t, (cancel_mono f).1 _, ht⟩,
  simp only [arrow.mk_hom, arrow.hom_mk'_left, category.assoc, ht, sq.w],
end

/-- A regular monomorphism is an isomorphism if it is an epimorphism. -/
lemma is_iso_of_regular_mono_of_epi (f : X ⟶ Y) [regular_mono f] [e : epi f] : is_iso f :=
is_iso_of_epi_of_strong_mono _

section
variables (C)

/-- A regular mono category is a category in which every monomorphism is regular. -/
class regular_mono_category :=
(regular_mono_of_mono : ∀ {X Y : C} (f : X ⟶ Y) [mono f], regular_mono f)

end

/-- In a category in which every monomorphism is regular, we can express every monomorphism as
    an equalizer. This is not an instance because it would create an instance loop. -/
def regular_mono_of_mono [regular_mono_category C] (f : X ⟶ Y) [mono f] : regular_mono f :=
regular_mono_category.regular_mono_of_mono _

@[priority 100]
instance regular_mono_category_of_split_mono_category [split_mono_category C] :
  regular_mono_category C :=
{ regular_mono_of_mono := λ _ _ f _,
  by { haveI := by exactI is_split_mono_of_mono f, apply_instance } }

@[priority 100]
instance strong_mono_category_of_regular_mono_category [regular_mono_category C] :
  strong_mono_category C :=
{ strong_mono_of_mono := λ _ _ f _,
    by { haveI := by exactI regular_mono_of_mono f, apply_instance } }

/-- A regular epimorphism is a morphism which is the coequalizer of some parallel pair. -/
class regular_epi (f : X ⟶ Y) :=
(W : C)
(left right : W ⟶ X)
(w : left ≫ f = right ≫ f)
(is_colimit : is_colimit (cofork.of_π f w))

attribute [reassoc] regular_epi.w

/-- Every regular epimorphism is an epimorphism. -/
@[priority 100]
instance regular_epi.epi (f : X ⟶ Y) [regular_epi f] : epi f :=
epi_of_is_colimit_cofork regular_epi.is_colimit

instance coequalizer_regular (g h : X ⟶ Y) [has_colimit (parallel_pair g h)] :
  regular_epi (coequalizer.π g h) :=
{ W := X,
  left := g,
  right := h,
  w := coequalizer.condition g h,
  is_colimit := cofork.is_colimit.mk _ (λ s, colimit.desc _ s) (by simp)
    (λ s m w, by { ext1, simp [←w] }) }

/-- Every split epimorphism is a regular epimorphism. -/
@[priority 100]
instance regular_epi.of_split_epi (f : X ⟶ Y) [is_split_epi f] : regular_epi f :=
{ W     := X,
  left  := 𝟙 X,
  right := f ≫ section_ f,
  w     := by tidy,
  is_colimit := is_split_epi_coequalizes f }

/-- If `f` is a regular epi, then every morphism `k : X ⟶ W` coequalizing `regular_epi.left` and
    `regular_epi.right` induces `l : Y ⟶ W` such that `f ≫ l = k`. -/
def regular_epi.desc' {W : C} (f : X ⟶ Y) [regular_epi f] (k : X ⟶ W)
  (h : (regular_epi.left : regular_epi.W f ⟶ X) ≫ k = regular_epi.right ≫ k) :
  {l : Y ⟶ W // f ≫ l = k} :=
cofork.is_colimit.desc' (regular_epi.is_colimit) _ h

/--
The second leg of a pushout cocone is a regular epimorphism if the right component is too.

See also `pushout.snd_of_epi` for the basic epimorphism version, and
`regular_of_is_pushout_fst_of_regular` for the flipped version.
-/
def regular_of_is_pushout_snd_of_regular
  {P Q R S : C} {f : P ⟶ Q} {g : P ⟶ R} {h : Q ⟶ S} {k : R ⟶ S}
  [gr : regular_epi g] (comm : f ≫ h = g ≫ k) (t : is_colimit (pushout_cocone.mk _ _ comm)) :
regular_epi h :=
{ W := gr.W,
  left := gr.left ≫ f,
  right := gr.right ≫ f,
  w := by rw [category.assoc, category.assoc, comm, reassoc_of gr.w],
  is_colimit :=
  begin
    apply cofork.is_colimit.mk' _ _,
    intro s,
    have l₁ : gr.left ≫ f ≫ s.π = gr.right ≫ f ≫ s.π,
      rw [← category.assoc, ← category.assoc, s.condition],
    obtain ⟨l, hl⟩ := cofork.is_colimit.desc' gr.is_colimit (f ≫ cofork.π s) l₁,
    obtain ⟨p, hp₁, hp₂⟩ := pushout_cocone.is_colimit.desc' t _ _ hl.symm,
    refine ⟨p, hp₁, _⟩,
    intros m w,
    have z := w.trans hp₁.symm,
    apply t.hom_ext,
    apply (pushout_cocone.mk _ _ comm).coequalizer_ext,
    { exact z },
    { erw [← cancel_epi g, ← reassoc_of comm, ← reassoc_of comm, z], refl },
  end }

/--
The first leg of a pushout cocone is a regular epimorphism if the left component is too.

See also `pushout.fst_of_epi` for the basic epimorphism version, and
`regular_of_is_pushout_snd_of_regular` for the flipped version.
-/
def regular_of_is_pushout_fst_of_regular
  {P Q R S : C} {f : P ⟶ Q} {g : P ⟶ R} {h : Q ⟶ S} {k : R ⟶ S}
  [fr : regular_epi f] (comm : f ≫ h = g ≫ k) (t : is_colimit (pushout_cocone.mk _ _ comm)) :
regular_epi k :=
regular_of_is_pushout_snd_of_regular comm.symm (pushout_cocone.flip_is_colimit t)

@[priority 100]
instance strong_epi_of_regular_epi (f : X ⟶ Y) [regular_epi f] : strong_epi f :=
strong_epi.mk' begin
  introsI A B z hz u v sq,
  have : (regular_epi.left : regular_epi.W f ⟶ X) ≫ u = regular_epi.right ≫ u,
  { apply (cancel_mono z).1,
    simp only [category.assoc, sq.w, regular_epi.w_assoc] },
  obtain ⟨t, ht⟩ := regular_epi.desc' f u this,
  exact comm_sq.has_lift.mk' ⟨t, ht, (cancel_epi f).1
    (by simp only [←category.assoc, ht, ←sq.w, arrow.mk_hom, arrow.hom_mk'_right])⟩,
end

/-- A regular epimorphism is an isomorphism if it is a monomorphism. -/
lemma is_iso_of_regular_epi_of_mono (f : X ⟶ Y) [regular_epi f] [m : mono f] : is_iso f :=
is_iso_of_mono_of_strong_epi _

section
variables (C)

/-- A regular epi category is a category in which every epimorphism is regular. -/
class regular_epi_category :=
(regular_epi_of_epi : ∀ {X Y : C} (f : X ⟶ Y) [epi f], regular_epi f)

end

/-- In a category in which every epimorphism is regular, we can express every epimorphism as
    a coequalizer. This is not an instance because it would create an instance loop. -/
def regular_epi_of_epi [regular_epi_category C] (f : X ⟶ Y) [epi f] : regular_epi f :=
regular_epi_category.regular_epi_of_epi _

@[priority 100]
instance regular_epi_category_of_split_epi_category [split_epi_category C] :
  regular_epi_category C :=
{ regular_epi_of_epi := λ _ _ f _, by { haveI := by exactI is_split_epi_of_epi f, apply_instance } }

@[priority 100]
instance strong_epi_category_of_regular_epi_category [regular_epi_category C] :
  strong_epi_category C :=
{ strong_epi_of_epi := λ _ _ f _, by { haveI := by exactI regular_epi_of_epi f, apply_instance } }

end category_theory