import for_mathlib.short_complex_projections
import for_mathlib.homological_complex_abelian
import for_mathlib.homology_map_datum
import for_mathlib.abelian_sheaves.functor_category
import for_mathlib.short_complex_functor_category

noncomputable theory

open category_theory category_theory.category category_theory.limits
open_locale zero_object

universes v

namespace short_complex

section construction

variables {C : Type*} [category C] [has_zero_morphisms C]
variables {J : Type*} [category J] (F : J ⥤ short_complex C)
  [has_colimit (F ⋙ π₁)] [has_colimit (F ⋙ π₂)] [has_colimit (F ⋙ π₃)]

@[simps]
def colimit_cocone.cocone : cocone F :=
{ X := mk (colim_map (𝟙 F ◫ φ₁₂)) (colim_map (𝟙 F ◫ φ₂₃)) begin
    ext,
    dsimp,
    simp only [ι_colim_map_assoc, nat_trans.hcomp_app, φ₁₂_app, nat_trans.id_app, π₂_map,
      ι_colim_map, φ₂₃_app, π₃_map, assoc, comp_zero],
    erw [composable_morphisms.id_τ₂, id_comp, (F.obj j).zero_assoc, zero_comp],
  end,
  ι :=
    { app := λ j, begin
        refine ⟨colimit.ι (F ⋙ π₁) j, colimit.ι (F ⋙ π₂) j, colimit.ι (F ⋙ π₃) j, _, _⟩,
        { dsimp,
          simp only [ι_colim_map, nat_trans.hcomp_app, φ₁₂_app, nat_trans.id_app, π₂_map,
            assoc],
          erw [composable_morphisms.id_τ₂, id_comp], },
        { dsimp,
          simp only [ι_colim_map, nat_trans.hcomp_app, φ₂₃_app, nat_trans.id_app, π₃_map,
            assoc],
          erw [composable_morphisms.id_τ₃, id_comp], },
      end,
      naturality' := λ i j f, begin
        ext,
        { dsimp, simpa only [comp_id] using colimit.w (F ⋙ π₁) f, },
        { dsimp, simpa only [comp_id] using colimit.w (F ⋙ π₂) f, },
        { dsimp, simpa only [comp_id] using colimit.w (F ⋙ π₃) f, },
      end }, }

def colimit_cocone : colimit_cocone F :=
{ cocone := colimit_cocone.cocone F,
  is_colimit :=
  { desc := λ s, begin
      refine ⟨colimit.desc (F ⋙ π₁) (π₁.map_cocone s),
        colimit.desc (F ⋙ π₂) (π₂.map_cocone s),
        colimit.desc (F ⋙ π₃) (π₃.map_cocone s), _, _⟩,
      { ext,
        dsimp,
        simp only [ι_colim_map_assoc, nat_trans.hcomp_app, φ₁₂_app, nat_trans.id_app,
          π₂_map, colimit.ι_desc, functor.map_cocone_ι_app, assoc, colimit.ι_desc_assoc, π₁_map],
        erw [composable_morphisms.id_τ₂, id_comp],
        exact (s.ι.app j).comm₁₂, },
      { ext,
        dsimp,
        simp only [ι_colim_map_assoc, nat_trans.hcomp_app, φ₂₃_app, nat_trans.id_app,
          π₃_map, colimit.ι_desc, functor.map_cocone_ι_app, assoc, colimit.ι_desc_assoc, π₂_map],
        erw [composable_morphisms.id_τ₃, id_comp],
        exact (s.ι.app j).comm₂₃, },
    end,
    fac' := λ s j, begin
      ext,
      { dsimp, simp only [colimit.ι_desc, functor.map_cocone_ι_app, π₁_map], },
      { dsimp, simp only [colimit.ι_desc, functor.map_cocone_ι_app, π₂_map], },
      { dsimp, simp only [colimit.ι_desc, functor.map_cocone_ι_app, π₃_map], },
    end,
    uniq' := λ s m hm, begin
      have h₁ := λ j, congr_arg (λ (φ : F.obj j ⟶ s.X), π₁.map φ) (hm j),
      have h₂ := λ j, congr_arg (λ (φ : F.obj j ⟶ s.X), π₂.map φ) (hm j),
      have h₃ := λ j, congr_arg (λ (φ : F.obj j ⟶ s.X), π₃.map φ) (hm j),
      dsimp at h₁ h₂ h₃,
      ext,
      { dsimp, simp only [h₁, colimit.ι_desc, functor.map_cocone_ι_app, π₁_map], },
      { dsimp, simp only [h₂, colimit.ι_desc, functor.map_cocone_ι_app, π₂_map], },
      { dsimp, simp only [h₃, colimit.ι_desc, functor.map_cocone_ι_app, π₃_map], },
    end, }, }

instance : has_colimit F := ⟨nonempty.intro (colimit_cocone F)⟩

def π₁_preserves_colimit : preserves_colimit F (π₁ : short_complex C ⥤ C) :=
preserves_colimit_of_preserves_colimit_cocone (colimit_cocone F).is_colimit
  (is_colimit.of_iso_colimit (get_colimit_cocone (F ⋙ π₁)).is_colimit
    (cocones.ext (iso.refl _) (λ j, comp_id _)))

def π₂_preserves_colimit : preserves_colimit F (π₂ : short_complex C ⥤ C) :=
preserves_colimit_of_preserves_colimit_cocone (colimit_cocone F).is_colimit
  (is_colimit.of_iso_colimit (get_colimit_cocone (F ⋙ π₂)).is_colimit
    (cocones.ext (iso.refl _) (λ j, comp_id _)))

def π₃_preserves_colimit : preserves_colimit F (π₃ : short_complex C ⥤ C) :=
preserves_colimit_of_preserves_colimit_cocone (colimit_cocone F).is_colimit
  (is_colimit.of_iso_colimit (get_colimit_cocone (F ⋙ π₃)).is_colimit
    (cocones.ext (iso.refl _) (λ j, comp_id _)))

end construction

section preserves

variables {C : Type*} [category C] [has_zero_morphisms C]
variables {J D : Type*} [category J] [category D]

def π₁₂₃_reflects_colimits {F : J ⥤ short_complex C} (s : cocone F)
  (h₁ : is_colimit (π₁.map_cocone s)) (h₂ : is_colimit (π₂.map_cocone s))
  (h₃ : is_colimit (π₃.map_cocone s)) :
  is_colimit s :=
begin
  haveI : has_colimit (F ⋙ π₁) := ⟨nonempty.intro ⟨_, h₁⟩⟩,
  haveI : has_colimit (F ⋙ π₂) := ⟨nonempty.intro ⟨_, h₂⟩⟩,
  haveI : has_colimit (F ⋙ π₃) := ⟨nonempty.intro ⟨_, h₃⟩⟩,
  refine is_colimit.of_iso_colimit (colimit_cocone F).is_colimit (cocones.ext _ _),
  { suffices : is_iso ((colimit_cocone F).is_colimit.desc s),
    { haveI := this,
      exact as_iso ((colimit_cocone F).is_colimit.desc s), },
    apply is_iso_of_is_isos,
    { exact is_iso.of_iso (is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit _) h₁), },
    { exact is_iso.of_iso (is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit _) h₂), },
    { exact is_iso.of_iso (is_colimit.cocone_point_unique_up_to_iso
        (colimit.is_colimit _) h₃), }, },
  { intro j,
    simp only [as_iso_hom, is_colimit.fac], },
end

def π₁₂₃_reflect_preserves_colimits (G : J ⥤ D) (F : D ⥤ short_complex C)
  (h₁ : preserves_colimit G (F ⋙ π₁)) (h₂ : preserves_colimit G (F ⋙ π₂))
  (h₃ : preserves_colimit G (F ⋙ π₃)) : preserves_colimit G F :=
⟨λ s hs, π₁₂₃_reflects_colimits _
  (@is_colimit_of_preserves _ _ _ _ _ _ G (F ⋙ π₁) _ hs _)
  (@is_colimit_of_preserves _ _ _ _ _ _ G (F ⋙ π₂) _ hs _)
  (@is_colimit_of_preserves _ _ _ _ _ _ G (F ⋙ π₃) _ hs _)⟩

variable (J)

def preserves_colimits_of_shape_of_projections (F : D ⥤ short_complex C)
  (h₁ : preserves_colimits_of_shape J (F ⋙ π₁))
  (h₂ : preserves_colimits_of_shape J (F ⋙ π₂))
  (h₃ : preserves_colimits_of_shape J (F ⋙ π₃)) :
  preserves_colimits_of_shape J F :=
⟨by { intro G, apply π₁₂₃_reflect_preserves_colimits; apply_instance, }⟩

end preserves

section functor_homological_complex

variables {C : Type*} [category C] [abelian C]
variables {M : Type*} {c : complex_shape M}
variables {J : Type*} [category J]

instance zero_preserves_colimits_of_shape {D : Type*} [category D]:
  preserves_colimits_of_shape J (0 : D ⥤ C) :=
⟨λ F, ⟨λ s hs,
{ desc := λ t, 0,
  fac' := λ t j, begin
    dsimp,
    apply is_zero.eq_of_src,
    apply is_zero.obj,
    apply is_zero_zero,
  end,
  uniq' := λ t m j, begin
    dsimp,
    apply is_zero.eq_of_src,
    apply is_zero.obj,
    apply is_zero_zero,
  end, }⟩⟩

lemma functor_homological_complex_π₁_iso_eval (i j : M) (hij : c.rel j i) :
  functor_homological_complex C c i ⋙ π₁ ≅ homological_complex.eval C c j :=
nat_iso.of_components (λ X, X.X_prev_iso hij)
(λ X Y f, begin
  dsimp,
  simp only [homological_complex.hom.prev_eq f hij, assoc, iso.inv_hom_id, comp_id],
end)

lemma functor_homological_complex_π₃_iso_eval (i j : M) (hij : c.rel i j) :
  functor_homological_complex C c i ⋙ π₃ ≅ homological_complex.eval C c j :=
nat_iso.of_components (λ X, X.X_next_iso hij)
(λ X Y f, begin
  dsimp,
  simp only [homological_complex.hom.next_eq f hij, assoc, iso.inv_hom_id, comp_id],
end)

instance (i : M) [has_colimits_of_shape J C] :
  preserves_colimits_of_shape J (short_complex.functor_homological_complex C c i) :=
begin
  apply preserves_colimits_of_shape_of_projections;
  { exact (infer_instance : preserves_colimits_of_shape J (homological_complex.eval C c _)), },
end

end functor_homological_complex

section functor_homology

variables {C : Type*} [category.{v} C] [abelian C]
variables {M : Type*} {c : complex_shape M}
  {J : Type v} [small_category J] [is_filtered J]
  [has_colimits_of_shape J C]
  [preserves_finite_limits (limits.colim : (J ⥤ C) ⥤ C)]
  [preserves_finite_colimits (limits.colim : (J ⥤ C) ⥤ C)]

namespace homology_functor_preserves_colimit

variable (F : short_complex (J ⥤ C))

def iso_datum := homology_iso_datum.tautological' F.1.f F.1.g F.2

instance (j : J) : preserves_finite_limits ((evaluation J C).obj j) :=
⟨by { intro F, introI, introI, apply_instance, }⟩
instance (j : J) : preserves_finite_colimits ((evaluation J C).obj j) :=
⟨by { intro F, introI, introI, apply_instance, }⟩
instance (j : J) : functor.additive ((evaluation J C).obj j) := { }
instance colim_additive : functor.additive (colim : (J ⥤ C) ⥤ C) := { }

@[simps]
def nat_trans_ι (j : J) : (evaluation J C).obj j ⟶ (colim : (J ⥤ C) ⥤ C) :=
{ app := λ F, colimit.ι F j,
  naturality' := λ F₁ F₂ φ, by { dsimp, simp only [colimit.ι_map], }, }

def iso_datum₁ := (iso_datum F).apply_exact_functor (colim : (J ⥤ C) ⥤ C)

def F₀ := functor_category_equivalence.functor.obj F

def e₁ : (F₀ F) ⋙ homology_functor ≅ (iso_datum F).H :=
nat_iso.of_components
  (λ j, ((iso_datum F).apply_exact_functor ((evaluation J C).obj j)).iso.symm)
  (λ i j f, begin
    simp only [functor.comp_map, iso.symm_hom],
    erw ((iso_datum F).map_nat_trans ((evaluation J C).map f)).homology_map_eq,
    simpa only [evaluation_map_app, assoc, iso.hom_inv_id, comp_id,
      iso.cancel_iso_inv_left],
  end)

def e₂ : colim.map_short_complex.obj F ≅ (colimit_cocone.cocone (F₀ F)).X :=
begin
  refine iso_mk _ _ _ _ _,
  { refine colim.map_iso (nat_iso.of_components (λ j, iso.refl _) (λ i j f, _)),
    dsimp, erw [id_comp, comp_id], refl, },
  { refine colim.map_iso (nat_iso.of_components (λ j, iso.refl _) (λ i j f, _)),
    dsimp, erw [id_comp, comp_id], refl, },
  { refine colim.map_iso (nat_iso.of_components (λ j, iso.refl _) (λ i j f, _)),
    dsimp, erw [id_comp, comp_id], refl, },
  { ext, dsimp, simp only [colimit.ι_map_assoc, colimit.ι_map, nat_iso.of_components_hom_app,
      iso.refl_hom, id_comp, ι_colim_map, nat_trans.hcomp_app, φ₁₂_app, nat_trans.id_app,
      π₂_map, assoc], erw id_comp, refl, },
  { ext, dsimp, simp only [colimit.ι_map_assoc, colimit.ι_map, nat_iso.of_components_hom_app,
      iso.refl_hom, id_comp, ι_colim_map, nat_trans.hcomp_app, φ₂₃_app, nat_trans.id_app,
      π₃_map, assoc], erw id_comp, refl, },
end

def e₃ : colimit (F₀ F ⋙ homology_functor) ≅ (colim.map_short_complex.obj F).homology :=
colim.map_iso (e₁ F) ≪≫ (iso_datum₁ F).iso

def e₄ : colimit (F₀ F ⋙ homology_functor) ≅ (colimit_cocone.cocone (F₀ F)).X.homology :=
e₃ F ≪≫ homology_functor.map_iso (e₂ F)

lemma compatibility (j : J) : (colimit.cocone (F₀ F ⋙ homology_functor)).ι.app j ≫
  (e₃ F).hom = homology_functor.map ((nat_trans_ι j).map_short_complex.app F) :=
begin
  rw ((iso_datum F).map_nat_trans (nat_trans_ι j)).homology_map_eq,
  dsimp only [e₁, e₃, iso_datum₁, nat_iso.of_components],
  simpa only [colimit.cocone_ι, iso.trans_hom, functor.map_iso_hom, colimit.ι_map_assoc,
    iso.symm_hom, nat_trans_ι_app, iso.cancel_iso_hom_right_assoc, iso.cancel_iso_inv_left],
end

lemma preserves : preserves_colimit (F₀ F) short_complex.homology_functor :=
⟨λ s hs, begin
  have e₁ : s ≅ colimit_cocone.cocone (F₀ F),
  { refine is_initial.unique_up_to_iso _ _,
    all_goals { equiv_rw (cocone.is_colimit_equiv_is_initial _).symm, },
    exacts [hs, (colimit_cocone (F₀ F)).is_colimit], },
  suffices : is_colimit (homology_functor.map_cocone (colimit_cocone.cocone (F₀ F))),
  { exact is_colimit.of_iso_colimit this
      ((cocones.functoriality _ homology_functor).map_iso e₁.symm), },
  clear e₁ hs s,
  refine is_colimit.of_iso_colimit (colimit.is_colimit (F₀ F ⋙ homology_functor))
     (cocones.ext (e₄ F) _),
  intro j,
  dsimp only [functor.map_cocone, cocones.functoriality, e₄, iso.trans, functor.map_iso],
  rw [← assoc, compatibility, ← homology_functor.map_comp],
  congr' 1,
  ext1,
  all_goals
  { dsimp [e₂], simp only [colimit.ι_map, nat_iso.of_components_hom_app,
      iso.refl_hom, id_comp], },
end⟩

end homology_functor_preserves_colimit

instance (F₀ : J ⥤ short_complex C) : preserves_colimit F₀ short_complex.homology_functor :=
begin
  let F := functor_category_equivalence.inverse.obj F₀,
  haveI : preserves_colimit (homology_functor_preserves_colimit.F₀ F) homology_functor
    := homology_functor_preserves_colimit.preserves F,
  have h : homology_functor_preserves_colimit.F₀ F ≅ F₀ :=
    functor_category_equivalence.counit_iso.app F₀,
  exact preserves_colimit_of_iso_diagram short_complex.homology_functor h,
end

instance : preserves_colimits_of_shape J
  (short_complex.homology_functor : short_complex C ⥤ C) := ⟨λ F, infer_instance⟩

end functor_homology

end short_complex


import Lean.Meta

syntax (name := stx_rfl) "stx_rfl" : tactic

open Lean.Elab.Tactic Lean Meta in
@[tactic stx_rfl] def syntacticRefl : Tactic := fun _ => do
  let goal ← getMainGoal
  let goalType ← goal.getType
  match goalType.app3? ``Eq with
  | none => throwTacticEx `stx_rfl goal m!"equality expected"
  | some (_,lhs,rhs) =>

    let lhs ← instantiateMVars lhs
    let rhs ← instantiateMVars rhs

    -- This is a very crude test and maybe too strict
    -- In my use case I wand defEq witout zeta reduction
    if lhs == rhs then
      goal.applyRefl
    else
      throwTacticEx `stx_rfl goal m!"{← Lean.Meta.ppExpr lhs} and {← Lean.Meta.ppExpr rhs} are not syntactically equal!"

example : 0 = 0 :=
by
  stx_rfl


import for_mathlib.derived.les_facts
import liquid
import Lbar.functor
import condensed.projective_resolution
import condensed.condensify
import condensed.bd_lemma
import breen_deligne.eg

import for_mathlib.derived.ext_coproducts
import condensed.ab4
import Lbar.squares
import pseudo_normed_group.QprimeFP
import for_mathlib.acyclic
import free_pfpng.acyclic
import for_mathlib.SemiNormedGroup_ulift
import for_mathlib.bicartesian4
import for_mathlib.has_homology_aux

import for_mathlib.derived.Ext_lemmas

noncomputable theory

universes u

open opposite category_theory category_theory.limits
open_locale nnreal zero_object

variables (r r' : ℝ≥0)
variables [fact (0 < r)] [fact (0 < r')] [fact (r < r')] [fact (r < 1)] [fact (r' < 1)]

abbreviation SemiNormedGroup.to_Cond (V : SemiNormedGroup.{u}) := Condensed.of_top_ab V

section

open bounded_homotopy_category

variables (BD : breen_deligne.data)
variables (κ κ₂ : ℝ≥0 → ℕ → ℝ≥0)
variables [∀ (c : ℝ≥0), BD.suitable (κ c)] [∀ n, fact (monotone (function.swap κ n))]
variables [∀ (c : ℝ≥0), BD.suitable (κ₂ c)] [∀ n, fact (monotone (function.swap κ₂ n))]
variables (M : ProFiltPseuNormGrpWithTinv₁.{u} r')
variables (V : SemiNormedGroup.{u}) [complete_space V] [separated_space V]

lemma ExtQprime_iso_aux_system_aux (c : ℝ≥0) (k i : ℤ) (hi : i > 0) :
  is_zero (((Ext' i).obj (op (((homological_complex.embed complex_shape.embedding.nat_down_int_up).obj
      ((QprimeFP_nat.{u} r' BD κ M).obj c)).X k))).obj V.to_Cond) :=
begin
  rcases k with (_|_)|_,
  { apply free_acyclic.{u} _ V i hi },
  { apply bounded_derived_category.Ext'_zero_left_is_zero, refine (is_zero_zero _).op },
  { apply free_acyclic.{u} _ V i hi },
end

def embed_unop {𝓐 : Type*} [category 𝓐] [abelian 𝓐] :
  (homological_complex.embed complex_shape.embedding.nat_down_int_up).op ⋙
    @homological_complex.unop_functor 𝓐 _ _ _ _ ≅
  homological_complex.unop_functor ⋙
    homological_complex.embed complex_shape.embedding.nat_up_int_down :=
begin
  refine nat_iso.of_components _ _,
  { intro X, refine homological_complex.hom.iso_of_components _ _,
    { rintro ((_|n)|n),
      { exact iso.refl _ },
      { refine is_zero.iso (is_zero_zero _).unop (is_zero_zero _), },
      { exact iso.refl _ }, },
    { rintro i (j|(_|j)) (rfl : _ = _),
      { apply is_zero.eq_of_src, exact (is_zero_zero _).unop },
      { dsimp only [iso.refl_hom], erw [category.id_comp, category.comp_id], refl },
      { dsimp only [iso.refl_hom], erw [category.id_comp, category.comp_id], refl }, } },
  { intros X Y f, ext ((_|n)|n),
    { dsimp only [homological_complex.comp_f, homological_complex.hom.iso_of_components_hom_f, iso.refl_hom],
      erw [category.id_comp, category.comp_id], refl },
    { apply is_zero.eq_of_tgt, exact is_zero_zero _ },
    { dsimp only [homological_complex.comp_f, homological_complex.hom.iso_of_components_hom_f, iso.refl_hom],
      erw [category.id_comp, category.comp_id], refl } }
end
.

-- move me
lemma nat_up_int_down_c_iff : complex_shape.embedding.nat_up_int_down.c_iff :=
λ i j, complex_shape.embedding.nat_down_int_up_c_iff j i

def forget₂_unop :
  ((forget₂ SemiNormedGroup Ab).op.map_homological_complex (complex_shape.down ℕ)).op ⋙
  homological_complex.unop_functor ≅
  homological_complex.unop_functor ⋙
  (forget₂ SemiNormedGroup Ab).map_homological_complex (complex_shape.down ℕ).symm :=
begin
  refine nat_iso.of_components _ _,
  { intro X, refine homological_complex.hom.iso_of_components _ _,
    { intro n, exact iso.refl _ },
    { rintro i j (rfl : _ = _), dsimp only [iso.refl_hom],
      rw [category.id_comp, category.comp_id], refl } },
  { intros X Y f, ext n,
    dsimp only [homological_complex.comp_f, homological_complex.hom.iso_of_components_hom_f, iso.refl_hom],
    rw [category.id_comp, category.comp_id], refl }
end
.

def preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab
  (M : Condensed.{u} Ab.{u+1}) (X : Profinite) :
  (preadditive_yoneda.obj M).obj (op $ CondensedSet_to_Condensed_Ab.obj (Profinite_to_Condensed.obj X)) ≅
  M.val.obj (op X) :=
let e := Condensed_Ab_CondensedSet_adjunction.hom_equiv X.to_Condensed M in
add_equiv.to_AddCommGroup_iso $
{ to_fun := λ t, yoneda'_equiv _ _ (e t).val,
  inv_fun := λ t, e.symm $ ⟨(yoneda'_equiv _ _).symm $ by apply t⟩,
  left_inv := λ t, begin
    dsimp only,
    apply_fun e, rw equiv.apply_symm_apply, ext1,
    dsimp only, erw equiv.apply_symm_apply,
  end,
  right_inv := λ t, begin
    dsimp only,
    rw equiv.apply_symm_apply,
    rw equiv.apply_symm_apply,
  end,
  map_add' := begin
    intros x y,
    refl,
  end }

@[reassoc]
lemma preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab_natural
  {M₁ M₂ : Condensed.{u} Ab.{u+1}} (f : M₁ ⟶ M₂) (X : Profinite) :
  (preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab M₁ X).hom ≫ f.val.app _ =
  (preadditive_yoneda.map f).app _ ≫
  (preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab M₂ X).hom :=
by { ext, refl }

@[reassoc]
lemma preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab_natural'
  (M : Condensed.{u} Ab.{u+1}) {X Y : Profinite.{u}} (f : X ⟶ Y) :
  (preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab M Y).hom ≫ M.val.map f.op =
  (preadditive_yoneda.obj M).map (CondensedSet_to_Condensed_Ab.map $
    Profinite_to_Condensed.map f).op ≫
  (preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab M X).hom :=
begin
  ext t,
  rw comp_apply,
  rw comp_apply,
  dsimp [preadditive_yoneda_obj_obj_CondensedSet_to_Condensed_Ab, adjunction.whisker_right],
  simp only [← nat_trans.comp_app],
  rw ← grothendieck_topology.to_sheafify_naturality_assoc,
  dsimp [functor.right_unitor],
  simp only [← comp_apply, category.assoc, ← nat_trans.comp_app, ← nat_trans.comp_app_assoc],
  simp only [← nat_trans.naturality, functor.comp_map, category.assoc],
  refl,
end

end


class L1 (α : Type u) where
  add    : α → α → α
  addc1  : ∀ (x y : α), @Add.add α ⟨add⟩ x y = @Add.add α ⟨add⟩ y x

instance L1.toAdd [inst : L1 α] : Add α := { inst with }

class L2 (α : Type u) where
  add   : α → α → α
  addc1 : ∀ (x y : α), @Add.add α ⟨add⟩ x y = @Add.add α ⟨add⟩ y x
  addc2 : ∀ (x y : α), @Add.add α (@L1.toAdd _ ⟨add, addc1⟩) x y = @Add.add α (@L1.toAdd _ ⟨add, addc1⟩) y x

instance L2.toL1 [inst : L2 α] : L1 α := { inst with }

class L3 (α : Type u) where
  add   : α → α → α
  addc1 : ∀ (x y : α), @Add.add α ⟨add⟩ x y = @Add.add α ⟨add⟩ y x
  addc2 : ∀ (x y : α), @Add.add α (@L1.toAdd _ ⟨add, addc1⟩) x y = @Add.add α (@L1.toAdd _ ⟨add, addc1⟩) y x
  addc3 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ ⟨add, addc1, addc2⟩)) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ ⟨add, addc1, addc2⟩)) y x

instance L3.toL2 [inst : L3 α] : L2 α := { inst with }

class L4 (α : Type u) where
  add   : α → α → α
  addc1 : ∀ (x y : α), @Add.add α ⟨add⟩ x y = @Add.add α ⟨add⟩ y x
  addc2 : ∀ (x y : α), @Add.add α (@L1.toAdd _ ⟨add, addc1⟩) x y = @Add.add α (@L1.toAdd _ ⟨add, addc1⟩) y x
  addc3 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ ⟨add, addc1, addc2⟩)) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ ⟨add, addc1, addc2⟩)) y x
  addc4 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ ⟨add, addc1, addc2, addc3⟩))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ ⟨add, addc1, addc2, addc3⟩))) y x

instance L4.toL3 [inst : L4 α] : L3 α := { inst with }

class L5 (α : Type u) where
  add   : α → α → α
  addc1 : ∀ (x y : α), @Add.add α ⟨add⟩ x y = @Add.add α ⟨add⟩ y x
  addc2 : ∀ (x y : α), @Add.add α (@L1.toAdd _ ⟨add, addc1⟩) x y = @Add.add α (@L1.toAdd _ ⟨add, addc1⟩) y x
  addc3 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ ⟨add, addc1, addc2⟩)) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ ⟨add, addc1, addc2⟩)) y x
  addc4 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ ⟨add, addc1, addc2, addc3⟩))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ ⟨add, addc1, addc2, addc3⟩))) y x
  addc5 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ ⟨add, addc1, addc2, addc3, addc4⟩)))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ ⟨add, addc1, addc2, addc3, addc4⟩)))) y x

instance L5.toL4 [inst : L5 α] : L4 α := { inst with }

class L6 (α : Type u) where
  add   : α → α → α
  addc1 : ∀ (x y : α), @Add.add α ⟨add⟩ x y = @Add.add α ⟨add⟩ y x
  addc2 : ∀ (x y : α), @Add.add α (@L1.toAdd _ ⟨add, addc1⟩) x y = @Add.add α (@L1.toAdd _ ⟨add, addc1⟩) y x
  addc3 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ ⟨add, addc1, addc2⟩)) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ ⟨add, addc1, addc2⟩)) y x
  addc4 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ ⟨add, addc1, addc2, addc3⟩))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ ⟨add, addc1, addc2, addc3⟩))) y x
  addc5 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ ⟨add, addc1, addc2, addc3, addc4⟩)))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ ⟨add, addc1, addc2, addc3, addc4⟩)))) y x
  addc6 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ ⟨add, addc1, addc2, addc3, addc4, addc5⟩))))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ ⟨add, addc1, addc2, addc3, addc4, addc5⟩))))) y x

instance L6.toL5 [inst : L6 α] : L5 α := { inst with }

class L7 (α : Type u) where
  add   : α → α → α
  addc1 : ∀ (x y : α), @Add.add α ⟨add⟩ x y = @Add.add α ⟨add⟩ y x
  addc2 : ∀ (x y : α), @Add.add α (@L1.toAdd _ ⟨add, addc1⟩) x y = @Add.add α (@L1.toAdd _ ⟨add, addc1⟩) y x
  addc3 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ ⟨add, addc1, addc2⟩)) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ ⟨add, addc1, addc2⟩)) y x
  addc4 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ ⟨add, addc1, addc2, addc3⟩))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ ⟨add, addc1, addc2, addc3⟩))) y x
  addc5 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ ⟨add, addc1, addc2, addc3, addc4⟩)))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ ⟨add, addc1, addc2, addc3, addc4⟩)))) y x
  addc6 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ ⟨add, addc1, addc2, addc3, addc4, addc5⟩))))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ ⟨add, addc1, addc2, addc3, addc4, addc5⟩))))) y x
  addc7 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6⟩)))))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6⟩)))))) y x

instance L7.toL6 [inst : L7 α] : L6 α := { inst with }

class L8 (α : Type u) where
  add   : α → α → α
  addc1 : ∀ (x y : α), @Add.add α ⟨add⟩ x y = @Add.add α ⟨add⟩ y x
  addc2 : ∀ (x y : α), @Add.add α (@L1.toAdd _ ⟨add, addc1⟩) x y = @Add.add α (@L1.toAdd _ ⟨add, addc1⟩) y x
  addc3 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ ⟨add, addc1, addc2⟩)) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ ⟨add, addc1, addc2⟩)) y x
  addc4 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ ⟨add, addc1, addc2, addc3⟩))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ ⟨add, addc1, addc2, addc3⟩))) y x
  addc5 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ ⟨add, addc1, addc2, addc3, addc4⟩)))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ ⟨add, addc1, addc2, addc3, addc4⟩)))) y x
  addc6 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ ⟨add, addc1, addc2, addc3, addc4, addc5⟩))))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ ⟨add, addc1, addc2, addc3, addc4, addc5⟩))))) y x
  addc7 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6⟩)))))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6⟩)))))) y x
  addc8 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ (@L7.toL6 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6, addc7⟩))))))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ (@L7.toL6 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6, addc7⟩))))))) y x

instance L8.toL7 [inst : L8 α] : L7 α := { inst with }

class L9 (α : Type u) where
  add   : α → α → α
  addc1 : ∀ (x y : α), @Add.add α ⟨add⟩ x y = @Add.add α ⟨add⟩ y x
  addc2 : ∀ (x y : α), @Add.add α (@L1.toAdd _ ⟨add, addc1⟩) x y = @Add.add α (@L1.toAdd _ ⟨add, addc1⟩) y x
  addc3 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ ⟨add, addc1, addc2⟩)) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ ⟨add, addc1, addc2⟩)) y x
  addc4 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ ⟨add, addc1, addc2, addc3⟩))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ ⟨add, addc1, addc2, addc3⟩))) y x
  addc5 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ ⟨add, addc1, addc2, addc3, addc4⟩)))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ ⟨add, addc1, addc2, addc3, addc4⟩)))) y x
  addc6 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ ⟨add, addc1, addc2, addc3, addc4, addc5⟩))))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ ⟨add, addc1, addc2, addc3, addc4, addc5⟩))))) y x
  addc7 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6⟩)))))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6⟩)))))) y x
  addc8 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ (@L7.toL6 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6, addc7⟩))))))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ (@L7.toL6 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6, addc7⟩))))))) y x
  addc9 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ (@L7.toL6 _ (@L8.toL7 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6, addc7, addc8⟩)))))))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ (@L7.toL6 _ (@L8.toL7 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6, addc7, addc8⟩)))))))) y x

instance L9.toL8 [inst : L9 α] : L8 α := { inst with }

class T1 (α : Type u) where
  add   : α → α → α
  addc1 : ∀ (x y : α), @Add.add α ⟨add⟩ x y = @Add.add α ⟨add⟩ y x
  addc2 : ∀ (x y : α), @Add.add α (@L1.toAdd _ ⟨add, addc1⟩) x y = @Add.add α (@L1.toAdd _ ⟨add, addc1⟩) y x
  addc3 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ ⟨add, addc1, addc2⟩)) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ ⟨add, addc1, addc2⟩)) y x
  addc4 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ ⟨add, addc1, addc2, addc3⟩))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ ⟨add, addc1, addc2, addc3⟩))) y x
  addc5 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ ⟨add, addc1, addc2, addc3, addc4⟩)))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ ⟨add, addc1, addc2, addc3, addc4⟩)))) y x
  addc6 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ ⟨add, addc1, addc2, addc3, addc4, addc5⟩))))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ ⟨add, addc1, addc2, addc3, addc4, addc5⟩))))) y x
  addc7 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6⟩)))))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6⟩)))))) y x
  addc8 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ (@L7.toL6 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6, addc7⟩))))))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ (@L7.toL6 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6, addc7⟩))))))) y x
  addc9 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ (@L7.toL6 _ (@L8.toL7 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6, addc7, addc8⟩)))))))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ (@L7.toL6 _ (@L8.toL7 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6, addc7, addc8⟩)))))))) y x

-- slow
instance T1.toL9 [inst : T1 α] : L9 α := { inst with }

class T2 (α : Type u) where
  add   : α → α → α
  addc1 : ∀ (x y : α), @Add.add α ⟨add⟩ x y = @Add.add α ⟨add⟩ y x
  addc2 : ∀ (x y : α), @Add.add α (@L1.toAdd _ ⟨add, addc1⟩) x y = @Add.add α (@L1.toAdd _ ⟨add, addc1⟩) y x
  addc3 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ ⟨add, addc1, addc2⟩)) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ ⟨add, addc1, addc2⟩)) y x
  addc4 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ ⟨add, addc1, addc2, addc3⟩))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ ⟨add, addc1, addc2, addc3⟩))) y x
  addc5 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ ⟨add, addc1, addc2, addc3, addc4⟩)))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ ⟨add, addc1, addc2, addc3, addc4⟩)))) y x
  addc6 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ ⟨add, addc1, addc2, addc3, addc4, addc5⟩))))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ ⟨add, addc1, addc2, addc3, addc4, addc5⟩))))) y x
  addc7 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6⟩)))))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6⟩)))))) y x
  addc8 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ (@L7.toL6 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6, addc7⟩))))))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ (@L7.toL6 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6, addc7⟩))))))) y x
  addc9 : ∀ (x y : α), @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ (@L7.toL6 _ (@L8.toL7 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6, addc7, addc8⟩)))))))) x y = @Add.add α (@L1.toAdd _ (@L2.toL1 _ (@L3.toL2 _ (@L4.toL3 _ (@L5.toL4 _ (@L6.toL5 _ (@L7.toL6 _ (@L8.toL7 _ ⟨add, addc1, addc2, addc3, addc4, addc5, addc6, addc7, addc8⟩)))))))) y x

-- slow
instance T2.toL9 [inst : T2 α] : L9 α := { inst with }

set_option pp.all true in
-- #print T2.toL9

axiom C : Type
axiom C.add   : C → C → C

noncomputable instance C.T1 : T1 C := ⟨add, sorry, sorry, sorry, sorry, sorry, sorry, sorry, sorry, sorry⟩
noncomputable instance C.T2 : T2 C := ⟨add, sorry, sorry, sorry, sorry, sorry, sorry, sorry, sorry, sorry⟩

-- slow
example : @T1.toL9 _ C.T1 = @T2.toL9 _ C.T2 := rfl


import for_mathlib.abelian_category
import for_mathlib.exact_seq3

noncomputable theory

namespace category_theory
open category_theory.limits

variables {𝓐 : Type*} [category 𝓐] [abelian 𝓐]

-- lemma exact_seq.is_iso_of_is_zero_of_is_zero
--   {A B C D : 𝓐} {f : A ⟶ B} {g : B ⟶ C} {h : C ⟶ D} {L : list (arrow 𝓐)}
--   (H : exact_seq 𝓐 (f::g::h::L)) (hA : is_zero A) (hD : is_zero D) :
--   is_iso g :=
-- begin
--   admit
-- end

end category_theory


import for_mathlib.algebra.homology.k_projective
import for_mathlib.category_theory.localization.derived_functor_triangulated
import category_theory.abelian.injective
import for_mathlib.algebra.homology.cochain_complex_opposites

noncomputable theory

open category_theory category_theory.category category_theory.limits
  category_theory.pretriangulated
open_locale zero_object

instance inverse_image_multiplicative {C D : Type*} [category C] [category D]
  (F : C ⥤ D) (W : morphism_property D)
  [W.multiplicative] : (W.inverse_image F).multiplicative :=
{ contains_identities := ⟨λ X, begin
    change W _,
    rw F.map_id,
    apply morphism_property.contains_identities.id W,
  end⟩,
  comp := (morphism_property.multiplicative.comp W).inverse_image F, }

variables {C : Type*} [category C] [abelian C]

namespace homological_complex

variables {ι : Type*} {c : complex_shape ι} (K L : homological_complex C c)

class is_K_injective : Prop :=
(null_homotopic : ∀ ⦃X : homological_complex C c⦄ (f : X ⟶ K)
  (hX : acyclic X), nonempty (homotopy f 0))

variables {K L}

lemma is_K_injective.of_homotopy_equiv [K.is_K_injective] (e : homotopy_equiv K L) :
  L.is_K_injective :=
⟨λ X f hX, begin
  obtain ⟨h⟩ := is_K_injective.null_homotopic (f ≫ e.inv) hX,
  refine ⟨(homotopy.of_eq (comp_id f)).symm.trans
    (((e.homotopy_inv_hom_id.symm.comp_left f).trans
      (homotopy.of_eq (assoc _ _ _).symm)).trans
        ((h.comp_right e.hom).trans (homotopy.of_eq zero_comp)))⟩,
end⟩

lemma is_K_injective.of_iso [K.is_K_injective] (e : K ≅ L) : L.is_K_injective :=
is_K_injective.of_homotopy_equiv (homotopy_equiv.of_iso e)

lemma is_K_injective.iff_of_iso (e : K ≅ L) :
  K.is_K_injective ↔ L.is_K_injective :=
begin
  split,
  { introI, exact is_K_injective.of_iso e, },
  { introI, exact is_K_injective.of_iso e.symm, },
end

lemma is_K_injective.of_is_zero (h : is_zero K) : K.is_K_injective :=
⟨λ X f hX, begin
  rw h.eq_of_tgt f 0,
  exact ⟨homotopy.refl _⟩
end⟩

instance zero_is_K_injective : is_K_injective (0 : homological_complex C c) :=
is_K_injective.of_is_zero (limits.is_zero_zero _)

end homological_complex

namespace cochain_complex

open homological_complex

variables (K : cochain_complex C ℤ)

lemma is_K_injective_iff : is_K_injective K ↔
  (homotopy_category.quotient _ _).obj K
    ∈ triangulated.right_orthogonal (homotopy_category.acyclic C) :=
begin
  split,
  { introI,
    rintros ⟨X⟩ f hX,
    obtain ⟨f, rfl⟩ := (homotopy_category.quotient _ _).map_surjective f,
    rw ← (homotopy_category.quotient C (complex_shape.up ℤ)).map_zero,
    refine homotopy_category.eq_of_homotopy _ _ (is_K_injective.null_homotopic _ _).some,
    erw homotopy_category.quotient_obj_mem_acyclic_iff at hX,
    exact hX, },
  { intro hK,
    refine ⟨λ X f hX, ⟨homotopy_category.homotopy_of_eq _ _ _⟩⟩,
    simp only [functor.map_zero],
    apply hK,
    simpa only [homotopy_category.quotient_obj_mem_acyclic_iff] using hX, },
end

lemma shift_is_K_injective_iff (K : cochain_complex C ℤ) (r : ℤ) :
  is_K_injective (K⟦r⟧) ↔ is_K_injective K :=
begin
  simp only [is_K_injective_iff],
  erw [set.respects_iso.mem_iff_of_iso (triangulated.right_orthogonal (homotopy_category.acyclic C))
   (((homotopy_category.quotient C (complex_shape.up ℤ)).comm_shift_iso r).app K),
   ← triangulated.is_triangulated_subcategory.shift_iff],
end

lemma is_K_injective_of_op (K : cochain_complex C ℤ)
  (hK : (op_equivalence.op_obj K).is_K_projective) :
  is_K_injective K :=
⟨λ (L : cochain_complex C ℤ) f hL, ⟨begin
  apply cochain_complex.unop_homotopy,
  let f' : op_equivalence.op_obj K ⟶ _ :=
    (cochain_complex.op_equivalence.functor C).map f.op,
  exact (is_K_projective.null_homotopic f' (cochain_complex.acyclic_op hL)).some,
end⟩⟩

lemma is_K_injective_of_bounded_below_of_injective
  (K : cochain_complex C ℤ) (n : ℤ) [K.is_strictly_ge n]
  [∀ (n : ℤ), injective (K.X n)] : is_K_injective K :=
begin
  haveI : K.is_strictly_ge (-(-n)),
  { simp only [neg_neg], apply_instance, },
  haveI : (op_equivalence.op_obj K).is_strictly_le (-n) := op_obj_is_strictly_le K (-n),
  haveI : ∀ (n : ℤ), projective ((op_equivalence.op_obj K).X n),
  { intro n,
    dsimp,
    apply_instance, },
  exact is_K_injective_of_op _ (is_K_projective_of_bounded_above_of_projective _ (-n)),
end

end cochain_complex

namespace homotopy_category

variables {C} {ι : Type*} {c : complex_shape ι}

class is_K_injective (K : homotopy_category C c) : Prop :=
(K_injective : K.as.is_K_injective)

lemma is_K_injective_iff' (K : homotopy_category C c) :
  K.is_K_injective ↔ K.as.is_K_injective :=
begin
  split,
  { exact λ h, h.K_injective, },
  { exact λ h, ⟨h⟩, },
end

lemma is_K_injective_iff (K : homotopy_category C (complex_shape.up ℤ)) : is_K_injective K ↔
  K ∈ triangulated.right_orthogonal (homotopy_category.acyclic C) :=
begin
  rw K.is_K_injective_iff',
  cases K,
  dsimp,
  apply cochain_complex.is_K_injective_iff,
end

variables (C c)

instance zero_is_K_injective :
  (0 : homotopy_category C c).is_K_injective :=
⟨⟨λ X f hf, ⟨begin
  have e : ∀ (X : homotopy_category C c), ((quotient C c).obj X.1 ≅ X),
  { rintro ⟨X⟩, exact (iso.refl _), },
  refine homotopy_of_eq _ _ (is_zero.eq_of_tgt (is_zero.of_iso (is_zero_zero _) (e _)) _ _),
end⟩⟩⟩

abbreviation K_injective := full_subcategory (λ (K : homotopy_category C c), K.is_K_injective)

instance is_K_injective_is_triangulated_subcategory :
  triangulated.is_triangulated_subcategory
    (λ (K : homotopy_category C (complex_shape.up ℤ)), K.is_K_injective) :=
begin
  convert (infer_instance : triangulated.is_triangulated_subcategory
      (triangulated.right_orthogonal (homotopy_category.acyclic C))),
  ext,
  exact is_K_injective_iff _,
end

instance K_injective_is_K_injective (K : K_injective C c) : K.obj.is_K_injective := K.2

--instance : pretriangulated (K_injective C (complex_shape.up ℤ)) := infer_instance

abbreviation K_injective.ι : K_injective C c ⥤ homotopy_category C c :=
full_subcategory_inclusion _

end homotopy_category

namespace derived_category

lemma Qh_map_bijective_of_is_K_injective
  (K L : homotopy_category C (complex_shape.up ℤ)) [L.is_K_injective] :
  function.bijective (λ (f : K ⟶ L), Qh.map f) :=
(triangulated.subcategory.right_orthogonal_bijective_Q_map
  (homotopy_category.acyclic C) _ _
  (by { rw ← L.is_K_injective_iff, apply_instance, }))

lemma Qh_map_bijective_of_is_K_injective'
  (K L : cochain_complex C ℤ) [L.is_K_injective] :
  function.bijective (λ (f : ((homotopy_category.quotient _ _).obj K ⟶
    (homotopy_category.quotient _ _).obj L)), Qh.map f) :=
(triangulated.subcategory.right_orthogonal_bijective_Q_map
  (homotopy_category.acyclic C) _ _
  ((cochain_complex.is_K_injective_iff L).1 infer_instance))

lemma Q_map_surjective_of_is_K_injective
  (K L : cochain_complex C ℤ) [L.is_K_injective] :
  function.surjective (λ (f : K ⟶ L), Q.map f) :=
λ f, begin
  obtain ⟨g, hg⟩ := (Qh_map_bijective_of_is_K_injective' K L).2 f,
  dsimp at hg,
  obtain ⟨g, rfl⟩ := (homotopy_category.quotient _ _).map_surjective g,
  exact ⟨g, hg⟩,
end

def homotopy_of_eq_Qh_map_eq_of_is_K_injective
  {K L : cochain_complex C ℤ} [L.is_K_injective] (f₁ f₂ : K ⟶ L)
  (h : Q.map f₁ = Q.map f₂) : homotopy f₁ f₂ :=
homotopy_category.homotopy_of_eq _ _ ((Qh_map_bijective_of_is_K_injective' K L).1 h)

end derived_category

namespace homotopy_category

variable (C)

namespace K_injective

def W : morphism_property (homotopy_category.K_injective C (complex_shape.up ℤ)) :=
(triangulated.subcategory.W (homotopy_category.acyclic C)).inverse_image (K_injective.ι _ _)

instance W_multiplicative : (W C).multiplicative :=
by { dsimp [W], apply_instance, }

variable {C}

def Φ : localizor_morphism (W C) (triangulated.subcategory.W (homotopy_category.acyclic C)) :=
{ functor := K_injective.ι _ _,
  mapW := λ X Y f hf, hf, }

instance Φ_functor_has_comm_shift :
  (Φ : localizor_morphism (W C) _).functor.has_comm_shift ℤ :=
by { dsimp only [Φ], apply_instance, }

instance Φ_functor_is_triangulated :
  (Φ : localizor_morphism (W C) _).functor.is_triangulated :=
by { dsimp only [Φ], apply_instance, }

end K_injective

end homotopy_category

namespace category_theory

variable (C)

include C

class has_enough_K_injectives : Prop :=
(condition : ∀ (K : homotopy_category C (complex_shape.up ℤ)),
  nonempty (homotopy_category.K_injective.Φ.right_resolution K))

end category_theory

open category_theory

namespace homotopy_category

namespace K_injective

variable {C}

def Qh : K_injective C (complex_shape.up ℤ) ⥤ derived_category C :=
K_injective.ι _ _ ⋙ derived_category.Qh

instance full_Qh : full (Qh : _ ⥤ derived_category C) :=
functor.full_of_surjective _ (λ K L, (derived_category.Qh_map_bijective_of_is_K_injective _ _).2)

instance faithful_Qh : faithful (Qh : _ ⥤ derived_category C) :=
⟨λ K L, (derived_category.Qh_map_bijective_of_is_K_injective _ _).1⟩

variable (C)

lemma W_eq_isomorphisms : W C = morphism_property.isomorphisms _ :=
begin
  ext K L f,
  split,
  { intro hf,
    haveI : is_iso (Qh.map f) := (triangulated.subcategory.is_iso_map_iff
      (acyclic C) derived_category.Qh f).2 hf,
    exact is_iso_of_reflects_iso f Qh, },
  { rintro (h : is_iso _),
    haveI := h,
    exact (triangulated.subcategory.is_iso_map_iff (acyclic C) derived_category.Qh ((ι _ _).map f)).1
      infer_instance, },
end

variable {C}

lemma W_inverts {D : Type*} [category D]
  (G : K_injective C (complex_shape.up ℤ) ⥤ D) :
  (W C).is_inverted_by G :=
begin
  intros X Y f hf,
  haveI : is_iso f := by simpa only [W_eq_isomorphisms] using hf,
  apply_instance,
end

variables [has_enough_K_injectives C]

instance (Y : homotopy_category C (complex_shape.up ℤ)) :
  nonempty (Φ.right_resolution Y) :=
has_enough_K_injectives.condition Y

instance (Y : homotopy_category C (complex_shape.up ℤ)) (X : Φ.right_resolution Y) :
  is_iso (derived_category.Qh.map X.hom.f) :=
by simpa only [triangulated.subcategory.is_iso_map_iff (homotopy_category.acyclic C)
  derived_category.Qh] using X.hom.hf

instance ess_surj_Qh : ess_surj (Qh : _ ⥤ derived_category C) :=
⟨λ Z, begin
  have e := derived_category.Qh.obj_obj_preimage_iso Z,
  let Y := derived_category.Qh.obj_preimage Z,
  let X := (has_enough_K_injectives.condition Y).some,
  exact ⟨X.right.obj, ⟨(as_iso (derived_category.Qh.map X.hom.f)).symm ≪≫
    derived_category.Qh.obj_obj_preimage_iso Z⟩⟩,
end⟩

instance : is_equivalence (Qh : _ ⥤ derived_category C) :=
equivalence.of_fully_faithfully_ess_surj _

instance Qh_is_localization : Qh.is_localization (W C) :=
begin
  haveI : (𝟭 _).is_localization (W C),
  { refine functor.is_localization.for_id _ _,
    rw W_eq_isomorphisms, },
  exact functor.is_localization.of_equivalence_target (𝟭 _) (W C) Qh
    (functor.as_equivalence Qh) (functor.left_unitor _),
end

instance Φ_induced_functor_obj_is_K_injective (Y : homotopy_category C (complex_shape.up ℤ))
  (X : Φ.right_resolution Y) : (Φ.induced_functor.obj X.right).obj.is_K_injective :=
X.right.obj.2

instance Φ_induced_functor_obj_is_K_injective' (Y : homotopy_category C (complex_shape.up ℤ))
  (X : Φ.right_resolution Y) : (Φ.functor.obj X.right.obj).is_K_injective :=
X.right.obj.2

lemma lift_map {Y₁ Y₂ : homotopy_category C (complex_shape.up ℤ)} (f : Y₁ ⟶ Y₂)
  (X₁ : Φ.right_resolution Y₁) (X₂ : Φ.right_resolution Y₂) :
  ∃ (f' : X₁.right.obj ⟶ X₂.right.obj), X₁.hom.f ≫ Φ.functor.map f' = f ≫ X₂.hom.f :=
begin
  let f'' := inv (derived_category.Qh.map (X₁.hom.f)) ≫
    derived_category.Qh.map (f ≫ X₂.hom.f),
  obtain ⟨f', hf'⟩ := (derived_category.Qh_map_bijective_of_is_K_injective _ _).2 f'',
  refine ⟨f', (derived_category.Qh_map_bijective_of_is_K_injective _ _).1 _⟩,
  dsimp [Φ] at hf' ⊢,
  simp only [functor.map_comp, hf', f'', is_iso.hom_inv_id_assoc],
end

instance (Y : homotopy_category C (complex_shape.up ℤ)) :
  is_preconnected' (Φ.right_resolution Y) :=
⟨⟨begin
  rintro ⟨X₁⟩ ⟨X₂⟩,
  obtain ⟨g, hg⟩ := K_injective.lift_map (𝟙 Y) X₁ X₂,
  dsimp at hg,
  rw id_comp at hg,
  refine quot.sound ⟨structured_arrow.hom_mk ⟨g, _⟩ _⟩,
  { change (triangulated.subcategory.W (homotopy_category.acyclic C)) _,
    rw ← triangulated.subcategory.is_iso_map_iff (homotopy_category.acyclic C)
      derived_category.Qh,
    replace hg := derived_category.Qh.congr_map hg,
    rw functor.map_comp at hg,
    exact is_iso.of_is_iso_fac_left hg, },
  { ext, exact hg, },
end⟩⟩

instance Φ_is_localization_equivalence : (Φ : localizor_morphism (W C) _).is_localization_equivalence :=
begin
  rw localizor_morphism.is_localization_equivalence.iff_is_localization Φ
    (derived_category.Qh : _ ⥤ derived_category C),
  change Qh.is_localization _,
  apply_instance,
end

lemma right_derivability_structure :
  right_derivability_structure.basic (Φ : localizor_morphism (W C) _) :=
{ right_resolution_connected := λ Y, { },
  nonempty_arrow_right_resolution := λ Y₁ Y₂ f, begin
    let X₁ := (has_enough_K_injectives.condition Y₁).some,
    let X₂ := (has_enough_K_injectives.condition Y₂).some,
    obtain ⟨f', fac⟩ := K_injective.lift_map f X₁ X₂,
    exact ⟨X₁, X₂, f', fac⟩,
  end, }

instance Φ_functor_comp_Qh_ess_surj_on_dist_triang : (Φ.functor ⋙
  derived_category.Qh : _ ⥤ derived_category C).ess_surj_on_dist_triang :=
K_injective.right_derivability_structure.Φ_functor_comp_L_ess_surj_on_dist_triang _

section

variables {D : Type*} [category D]
  (F : homotopy_category C (complex_shape.up ℤ) ⥤ D)

instance existence_right_derived_functor :
  F.has_right_derived_functor (triangulated.subcategory.W (acyclic C)) :=
right_derivability_structure.basic.existence_derived_functor
  K_injective.right_derivability_structure F (W_inverts _)

lemma is_iso_app (RF : derived_category C ⥤ D)
  (α : F ⟶ derived_category.Qh ⋙ RF)
  [RF.is_right_derived_functor α]
  (K : homotopy_category C (complex_shape.up ℤ)) [K.is_K_injective] :
  is_iso (α.app K) :=
right_derivability_structure.basic.is_iso_app
  K_injective.right_derivability_structure derived_category.Qh F (W_inverts _)
  RF α ⟨K, infer_instance⟩

instance (K : homotopy_category C (complex_shape.up ℤ)) [K.is_K_injective] :
  is_iso ((F.right_derived_functor_α derived_category.Qh
    (triangulated.subcategory.W (acyclic C))).app K) :=
is_iso_app _ _ _ _

section

variables [has_zero_object D] [has_shift D ℤ] [preadditive D]
  [∀ (n : ℤ), (shift_functor D n).additive] [pretriangulated D]
  [F.has_comm_shift ℤ] [functor.is_triangulated F]

instance right_derived_functor_is_triangulated :
  (F.right_derived_functor derived_category.Qh
    (triangulated.subcategory.W (acyclic C))).is_triangulated :=
right_derivability_structure.basic.derived_functor_is_triangulated'
    K_injective.right_derivability_structure F derived_category.Qh (W_inverts _)

end

end

end K_injective

end homotopy_category


-- Copyright (c) 2017 Scott Morrison. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.
-- Authors: Stephen Morgan, Scott Morrison
import .pentagon_in_terms_of_natural_transformations_definitions
import tidy.its

open categories
open categories.functor
open categories.products
open categories.natural_transformation

namespace categories.monoidal_category

universe variables u v

variables (C : Type u) [𝒞 : monoidal_category.{u v} C]
include 𝒞

local attribute [tidy] dsimp_all'

set_option trace.check true

-- TODO tidy this up
lemma pentagon_in_terms_of_natural_transformations :
  pentagon_3step C = pentagon_2step C :=
  begin
    dsimp',
    apply NaturalTransformations_componentwise_equal,
    intros WXYZ,
    induction WXYZ with WXY Z,
    induction WXY with WX Y,
    induction WX with W X,
    {
      tidy,
      -- erw rewrite_tensor_as_otimes, -- FIXME terrifying: equalities between objects are evil, and hence rewriting along them is hard
      have p := monoidal_category.pentagon C W X Y Z,
      -- have p := monoidal_category.pentagon C X_fst_fst_fst X_fst_fst_snd X_fst_snd X_snd,
      obviously, -- FIXME
    },
end

end categories.monoidal_category


example : if x = 0 then y + x = y else x ≠ 0 := by
  simp (config := { contextual := true })

example : if x = 0 then y + x = y else x ≠ 0 := by
  split
  simp_all
  simp_all

example : if x = 0 then y + x = y else x ≠ 0 := by
  simp (config := { contextual := true })
  split -- Error: no goals to be solved


import for_mathlib.endomorphisms.basic
import for_mathlib.exact_functor

universe v

namespace category_theory

namespace endomorphisms

open homological_complex category_theory category_theory.limits category

variables (𝓐 : Type*) [category.{v} 𝓐]

@[simps]
def tautological_nat_trans :
  (endomorphisms.forget 𝓐) ⟶ (endomorphisms.forget 𝓐) :=
{ app := λ X, X.e, }

variable {𝓐}

variables [abelian 𝓐]
  [has_coproducts_of_shape (ulift.{v} ℕ) 𝓐] [has_products_of_shape (ulift.{v} ℕ) 𝓐]
variables {M : Type*} {c : complex_shape M} (F : endomorphisms 𝓐 ⥤ homological_complex 𝓐 c)
variables (Y : homological_complex (endomorphisms 𝓐) c)

@[simps]
def _root_.homological_complex.tautological_endomorphism : Y ⟶ Y :=
{ f := λ i, ⟨(Y.X i).e, rfl⟩, }

lemma homology_functor_obj_e (i : M) :
  ((homology_functor (endomorphisms 𝓐) c i).obj Y).e =
    ((homology_functor (endomorphisms 𝓐) c i).map Y.tautological_endomorphism).f  :=
begin
  have h₁ := ((endomorphisms.forget 𝓐).homology_functor_iso c i).hom.naturality
    Y.tautological_endomorphism,
  rw [← cancel_mono (((endomorphisms.forget 𝓐).homology_functor_iso c i).inv.app Y),
    assoc] at h₁,
  conv_lhs at h₁ { congr, skip, rw [← nat_trans.comp_app, iso.hom_inv_id, nat_trans.id_app], },
  rw comp_id at h₁,
  conv_lhs at h₁ { dsimp only [functor.comp, endomorphisms.forget], },
  rw h₁,
  clear h₁,
  have h₂ := nat_trans.congr_app (functor.naturality_homology_functor_iso
    (tautological_nat_trans 𝓐) c i) Y,
  dsimp [nat_trans.hcomp] at h₂,
  rw [comp_id, id_comp, ← cancel_mono
    (((endomorphisms.forget 𝓐).homology_functor_iso c i).inv.app Y), assoc] at h₂,
  conv_lhs at h₂ { congr, skip, rw [← nat_trans.comp_app, iso.hom_inv_id, nat_trans.id_app], },
  erw comp_id at h₂,
  exact h₂,
end

end endomorphisms

end category_theory


import Yatima.Typechecker.Equal

/-!
# Yatima typechecker: Infer

## Basic Structure

This is the third of the three main files that constitute the Yatima typechecker: `Eval`, `Equal`,
and `Infer`.

TODO: Add a high level overview of Infer in the context of Eval-Equal-Infer.

## Infer

In this module the two major functions `check` and `infer` are defined.
* `check` : Checks that a Yatima expression has a prescribed type.
* `infer` : Determines the type of a given Yatima expression.
-/

namespace Yatima.Typechecker

open IR PP
open Lurk (F)

/--
  Gives the correct type information for a lambda based on the information of the body.
  No lambdas can be a proposition, a struct or be elements of the unit type.
-/
def lamInfo : TypeInfo → TypeInfo
| .proof => .proof
| _ => .none

def piInfo (dom img : TypeInfo) : TypecheckM TypeInfo := match dom, img with
| .sort lvl, .sort lvl' => pure $ .sort $ .reduceIMax lvl lvl'
| .sort _, _ => throw "Image is not a type"
| _, .sort _ => throw "Domain is not a type"
| _, _ => throw "Neither image nor domain are types"

def eqSortInfo (inferType expectType : SusValue) : TypecheckM Bool := do
  match inferType.info, expectType.info with
  | .sort lvl, .sort lvl' => pure $ lvl.equalUniv lvl'
  | .sort _, e => throw s!"Expected type {← ppValue expectType.get} {repr e} is not actually a type"
  | e, .sort _ => throw s!"Inferred type {← ppValue inferType.get} {repr e} is not actually a type"
  | e, e' => throw s!"Neither expected {← ppValue expectType.get} {repr e} nor inferred types {← ppValue inferType.get} {repr e'} are actually types"
/--
  Gives the correct type information for a term based on its type.
-/
def infoFromType (typ : SusValue) : TypecheckM TypeInfo :=
  match typ.info with
  | .sort .zero => pure .proof
  | _ =>
    match typ.get with
    | .app (.const f _) _ _ => do match derefConst f (← read).store with
      | .inductiveProj p =>
        let induct ← getIndFromProj p
        if induct.unit then pure .unit else pure .none
      | _ => pure .none
    | .sort lvl => pure (.sort lvl)
    | _ => pure .none

mutual

  partial def getStructInfo (v : Value) :
      TypecheckM (F × TypedExpr × List Univ × List SusValue) := do
    match v with
    | .app (.const indF univs) params _ =>
      let .inductiveProj p := derefConst indF (← read).store
        | throw s!"Expected a structure type, found {← ppValue v}"
      let ind ← getIndFromProj p
      -- Sanity check
      unless ind.struct && ind.params == params.length do
        throw s!"Expected a structure type, found {← ppValue v}"
      withLimitedAxioms $ checkConst indF
      let ctorF := mkConstructorProjF p.block p.idx 0 (← read).quick
      match (← get).typedConsts.find? ctorF with
      | .some (.constructor type _ _) =>
        return (indF, type, univs, params)
      | _ => throw s!"Implementation broken: ctorF {ctorF} is not a constructor"
    | v => throw s!"Expected a structure type, found {← ppValue v}"

  /--
  Checks if `term : IR.Expr` has type `type : SusValue`. Returns the typed IR for `term`
  -/
  partial def check (term : IR.Expr) (type : SusValue) : TypecheckM TypedExpr := do
    let (term, inferType) ← infer term
    if !(← eqSortInfo inferType type) then
      throw s!"Term: {← ppTypedExpr term}\nInfo mismatch:\n{repr inferType.info}\n\nnot equal to\n{repr type.info}\n\nExpected type: {← ppValue type.get}\nInferred type: {← ppValue inferType.get}"
    if !(← equal (← read).lvl type inferType) then
      throw s!"Expected type {← ppValue type.get}, found type {← ppValue inferType.get}"
    pure term

  /-- Infers the type of `term : IR.Expr`. Returns the typed IR for `term` along with its inferred type  -/
  partial def infer (term : IR.Expr) : TypecheckM (TypedExpr × SusValue) := do
    match term with
    | .var idx lvls =>
      let ctx ← read
      if idx < ctx.lvl then
        -- this is a bound free variable
        if !lvls.isEmpty then
          -- bound free variables should never have universe levels (sanity check)
          throw s!"found var@{idx} with unexpected universe variables"
        let types := ctx.types
        let some type := types.get? idx
          | throw s!"var@{idx} out of environment range (size {types.length})"
        let term := ⟨← infoFromType type, .var idx⟩
        pure (term, type)
      else
        -- this free variable came from `recrCtx`, and thus represents a mutual reference
        match ctx.mutTypes.find? (idx - ctx.lvl) with
        | some (constF, typeValFn) =>
          if some constF == ctx.recF? then
            throw s!"Invalid recursion in {(← read).constNames.getF constF}"
          let type := typeValFn lvls
          let term := ⟨← infoFromType type, .const constF lvls⟩
          pure (term, type)
        | none =>
          throw $ s!"var@{idx} out of environment range (size {ctx.types.length})"
            ++ " and does not represent a mutual constant"
    | .sort lvl =>
      let univs := (← read).env.univs
      let lvl := Univ.instBulkReduce univs lvl
      let lvl' := lvl.succ
      let typ := .mk (.sort lvl'.succ) ⟨ fun _ => .sort lvl' ⟩
      -- NOTE: we populate `SusTypeInfo.sort` here for consistency but technically it isn't necessary
      -- because `lvl'` can never become `Univ.zero`.
      let term := ⟨.sort lvl', .sort lvl⟩
      return (term, typ)
    | .app fnc' arg =>
      let (fnc, fncType) ← infer fnc'
      match fncType.get with
      | .pi dom img env =>
        let arg ← check arg dom
        let ctx ← read
        let stt ← get
        let typ := suspend img { ctx with env := env.extendWith $ suspend arg ctx stt} stt
        let term := ⟨← infoFromType typ, .app fnc arg⟩
        pure (term, typ)
      | val => throw s!"Expected a pi type, found {← ppValue val}"
    | .lam dom bod => do
      let (dom, _) ← isSort dom
      let ctx ← read
      let domVal := suspend dom ctx (← get)
      let var := mkSusVar (← infoFromType domVal) ctx.lvl
      let (bod, imgVal) ← withExtendedCtx var domVal $ infer bod
      let term := ⟨lamInfo bod.info, .lam dom bod⟩
      let typ := .mk (← piInfo domVal.info imgVal.info) $
        Value.pi domVal (← quoteTyped (ctx.lvl+1) ctx.env imgVal.getTyped) ctx.env
      pure (term, typ)
    | .pi dom img =>
      let (dom, domLvl) ← isSort dom
      let ctx ← read
      let domVal := suspend dom ctx (← get)
      let domSusVal := mkSusVar (← infoFromType domVal) ctx.lvl
      withExtendedCtx domSusVal domVal $ do
        let (img, imgLvl) ← isSort img
        let sortLvl := .reduceIMax domLvl imgLvl
        let typ := .mk (.sort sortLvl.succ) ⟨ fun _ => .sort $ sortLvl ⟩
        let term := ⟨← infoFromType typ, .pi dom img⟩
        return (term, typ)
    | .letE expType exp bod =>
      let (expType, _) ← isSort expType
      let ctx ← read
      let expTypeVal := suspend expType ctx (← get)
      let exp ← check exp expTypeVal
      let expVal := suspend exp ctx (← get)
      let (bod, typ) ← withExtendedCtx expVal expTypeVal $ infer bod
      let term := ⟨bod.info, .letE expType exp bod⟩
      return (term, typ)
    | .lit (.natVal v) =>
      let typ := .mk (.sort $ .succ .zero) (mkConst (← primF .nat) [])
      let term := ⟨.none, .lit (.natVal v)⟩
      pure $ (term, typ)
    | .lit (.strVal s) =>
      let typ := .mk (.sort $ .succ .zero) (mkConst (← primF .string) [])
      let term := ⟨.none, .lit (.strVal s)⟩
      pure $ (term, typ)
    | .const k constUnivs =>
      withLimitedAxioms $ checkConst k
      let ctx ← read
      let univs := ctx.env.univs
      let tconst ← derefTypedConst k
      let env := ⟨[], constUnivs.map (Univ.instBulkReduce univs)⟩
      let typ := suspend tconst.type { ctx with env := env } (← get)
      let term := ⟨← infoFromType typ, .const k constUnivs⟩
      pure (term, typ)
    | .proj idx expr =>
      let (expr, exprType) ← infer expr
      let (indF, ctorType, univs, params) ←  getStructInfo exprType.get
      let mut ctorType ← applyType (← withEnv ⟨[], univs⟩ $ eval ctorType) params.reverse
      for i in [:idx] do
        match ctorType with
        | .pi dom img piEnv =>
          let info ← infoFromType dom
          let proj := suspend ⟨info, .proj indF i expr⟩ (← read) (← get)
          ctorType ← withNewExtendedEnv piEnv proj $ eval img
        | _ => pure ()
      match ctorType with
      | .pi dom _ _  =>
        match exprType.info, dom.info with
        | .sort .zero, .sort .zero =>
          let term := ⟨← infoFromType dom, .proj indF idx expr⟩
          pure (term, dom)
        | .sort .zero, _ =>
          throw s!"Projection {← ppTypedExpr expr}.{idx} not allowed"
        | _, _ =>
          let term := ⟨← infoFromType dom, .proj indF idx expr⟩
          pure (term, dom)
      | _ => throw "Impossible case. Implementation broken."

  /--
  Checks if `expr : IR.Expr` is `Sort lvl` for some level `lvl`, and throws `TypecheckerError.notTyp`
  if it is not.
  -/
  partial def isSort (expr : IR.Expr) : TypecheckM (TypedExpr × Univ) := do
    let (expr, typ) ← infer expr
    match typ.get with
    | .sort u =>
      pure (expr, u)
    | val => throw s!"Expected a sort type, found {← ppValue val}"

  partial def checkIndBlock (indBlockF : F) : TypecheckM Unit := do
    let quick := (← read).quick
    let indBlock ← match derefConst indBlockF (← read).store with
      | .mutIndBlock blk => pure blk
      | _ => throw "Invalid Const kind. Expected mutIndBlock"

    -- Check all inductives
    let mut mutTypes := .empty
    for (indIdx, ind) in indBlock.enum do
      let f := mkInductiveProjF indBlockF indIdx quick
      let univs := List.range ind.lvls |>.map .var
      let (type, _) ← withEnv ⟨ [], univs ⟩ $ isSort ind.type
      let ctx ← read
      let stt ← get
      let typeSus := (suspend type {ctx with env := .mk ctx.env.exprs ·} stt)
      mutTypes := mutTypes.insert indIdx (f, typeSus)
      modify fun stt => { stt with typedConsts := stt.typedConsts.insert f (.inductive type ind.struct) }

    -- Check all constructors
    for (indIdx, ind) in indBlock.enum do
      let start := mutTypes.size
      for (cidx, ctor) in ind.ctors.enum do
        let f := mkConstructorProjF indBlockF indIdx cidx quick
        let univs := List.range ctor.lvls |>.map .var
        let (type, _) ← withEnv ⟨ [], univs ⟩ $ withMutTypes mutTypes $ isSort ctor.type
        let ctx ← read
        let stt ← get
        let typeSus := (suspend type {ctx with env := .mk ctx.env.exprs ·} stt)
        mutTypes := mutTypes.insert (start + cidx) (f, typeSus)
        modify fun stt => { stt with typedConsts := stt.typedConsts.insert f (.constructor type ctor.idx ctor.fields) }

    -- Check all recursor types
    for (indIdx, ind) in indBlock.enum do
      let start := mutTypes.size
      for (ridx, recr) in ind.recrs.enum do
        let f := mkRecursorProjF indBlockF indIdx ridx quick
        let univs := List.range recr.lvls |>.map .var
        let (type, _) ← withEnv ⟨ [], univs ⟩ $ withMutTypes mutTypes $ isSort recr.type
        let ctx ← read
        let stt ← get
        let typeSus := (suspend type {ctx with env := .mk ctx.env.exprs ·} stt)
        mutTypes := mutTypes.insert (start + ridx) (f, typeSus)

    -- Check all recursor rules
    for (indIdx, ind) in indBlock.enum do
      for (ridx, recr) in ind.recrs.enum do
        -- TODO: do not recompute `f`, `univs` and `type`
        let f := mkRecursorProjF indBlockF indIdx ridx quick
        let univs := List.range recr.lvls |>.map .var
        let (type, _) ← withEnv ⟨ [], univs ⟩ $ withMutTypes mutTypes $ isSort recr.type
        let indProj := ⟨indBlockF, indIdx⟩
        let rules ← recr.rules.mapM fun rule => do
          let (rhs, _) ← withEnv ⟨ [], univs ⟩ $ withMutTypes mutTypes $ infer rule.rhs
          pure (rule.fields, rhs)
        let recrConst := .recursor type recr.params recr.motives recr.minors recr.indices recr.isK indProj ⟨rules⟩
        modify fun stt => { stt with typedConsts := stt.typedConsts.insert f recrConst }

    return ()

  /-- Typechecks a `Yatima.Const`. The `TypecheckM Unit` computation finishes if the check finishes,
  otherwise a `TypecheckError` is thrown in some other function in the typechecker stack.

  Note that inductives, constructors, and recursors are constructed to typecheck, so this function
  only has to check the other `Const` constructors.
  -/
  partial def checkConst (f : F) : TypecheckM Unit := withResetCtx do
    match (← get).typedConsts.find? f with
    | some _ =>
      pure ()
    | none =>
      let c := derefConst f (← read).store
      if c.isMutType then return ()
      let univs := List.range (← c.levels) |>.map .var
      withEnv ⟨ [], univs ⟩ do
        let quick := (← read).quick
        let newConst ← match c with
          | .axiom ax =>
            if (← read).limitAxioms then
              if quick then
                if !(allowedAxiomQuick f) then
                  throw s!"Axiom {(← read).constNames.getF f} is not allowed"
              else
                if !(allowedAxiom f) then
                  throw s!"Axiom {(← read).constNames.getF f} is not allowed"
            let (type, _) ← isSort ax.type
            pure $ TypedConst.axiom type
          | .opaque data =>
            let (type, _) ← isSort data.type
            let typeSus := suspend type (← read) (← get)
            let value ← withRecF f $ check data.value typeSus
            pure $ TypedConst.opaque type value
          | .theorem data =>
            let (type, _) ← isSort data.type
            let typeSus := suspend type (← read) (← get)
            let value ← withRecF f $ check data.value typeSus
            pure $ TypedConst.theorem type value
          | .definition data =>
            let (type, _) ← isSort data.type
            let ctx ← read
            let typeSus := suspend type ctx (← get)
            let value ←
              if data.part then
                let mutTypes :=
                  let typeSus := (suspend type {ctx with env := .mk ctx.env.exprs ·} (← get))
                  (default : RecrCtx).insert 0 (f, typeSus)
                withMutTypes mutTypes $ withRecF f $ check data.value typeSus
              else withRecF f $ check data.value typeSus
            pure $ TypedConst.definition type value data.part
          | .definitionProj p@⟨defBlockF, _⟩ =>
            let data ← getDefFromProj p
            let (type, _) ← isSort data.type
            let ctx ← read
            let defBlock ← match derefConst defBlockF ctx.store with
              | .mutDefBlock blk => pure blk
              | _ => throw "Invalid Const kind. Expected mutDefBlock"
            let typeSus := suspend type ctx (← get)
            let value ←
              if data.part then
                -- check order should be the same as `recrCtx` in CA
                let mutTypes ← defBlock.enum.foldlM (init := default) fun acc (i, defn) => do
                  let defProjF := mkDefinitionProjF defBlockF i quick
                  -- TODO avoid repeated work here
                  let (type, _) ← isSort defn.type
                  let typeSus := (suspend type {ctx with env := .mk ctx.env.exprs ·} (← get))
                  pure $ acc.insert i (defProjF, typeSus)
                withMutTypes mutTypes $ withRecF f $ check data.value typeSus
              else withRecF f $ check data.value typeSus
            pure $ TypedConst.definition type value data.part
          | .inductiveProj ⟨indBlockF, _⟩ =>
            checkIndBlock indBlockF
            return ()
          | .constructorProj ⟨indBlockF, _, _⟩ =>
            checkIndBlock indBlockF
            return ()
          | .recursorProj ⟨indBlockF, _, _⟩ =>
            checkIndBlock indBlockF
            return ()
          | .quotient data =>
            let (type, _) ← isSort (← c.type)
            pure $ .quotient type data.kind
          | _ => throw "Impossible case. Cannot typecheck a mutual block."
        -- TODO is it okay to use the original hash for the `TypedConst`, or should we compute a new one?
        modify fun stt => { stt with typedConsts := stt.typedConsts.insert f newConst }
end

end Yatima.Typechecker


import for_mathlib.category_theory.localization.shift
import for_mathlib.category_theory.triangulated.triangulated_functor

open category_theory category_theory.limits

namespace category_theory

namespace functor

variables {C H D : Type*} [category C] [category H] [category D]
  [has_shift C ℤ] [has_shift H ℤ] [has_shift D ℤ]
  [has_zero_object C] [has_zero_object H] [has_zero_object D]
  [preadditive C] [preadditive H] [preadditive D]
  [∀ (n : ℤ), (shift_functor C n).additive]
  [∀ (n : ℤ), (shift_functor H n).additive]
  [∀ (n : ℤ), (shift_functor D n).additive]
  [pretriangulated C] [pretriangulated H] [pretriangulated D]
  (L : C ⥤ H) [L.has_comm_shift ℤ]

class ess_surj_on_dist_triang :=
(condition [] : ∀ (T : pretriangulated.triangle H) (hT : T ∈ dist_triang H),
  ∃ (T' : pretriangulated.triangle C) (hT' : T' ∈ dist_triang C),
    nonempty (L.map_triangle.obj T' ≅ T))

variables {L}

lemma is_triangulated.of_ess_surj_on_dist_triang [L.ess_surj_on_dist_triang]
  {F : C ⥤ D} {G : H ⥤ D} (e : L ⋙ G ≅ F) [G.has_comm_shift ℤ] [F.has_comm_shift ℤ]
  [F.is_triangulated] [e.hom.respects_comm_shift ℤ] : G.is_triangulated :=
{ map_distinguished' := λ T hT, begin
    obtain ⟨T', hT', ⟨e₁⟩⟩ := ess_surj_on_dist_triang.condition L T hT,
    exact pretriangulated.isomorphic_distinguished _ (F.map_distinguished _ hT') _
      (G.map_triangle.map_iso e₁.symm ≪≫ (map_triangle_comp L G).symm.app T' ≪≫
      (map_triangle_nat_iso e).app T'),
  end }

instance localization_lift_is_triangulated [L.ess_surj_on_dist_triang]
  (W : morphism_property C) [L.is_localization W]
  (F : C ⥤ D) (hF : W.is_inverted_by F) [F.has_comm_shift ℤ] [F.is_triangulated] :
  (localization.lift F hF L).is_triangulated :=
is_triangulated.of_ess_surj_on_dist_triang (localization.fac F hF L)

end functor

end category_theory