import cof.basic
import cof.valley

-- In these files we define the concept of localizing a category at a
-- (left) multiplicative system.
-- The presence of conditions defining a multiplicative system mean
-- that the resulting category is much easier to work with than
-- localization through the path category.
-- See Stacks Project [Tag 04VB]

noncomputable theory

namespace category_theory

namespace derived

universe u

variables {C : Type u} [small_category C] {S : morphism_property C}
variables {M : left_mult_sys S}

-- Define the identity and composition of valleys

def id_valley (X : left_calculus C M) : valley X X :=
{ obj := X,
  f   := 𝟙 X.as,
  s   := 𝟙 X.as,
  qis := M.id }

structure ore_data {X Y Z : C} :=
  (W  : C)
  (f₁ : X ⟶ Y)
  (s₁ : X ⟶ Z)
  (s₂ : Y ⟶ W)
  (f₂ : Z ⟶ W)
  (hs : (S s₁ ∧ S s₂))
  (comm : (s₁ ≫ f₂) = (f₁ ≫ s₂))

structure comp_data {X Y Z : left_calculus C M} (v₁ : valley X Y) (v₂ : valley Y Z) :=
  (W    : C)
  (h    : v₁.obj.as ⟶ W)
  (u    : v₂.obj.as ⟶ W)
  (hu   : S u)
  (comm : v₂.f ≫ u = v₁.s ≫ h)

-- The Ore condition gives us composition data automatically
def data_from_ore {X Y Z : left_calculus C M} {v₁ : valley X Y} {v₂ : valley Y Z} : comp_data v₁ v₂ :=
let Y' := v₁.obj, Z' := v₂.obj in
  have hyp : _ :=
    M.ore v₂.f v₁.s v₁.qis,
  let Z'' := classical.some hyp in
  have hyp₁ : ∃ (f : Y'.as ⟶ Z'') (s : Z'.as ⟶ Z''), S s ∧ v₂.f ≫ s = v₁.s ≫ f :=
    classical.some_spec hyp,
  let h := classical.some hyp₁ in
  have hyp₂ : ∃ (s : Z'.as ⟶ Z''), S s ∧ v₂.f ≫ s = v₁.s ≫ h :=
    classical.some_spec hyp₁,
  let u := classical.some hyp₂ in
  have hyp₃ : S u ∧ v₂.f ≫ u = v₁.s ≫ h := (classical.some_spec hyp₂),
  { W    := Z'',
    h    := h,
    u    := u,
    hu   := hyp₃.left,
    comm := hyp₃.right }

def comp_valley_from_data {X Y Z : left_calculus C M}
    (v₁ : valley X Y) (v₂ : valley Y Z) (data : comp_data v₁ v₂)
  : valley X Z :=
  { obj := ⟨ data.W ⟩,
    f   := v₁.f ≫ data.h,
    s   := v₂.s ≫ data.u,
    qis := M.comp ⟨v₂.qis, data.hu⟩ }

lemma comp_valley_obj {X Y Z : left_calculus C M}
    (v₁ : valley X Y) (v₂ : valley Y Z) (data : comp_data v₁ v₂)
  : (comp_valley_from_data v₁ v₂ data).obj.as = data.W := rfl

-- As a default, we can always define composition using the Ore data
def comp_valley {X Y Z : left_calculus C M} (v₁ : valley X Y) (v₂ : valley Y Z) : valley X Z :=
  comp_valley_from_data v₁ v₂ data_from_ore

-- Composition is well defined under the equivalence relation
lemma comp_independent_of_data' {X Y Z : left_calculus C M} (v₁ : valley X Y) (v₂ : valley Y Z) (d₁ d₂ : comp_data v₁ v₂) :
  ⟦ comp_valley_from_data v₁ v₂ d₁ ⟧ = ⟦ comp_valley_from_data v₁ v₂ d₂ ⟧  :=
let c₁ := comp_valley_from_data v₁ v₂ d₁, c₂ := comp_valley_from_data v₁ v₂ d₂ in
match M.ore d₂.u d₁.u d₁.hu with ⟨W, h', u', hu', hc⟩ :=
  begin
    have h₁ : _, by calc
      v₁.s ≫ d₂.h ≫ u' = (v₂.f ≫ d₂.u) ≫ u' : by rw [←category.assoc, d₂.comm]
      ... = v₂.f ≫ (d₁.u ≫ h') : by rw [category.assoc, hc]
      ... = v₁.s ≫ d₁.h ≫ h' : by {rw [←category.assoc, d₁.comm], simp},
    have h₂ : _, from M.cancel ⟨v₁.qis, h₁⟩,
    rcases h₂ with ⟨Z', s', hs', hc'⟩,

    let h'' := h' ≫ s',
    let u'' := u' ≫ s',
    have h₂ : d₂.h ≫ u'' = d₁.h ≫ h'', by rw [←category.assoc, hc', category.assoc],
    have h₃ : d₂.u ≫ u'' = d₁.u ≫ h'', by rw [←category.assoc, hc, category.assoc],
    have hu'' : S u'', from M.comp ⟨hu', hs'⟩,

    apply quotient.eq.mpr,

    let v : valley X Z := {
      obj := {as := Z'},
      f   := v₁.f ≫ d₂.h ≫ u'',
      s   := v₂.s ≫ d₂.u ≫ u'',
      qis := triple_comp M ⟨v₂.qis, d₂.hu, hu''⟩,
    },
    use [v, h'', u''],

    simp, split,
    have hlemma : c₁.f = (v₁.f ≫ d₁.h), by refl,
    rw [hlemma, h₂], simp,

    split,
    have hlemma : c₁.s = (v₂.s ≫ d₁.u), by refl,
    rw [hlemma, h₃], simp,

    split,
    have hlemma : c₂.f = (v₁.f ≫ d₂.h), by refl,
    rw hlemma, simp,

    have hlemma : c₂.s = (v₂.s ≫ d₂.u), by refl,
    rw hlemma, simp,
  end
end

lemma comp_independent_of_data {X Y Z : left_calculus C M} (v₁ : valley X Y) (v₂ : valley Y Z) (d : comp_data v₁ v₂) :
  ⟦ comp_valley v₁ v₂ ⟧ = ⟦ comp_valley_from_data v₁ v₂ d ⟧  :=
comp_independent_of_data' v₁ v₂ data_from_ore d

lemma dom_imp_post_comp {X Y Z : left_calculus C M} (v₁ v₂ : valley X Y) (w : valley Y Z) (dom : v₁ E v₂) :
  ⟦ comp_valley v₁ w ⟧ = ⟦ comp_valley v₂ w ⟧ :=
begin
  rcases dom with ⟨a, ha₁, ha₂⟩,

  let g := w.f,
  have hore : _ := M.ore g v₂.s v₂.qis,
  rcases hore with ⟨Z'', h, u, hu, hcomm⟩,

  have hcomm' : g ≫ u = v₁.s ≫ a ≫ h, by rw [←category.assoc, ha₂, hcomm],
  let d₁ : comp_data v₁ w := {
    W := Z'',
    h := a ≫ h,
    u := u,
    hu := hu,
    comm := hcomm',
  },
  let d₂ : comp_data v₂ w := {
    W := Z'',
    h := h,
    u := u,
    hu := hu,
    comm := hcomm,
  },
  have hcomp₁ : _ := comp_independent_of_data v₁ w d₁,
  have hcomp₂ : _ := comp_independent_of_data v₂ w d₂,

  let c₁ := comp_valley_from_data v₁ w d₁,
  let c₂ := comp_valley_from_data v₂ w d₂,
  suffices heq : ⟦ c₁ ⟧ = ⟦ c₂ ⟧, by rw [hcomp₁, hcomp₂, heq],

  suffices heq' : veq X Z c₁ c₂, by {apply quotient.eq.mpr, exact heq'},

  use [Z'', c₁.f, c₂.s, c₂.qis, 𝟙 Z'', 𝟙 Z''],
  simp,
  -- idk why we need this, but simp can't seem to take care of it
  -- otherwise.
  have hlemma : ∀ {X : C}, ∀ f : X ⟶ Z'', f ≫ 𝟙 Z'' = f, by {intro f, simp},
  split, exact hlemma c₁.f, rw [hlemma c₁.s],
  split, refl,
  split, rw [hlemma c₂.f],

  have hc₁ : c₁.f = v₁.f ≫ a ≫ h, by refl, rw hc₁,
  have hc₂ : c₂.f = v₂.f ≫ h, by refl, rw hc₂,
  rw [←category.assoc, ha₁],
  rw hlemma c₂.s,
end

lemma dom_imp_pre_comp {X Y Z : left_calculus C M} (v₁ v₂ : valley X Y) (w: valley Z X) (dom : v₁ E v₂) :
  ⟦ comp_valley w v₁ ⟧ = ⟦ comp_valley w v₂ ⟧ :=
begin
  rcases dom with ⟨a, ha₁, ha₂⟩,

  have hore₁ : _ := M.ore v₁.f w.s w.qis,
  rcases hore₁ with ⟨Z₁, h₁, t₁, ht₁, hcomm₁⟩,
  have hore₂ : _ := M.ore a t₁ ht₁,
  rcases hore₂ with ⟨Z₂, h₂, t₂, ht₂, hcomm₂⟩,

  let d₁ : comp_data w v₁ := {
    W := Z₁,
    h := h₁,
    u := t₁,
    hu := ht₁,
    comm := hcomm₁,
  },

  have hcomm' : v₂.f ≫ t₂ = w.s ≫ h₁ ≫ h₂, by
    {rw [←ha₁, category.assoc, hcomm₂, ←category.assoc, hcomm₁], simp},
  let d₂ : comp_data w v₂ := {
    W := Z₂,
    h := h₁ ≫ h₂,
    u := t₂,
    hu := ht₂,
    comm := hcomm',
  },

  have hcomp₁ : _ := comp_independent_of_data w v₁ d₁,
  have hcomp₂ : _ := comp_independent_of_data w v₂ d₂,

  let c₁ := comp_valley_from_data w v₁ d₁,
  let c₂ := comp_valley_from_data w v₂ d₂,
  suffices heq : ⟦ c₁ ⟧ = ⟦ c₂ ⟧, by rw [hcomp₁, hcomp₂, heq],
  suffices heq' : veq Z Y c₁ c₂, by {apply quotient.eq.mpr, exact heq'},

  use [c₂, h₂, 𝟙 Z₂],
  split,
  { have hlemma₁ : c₁.f = w.f ≫ h₁, by refl,
    rw hlemma₁, simp,
    have hlemma₂ : c₂.f = w.f ≫ (h₁ ≫ h₂), by refl,
    rw hlemma₂ },
  split,
  { have hlemma₁ : c₁.s = v₁.s ≫ t₁, by refl,
    have hlemma₂ : c₂.s = v₂.s ≫ t₂, by refl,
    rw [hlemma₁, hlemma₂], simp, rw [←hcomm₂, ←category.assoc, ha₂] },

  have hlemma : ∀ {X : C}, ∀ f : X ⟶ Z₂, f ≫ 𝟙 Z₂ = f, by {intro f, simp},
  split,
  rw hlemma c₂.f,
  rw hlemma c₂.s,
end

lemma comp_well_def {X Y Z : left_calculus C M}  (v₁ v₁' : valley X Y) (v₂ v₂' : valley Y Z) :
  ⟦ v₁ ⟧ = ⟦ v₁' ⟧ ∧ ⟦ v₂ ⟧ = ⟦ v₂' ⟧ → ⟦ comp_valley v₁ v₂ ⟧ = ⟦ comp_valley v₁' v₂' ⟧ :=
begin
  rintro ⟨ h₁, h₂ ⟩,
  have h₁' : _ := quotient.eq.mp h₁,
  have h₂' : _ := quotient.eq.mp h₂,

  show ⟦ comp_valley v₁ v₂ ⟧ = ⟦ comp_valley v₁' v₂' ⟧,

  have dom₁ : _ := (dom_iff_equiv _ _).mpr h₁',
  have dom₂ : _ := (dom_iff_equiv _ _).mpr h₂',

  rcases dom₁ with ⟨w₁, dv₁, dv₁'⟩,
  rcases dom₂ with ⟨w₂, dv₂, dv₂'⟩,

  have heq₁ : ⟦ comp_valley v₁ v₂ ⟧ = ⟦ comp_valley w₁ w₂ ⟧,
  by calc
    ⟦ comp_valley v₁ v₂ ⟧
        = ⟦ comp_valley w₁ v₂ ⟧ : by { apply (dom_imp_post_comp _ _ _ dv₁)}
    ... = ⟦ comp_valley w₁ w₂ ⟧ : by { apply (dom_imp_pre_comp  _ _ _ dv₂)},

  have heq₂ : ⟦ comp_valley v₁' v₂' ⟧ = ⟦ comp_valley w₁ w₂ ⟧,
  by calc
    ⟦ comp_valley v₁' v₂' ⟧
        = ⟦ comp_valley w₁ v₂' ⟧ : by { apply (dom_imp_post_comp _ _ _ dv₁')}
    ... = ⟦ comp_valley w₁ w₂ ⟧  : by { apply (dom_imp_pre_comp  _ _ _ dv₂')},

  rw [heq₁, heq₂],
end

-- The axioms for the category

def hom_type (X Y : left_calculus C M) := quotient (valley_setoid X Y)

def id (X : left_calculus C M) := ⟦ id_valley X ⟧

def comp {X Y Z : left_calculus C M} (f : hom_type X Y) (g : hom_type Y Z) :=
  ⟦ comp_valley (quotient.out f) (quotient.out g) ⟧

@[simp]
lemma id_comp' (X Y : left_calculus C M) (f : hom_type X Y) :
  comp (id X) f = f :=
let g := comp (id X) f,
    f' := f.out,
    data : comp_data (id_valley X) f' :=
      { W := f'.obj.as,
        h := f'.f,
        u := (𝟙 f'.obj.as),
        hu := M.id,
        comm := have h : (id_valley X).s = 𝟙 X.as, from rfl,
          by {simp, rw h, simp},
      },
    g' := comp_valley_from_data (id_valley X) f' data in
begin
  change g = f,
  have h₁ : g = ⟦ comp_valley (id_valley X) f' ⟧,
    by { apply comp_well_def, split, simp, refl, refl },
  have h₂ : ⟦ comp_valley (id_valley X) f' ⟧ = ⟦ comp_valley_from_data (id_valley X) f' data ⟧,
    from comp_independent_of_data _ _ _,
  rw [h₁, h₂],
  suffices : veq X Y g' f', by {
      apply quotient.mk_eq_iff_out.mpr,
      exact this,
  },
  use [f', 𝟙 f'.obj.as, 𝟙 f'.obj.as], simp,
  have hlemma : ∀ {X : C}, ∀ f : X ⟶ f'.obj.as, f ≫ 𝟙 f'.obj.as = f, by {intro f, simp},
  split,
  { have : g'.f = (𝟙 X.as) ≫ f'.f, by refl, rw this,
    simp,
    rw hlemma f'.f },
  { have : g'.s = f'.s ≫ (𝟙 f'.obj.as), by refl, rw this,
    simp,
    rw hlemma f'.s},
end

@[simp]
lemma comp_id' (X Y : left_calculus C M) (f : hom_type X Y) :
  comp f (id Y) = f :=
let g := comp f (id Y),
    f' := f.out,
    data : comp_data f' (id_valley Y) :=
      { W := f'.obj.as,
        h := (𝟙 f'.obj.as),
        u := f'.s,
        hu := f'.qis,
        comm := have h : (id_valley Y).f = 𝟙 Y.as, from rfl,
          by {simp, rw h, simp},
      },
    g' := comp_valley_from_data f' (id_valley Y) data in
begin
  change g = f,
  have h₁ : g = ⟦ comp_valley f' (id_valley Y) ⟧,
    by { apply comp_well_def, split, simp, simp, refl },
  have h₂ : ⟦ comp_valley f' (id_valley Y) ⟧ = ⟦ comp_valley_from_data f' (id_valley Y) data ⟧,
    from comp_independent_of_data _ _ _,
  rw [h₁, h₂],
  suffices : veq X Y g' f', by {
      apply quotient.mk_eq_iff_out.mpr,
      exact this,
  },
  use [f', 𝟙 f'.obj.as, 𝟙 f'.obj.as], simp,
  have hlemma : ∀ {X : C}, ∀ f : X ⟶ f'.obj.as, f ≫ 𝟙 f'.obj.as = f, by {intro f, simp},
  split,
  { have : g'.f = f'.f ≫ (𝟙 f'.obj.as), by refl, rw this,
    simp,
    rw hlemma f'.f },
  { have : g'.s = (𝟙 Y.as) ≫ f'.s, by refl, rw this,
    simp,
    rw hlemma f'.s},
end

lemma assoc' {W X Y Z : left_calculus C M} (f : hom_type W X) (g : hom_type X Y) (h : hom_type Y Z) :
  comp (comp f g) h = comp f (comp g h) :=
let a := f.out,
    b := g.out,
    c := h.out in
begin
  rcases (M.ore b.f a.s a.qis) with ⟨Y'', f₁, s₁, hs₁, hc₁⟩,
  rcases (M.ore c.f b.s b.qis) with ⟨Z'', f₂, s₂, hs₂, hc₂⟩,
  rcases (M.ore f₂ s₁ hs₁)     with ⟨Z''', f₃, s₃, hs₃, hc₃⟩,

  let v : valley W Z := {
    obj := ⟨ Z''' ⟩,
    f   := a.f ≫ f₁ ≫ f₃,
    s   := c.s ≫ s₂ ≫ s₃,
    qis  := triple_comp M ⟨c.qis, hs₂, hs₃⟩,
  },

  let d₁ : comp_data a b := {
    W := Y'',
    h := f₁,
    u := s₁,
    hu := hs₁,
    comm := hc₁,
  },
  let d₂ : comp_data b c := {
    W := Z'',
    h := f₂,
    u := s₂,
    hu := hs₂,
    comm := hc₂,
  },

  let cab := comp_valley_from_data a b d₁,
  let cbc := comp_valley_from_data b c d₂,
  have h₁ : comp f g = ⟦ cab ⟧, by {apply comp_independent_of_data},
  have h₂ : comp g h = ⟦ cbc ⟧, by {apply comp_independent_of_data},
  rw [h₁, h₂],

  let d₃ : comp_data cab c := {
    W := Z''',
    h := f₃,
    u := s₂ ≫ s₃,
    hu := M.comp ⟨hs₂, hs₃⟩,
    comm := begin
      have : cab.s = b.s ≫ s₁, by refl,
      rw [this, category.assoc, ←hc₃, ←category.assoc, hc₂],
      simp,
    end,
  },
  let d₄ : comp_data a cbc := {
    W := Z''',
    h := f₁ ≫ f₃,
    u := s₃,
    hu := hs₃,
    comm := begin
      rw [←category.assoc, ←hc₁, category.assoc, ←hc₃, ←category.assoc],
      refl,
    end,
  },
  let ccabc := comp_valley_from_data cab c d₃,
  let cacbc := comp_valley_from_data a cbc d₄,

  have hcomp₁ : comp ⟦cab⟧ h = ⟦ ccabc ⟧, by calc
    comp ⟦cab⟧ h = ⟦comp_valley cab c⟧ : by {apply comp_well_def, simp}
    ... = ⟦ ccabc ⟧ : by {apply comp_independent_of_data},
  have hcomp₂ : comp f ⟦cbc⟧ = ⟦ cacbc ⟧, by calc
    comp f ⟦cbc⟧ = ⟦comp_valley a cbc⟧ : by {apply comp_well_def, simp}
    ... = ⟦ cacbc ⟧ : by {apply comp_independent_of_data},
  rw [hcomp₁, hcomp₂],

  apply quotient.eq.mpr,
  use [v, (𝟙 Z'''), (𝟙 Z''')],
  simp,
  have hlemma : ∀ {X : C}, ∀ f : X ⟶ Z''', f ≫ 𝟙 Z''' = f, by {intro f, simp},
  repeat {rw hlemma}, split,
    {rw ←category.assoc, refl},
  split,
    {refl},
  split,
    {refl},
    {rw ←category.assoc, refl}
end

-- Define the category structure

instance : category (left_calculus C M) :=
{ hom  := hom_type,
  id   := id,
  comp := λ _ _ _, comp,
  id_comp' := id_comp',
  comp_id' := comp_id',
  assoc' := λ _ _ _ _, assoc',
}

-- Some properties of this category

-- We have a canonical functor
@[simps]
def Q : C ⥤ left_calculus C M :=
{ obj := λ a, { as := a },
  map := λ X Y f, ⟦{ obj := ⟨ Y ⟩, f := f, s := 𝟙 Y, qis := M.id }⟧,
  map_comp' := λ X Y Z f g, begin
    -- Simplify notation
    let v₁ : valley ⟨X⟩ ⟨Z⟩ := {obj := {as := Z}, f := f ≫ g, s := 𝟙 Z, qis := _},
    let v₂ : valley ⟨X⟩ ⟨Y⟩ := {obj := {as := Y}, f := f, s := 𝟙 Y, qis := _},
    let v₃ : valley ⟨Y⟩ ⟨Z⟩ := {obj := {as := Z}, f := g, s := 𝟙 Z, qis := _},
    let c₁ : hom_type ⟨X⟩ ⟨Z⟩ := ⟦v₁⟧,
    let c₂ : hom_type ⟨X⟩ ⟨Z⟩ := comp ⟦v₂⟧ ⟦v₃⟧,
    suffices h : c₁ = c₂, by exact h,

    have h' : c₂ = ⟦ comp_valley v₂ v₃ ⟧, by calc
        c₂ = ⟦comp_valley v₂ ⟦v₃⟧.out⟧ : by
          {apply comp_well_def, simp, split, repeat {apply (valley_equiv_refl _ _)}}
        ... = ⟦comp_valley v₂ v₃⟧ : by
          {apply comp_well_def, simp, split, repeat {apply (valley_equiv_refl _ _)}},
    rw h',

    have h'' : ⟦ comp_valley v₂ v₃ ⟧ = c₁, by begin
      let d : comp_data v₂ v₃ :=
        { W := Z, h := g, u := 𝟙 Z, hu := M.id, comm := by simp },
      let c₄ := comp_valley_from_data v₂ v₃ d,
      have : ⟦comp_valley v₂ v₃⟧ = ⟦c₄⟧, by apply comp_independent_of_data,
      rw this,

      apply quotient.eq.mpr,
      use [v₁, 𝟙 Z], simp,

      have : c₄.f = f ≫ g, by refl, rw this,
      have : c₄.s = 𝟙 Z ≫ 𝟙 Z, by refl, rw this,
      simp, rw ←category.assoc,
      have hlemma : ∀ {X : C}, ∀ f : X ⟶ Z, f ≫ 𝟙 Z = f, by simp,
      rw hlemma,
    end,
    rw ←h'',
  end }

theorem functor_inverts_qis {X Y : C} (s : X ⟶ Y) [qis : S s] : @is_iso (left_calculus C M) _ _ _ (Q.map s) :=
⟨ begin
    let v : valley ⟨Y⟩ ⟨X⟩ := {obj := ⟨Y⟩, f := 𝟙 Y, s := s, qis := qis},
    use ⟦ v ⟧,
    sorry,
  end ⟩

theorem functor_univ_prop {D : Type u} [category D] (g : C ⥤ D) :
  (∀ X Y : C, ∀ s : X ⟶ Y, S s → is_iso (g.map s))
  → ∃! h : left_calculus C M ⥤ D, g = Q ⋙ h :=
begin
  sorry
end

end derived

end category_theory


import category_theory.colimit_lemmas
import .definitions

universes v u

open category_theory
open category_theory.category
local notation f ` ∘ `:80 g:80 := g ≫ f

namespace homotopy_theory.cofibrations
open category_theory.has_initial_object category_theory.preserves_initial_object
open category_theory.preserves_coproducts
open homotopy_theory.cylinder
open I_category

variables {C : Type u} [category.{v} C] [has_initial_object.{v} C]
  [has_coproducts.{v} C] [I_category.{v} C]

def Ii_initial : Is_initial_object.{v} (I.obj ∅ : C) :=
Is_initial_object_of_Is_initial_object
  has_initial_object.initial_object.is_initial_object

def I_preserves_coproducts : preserves_coproducts (I : C ↝ C) :=
⟨λ a₀ a₁ b f₀ f₁ copr,
  let po : Is_pushout (! a₀) (! a₁) f₀ f₁ :=
    Is_pushout_of_Is_coproduct_of_Is_initial copr
      has_initial_object.initial_object.is_initial_object in
  Is_coproduct_of_Is_pushout_of_Is_initial
    (I_preserves_pushout_by_cof (all_objects_cofibrant.cofibrant a₀) po) Ii_initial⟩

def I_of_coprod_is_coproduct {a₀ a₁ : C} :
  Is_coproduct (I &> (i₀ : a₀ ⟶ a₀ ⊔ a₁)) (I &> (i₁ : a₁ ⟶ a₀ ⊔ a₁)) :=
let ⟨f⟩ := I_preserves_coproducts in
f (has_coproducts.coproduct.{v} a₀ a₁).is_coproduct

lemma I_preserves_cofibrations {a b : C} {j : a ⟶ b} (hj : is_cof j) : is_cof (I.map j) :=
begin
  convert cof_comp _ (relative_cylinder j hj),
  exact (Is_pushout.induced_commutes₁ _ _ _ _).symm,
  exact precofibration_category.pushout_is_cof (pushout.is_pushout _) (cof_coprod hj hj)
end

end homotopy_theory.cofibrations


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.monoidal.functor
import category_theory.full_subcategory

/-!
# Monoidal natural transformations

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

Natural transformations between (lax) monoidal functors must satisfy
an additional compatibility relation with the tensorators:
`F.μ X Y ≫ app (X ⊗ Y) = (app X ⊗ app Y) ≫ G.μ X Y`.

(Lax) monoidal functors between a fixed pair of monoidal categories
themselves form a category.
-/

open category_theory

universes v₁ v₂ v₃ u₁ u₂ u₃

open category_theory.category
open category_theory.functor

namespace category_theory

open monoidal_category

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

/--
A monoidal natural transformation is a natural transformation between (lax) monoidal functors
additionally satisfying:
`F.μ X Y ≫ app (X ⊗ Y) = (app X ⊗ app Y) ≫ G.μ X Y`
-/
@[ext]
structure monoidal_nat_trans (F G : lax_monoidal_functor C D)
  extends nat_trans F.to_functor G.to_functor :=
(unit' : F.ε ≫ app (𝟙_ C) = G.ε . obviously)
(tensor' : ∀ X Y, F.μ _ _ ≫ app (X ⊗ Y) = (app X ⊗ app Y) ≫ G.μ _ _ . obviously)

restate_axiom monoidal_nat_trans.tensor'
attribute [simp, reassoc] monoidal_nat_trans.tensor
restate_axiom monoidal_nat_trans.unit'
attribute [simp, reassoc] monoidal_nat_trans.unit

namespace monoidal_nat_trans

/--
The identity monoidal natural transformation.
-/
@[simps]
def id (F : lax_monoidal_functor C D) : monoidal_nat_trans F F :=
{ ..(𝟙 F.to_functor) }

instance (F : lax_monoidal_functor C D) : inhabited (monoidal_nat_trans F F) := ⟨id F⟩

/--
Vertical composition of monoidal natural transformations.
-/
@[simps]
def vcomp {F G H : lax_monoidal_functor C D}
  (α : monoidal_nat_trans F G) (β : monoidal_nat_trans G H) : monoidal_nat_trans F H :=
{ ..(nat_trans.vcomp α.to_nat_trans β.to_nat_trans) }

instance category_lax_monoidal_functor : category (lax_monoidal_functor C D) :=
{ hom := monoidal_nat_trans,
  id := id,
  comp := λ F G H α β, vcomp α β, }

@[simp] lemma comp_to_nat_trans_lax {F G H : lax_monoidal_functor C D} {α : F ⟶ G} {β : G ⟶ H} :
  (α ≫ β).to_nat_trans =
    @category_struct.comp (C ⥤ D) _ _ _ _ (α.to_nat_trans) (β.to_nat_trans) := rfl

instance category_monoidal_functor : category (monoidal_functor C D) :=
induced_category.category monoidal_functor.to_lax_monoidal_functor

@[simp]

variables {E : Type u₃} [category.{v₃} E] [monoidal_category.{v₃} E]

/--
Horizontal composition of monoidal natural transformations.
-/
@[simps]
def hcomp {F G : lax_monoidal_functor C D} {H K : lax_monoidal_functor D E}
  (α : monoidal_nat_trans F G) (β : monoidal_nat_trans H K) :
  monoidal_nat_trans (F ⊗⋙ H) (G ⊗⋙ K) :=
{ unit' :=
  begin
    dsimp, simp,
    conv_lhs { rw [←K.to_functor.map_comp, α.unit], },
  end,
  tensor' := λ X Y,
  begin
    dsimp, simp,
    conv_lhs { rw [←K.to_functor.map_comp, α.tensor, K.to_functor.map_comp], },
  end,
  ..(nat_trans.hcomp α.to_nat_trans β.to_nat_trans) }

section

local attribute [simp] nat_trans.naturality monoidal_nat_trans.unit monoidal_nat_trans.tensor

/-- The cartesian product of two monoidal natural transformations is monoidal. -/
@[simps]
def prod {F G : lax_monoidal_functor C D} {H K : lax_monoidal_functor C E}
  (α : monoidal_nat_trans F G) (β : monoidal_nat_trans H K) :
  monoidal_nat_trans (F.prod' H) (G.prod' K) :=
{ app := λ X, (α.app X, β.app X) }

end

end monoidal_nat_trans

namespace monoidal_nat_iso

variables {F G : lax_monoidal_functor C D}

/--
Construct a monoidal natural isomorphism from object level isomorphisms,
and the monoidal naturality in the forward direction.
-/
def of_components
  (app : ∀ X : C, F.obj X ≅ G.obj X)
  (naturality : ∀ {X Y : C} (f : X ⟶ Y), F.map f ≫ (app Y).hom = (app X).hom ≫ G.map f)
  (unit : F.ε ≫ (app (𝟙_ C)).hom = G.ε)
  (tensor : ∀ X Y, F.μ X Y ≫ (app (X ⊗ Y)).hom = ((app X).hom ⊗ (app Y).hom) ≫ G.μ X Y) :
  F ≅ G :=
{ hom := { app := λ X, (app X).hom, },
  inv :=
  { app := λ X, (app X).inv,
    unit' := by { dsimp, rw [←unit, assoc, iso.hom_inv_id, comp_id], },
    tensor' := λ X Y,
    begin
      dsimp,
      rw [iso.comp_inv_eq, assoc, tensor, ←tensor_comp_assoc,
        iso.inv_hom_id, iso.inv_hom_id, tensor_id, id_comp],
    end,
    ..(nat_iso.of_components app @naturality).inv, }, }

@[simp] lemma of_components.hom_app
  (app : ∀ X : C, F.obj X ≅ G.obj X) (naturality) (unit) (tensor) (X) :
  (of_components app naturality unit tensor).hom.app X = (app X).hom := rfl
@[simp] lemma of_components.inv_app
  (app : ∀ X : C, F.obj X ≅ G.obj X) (naturality) (unit) (tensor) (X) :
  (of_components app naturality unit tensor).inv.app X = (app X).inv :=
by simp [of_components]

instance is_iso_of_is_iso_app (α : F ⟶ G) [∀ X : C, is_iso (α.app X)] : is_iso α :=
⟨(is_iso.of_iso (of_components (λ X, as_iso (α.app X))
  (λ X Y f, α.to_nat_trans.naturality f) α.unit α.tensor)).1⟩

end monoidal_nat_iso

noncomputable theory

/-- The unit of a monoidal equivalence can be upgraded to a monoidal natural transformation. -/
@[simps]
def monoidal_unit (F : monoidal_functor C D) [is_equivalence F.to_functor] :
  lax_monoidal_functor.id C ⟶
    F.to_lax_monoidal_functor ⊗⋙ (monoidal_inverse F).to_lax_monoidal_functor :=
let e := F.to_functor.as_equivalence in
{ to_nat_trans := e.unit,
  tensor' := λ X Y, begin
    -- This proof is not pretty; golfing welcome!
    dsimp,
    simp only [adjunction.hom_equiv_unit, adjunction.hom_equiv_naturality_right,
      category.id_comp, category.assoc],
    simp only [←functor.map_comp],
    erw [e.counit_app_functor, e.counit_app_functor, F.to_lax_monoidal_functor.μ_natural,
      is_iso.inv_hom_id_assoc],
    simp only [category_theory.is_equivalence.inv_fun_map],
    slice_rhs 2 3 { erw iso.hom_inv_id_app, },
    dsimp,
    simp only [category_theory.category.id_comp],
    slice_rhs 1 2 { rw [←tensor_comp, iso.hom_inv_id_app, iso.hom_inv_id_app],
      dsimp, rw [tensor_id], },
    simp,
  end }.

instance (F : monoidal_functor C D) [is_equivalence F.to_functor] : is_iso (monoidal_unit F) :=
begin
  haveI : ∀ (X : C), is_iso ((monoidal_unit F).to_nat_trans.app X),
  { intros, dsimp, apply_instance, },
  exact monoidal_nat_iso.is_iso_of_is_iso_app _
end

/-- The counit of a monoidal equivalence can be upgraded to a monoidal natural transformation. -/
@[simps]
def monoidal_counit (F : monoidal_functor C D) [is_equivalence F.to_functor] :
  (monoidal_inverse F).to_lax_monoidal_functor ⊗⋙ F.to_lax_monoidal_functor ⟶
    lax_monoidal_functor.id D :=
let e := F.to_functor.as_equivalence in
{ to_nat_trans := e.counit,
  unit' := begin
    dsimp,
    simp only [category.comp_id, category.assoc, functor.map_inv, functor.map_comp,
      nat_iso.inv_inv_app, is_iso.inv_comp, is_equivalence.fun_inv_map, adjunction.hom_equiv_unit],
    erw [e.counit_app_functor, ←e.functor.map_comp_assoc, iso.hom_inv_id_app],
    dsimp, simp,
  end,
  tensor' := λ X Y, begin
    dsimp,
    simp only [adjunction.hom_equiv_unit, adjunction.hom_equiv_naturality_right, category.assoc,
      category.comp_id, functor.map_comp],
    simp only [is_equivalence.fun_inv_map],
    erw [e.counit_app_functor],
    simp only [category.assoc],
    erw [←e.functor.map_comp_assoc],
    simp only [category_theory.iso.inv_hom_id_app,
      category_theory.iso.inv_hom_id_app_assoc],
    erw [iso.hom_inv_id_app],
    erw [category_theory.functor.map_id],
    simp only [category.id_comp],
    simp only [category_theory.iso.inv_hom_id_app,
      category_theory.is_iso.hom_inv_id_assoc],
    erw [iso.inv_hom_id_app],
    dsimp, simp, refl,
  end }

instance (F : monoidal_functor C D) [is_equivalence F.to_functor] : is_iso (monoidal_counit F) :=
begin
  haveI : ∀ (X : D), is_iso ((monoidal_counit F).to_nat_trans.app X),
  { intros, dsimp, apply_instance, },
  exact monoidal_nat_iso.is_iso_of_is_iso_app _
end

end category_theory


import unitb.models.nondet
import unitb.refinement.basic

namespace nondet

open temporal
open predicate
open unitb

universe variable u

section defs

variables {α β : Type}

structure evt_ref (lbl : Type) (mc : program α) (ea : event α) (ecs : lbl → event α) : Type :=
  (witness : lbl → α → Prop)
  (witness_fis : ⦃ ∃∃ e, witness e ⦄)
  (delay : ∀ ec, witness ec ⋀ ea.coarse_sch ⋀ ea.fine_sch ↦ witness ec ⋀ (ecs ec).coarse_sch in mc)
  (stable : ∀ ec, unless_except mc (witness ec ⋀ (ecs ec).coarse_sch) (-ea.coarse_sch) { e | ∃ l, ecs l = e })
  (resched : ∀ ec, ea.coarse_sch ⋀ ea.fine_sch ⋀ witness ec ↦ (ecs ec).fine_sch in mc)

structure refined (ma mc : program α) : Type :=
  (sim_init : mc^.first ⟹ ma^.first)
  (abs : option mc.lbl → option ma.lbl)
  (evt_sim : ∀ ec, ⟦ mc.step_of ec ⟧ ⟹ ⟦ ma.step_of (abs ec) ⟧)
  (events : ∀ ae, evt_ref { ec // abs ec = ae } mc (ma.event ae) (λ ec, mc.event ec.val) )

lemma refined.sim {ma mc : program α}
  (R : refined ma mc)
: ⟦ is_step mc ⟧ ⟹ ⟦ is_step ma ⟧ :=
begin
  simp [is_step_exists_event'],
  intro τ,
  simp,
  intros ce H,
  existsi (R.abs ce),
  apply R.evt_sim _ _ H,
end

end defs

section soundness

parameters {α β : Type}

parameter (ma : program α)
parameter (mc : program α)

open temporal

parameter R : refined ma mc
parameter τ : stream α
parameter M₁ : system_sem.ex mc τ

section schedules

parameter e : option ma.lbl
@[reducible]
def imp_lbl := { ec : option mc.lbl // R.abs ec = e }

def AC := (program.event ma e).coarse_sch
def AF := (program.event ma e).fine_sch
def W (e' : imp_lbl) := (R.events e).witness e'
def CC (e' : option mc.lbl) := mc.coarse_sch_of e'
def CF (e' : option mc.lbl) := mc.fine_sch_of e'

parameter abs_coarse : (◇◻(•AC ⋀ -⟦ ma.step_of e ⟧)) τ

parameter abs_fine : (◻◇•AF) τ

include M₁
include W
include abs_coarse
include abs_fine

lemma abs_coarse_and_fine
: (◻◇(•AC ⋀ •AF)) τ :=
begin
  apply coincidence,
  { apply stable_entails_stable _ _ abs_coarse,
    apply λ _, and.left },
  { apply abs_fine },
end

lemma conc_coarse : ∃ e', (◇◻(• W e' ⋀ • CC e'.val) ) τ :=
begin
  have H : ((∃∃ e', ◇◻(• W ma mc R e e' ⋀ • CC mc e'.val))
                   ⋁ ◻◇((-•AC ma e) ⋁ ∃∃ e' : imp_lbl ma mc R e, ⟦ mc.step_of e'.val ⟧)) τ,
  { rw exists_action,
    apply p_or_p_imp_p_or_right _ (unless_sem_exists' M₁.safety (R.events e).stable _),
    { apply inf_often_entails_inf_often,
      apply p_or_p_imp_p_or_right' _,
      apply action_entails_action,
      intros σ σ',
      simp [mem_set_of,imp_lbl],
      intros ec H x H' H₂,
      existsi [x],
      cases H with H₀ H,
      cases H with H₁ STEP,
      unfold program.step_of,
      simp [H',event.step_of,STEP,H₀,H₁,H₂], },
    have H' := leads_to.gen_disj' (R.events e).delay,
    apply inf_often_of_leads_to (system_sem.leads_to_sem H' _ M₁),
    simp,
    have H' := ew_eq_true (R.events e).witness_fis,
    rw [← p_and_over_p_exists_right
       ,← p_and_over_p_exists_right],
    simp [H'],
    apply abs_coarse_and_fine ma mc _ M₁ _ abs_coarse abs_fine, },
  simp at H,
  cases H with H H,
  { exfalso,
    revert abs_coarse,
    change ¬ _,
    rw [p_not_eq_not,not_eventually,not_henceforth,p_not_p_and,p_not_p_not_iff_self],
    apply inf_often_entails_inf_often _ _ H,
    apply p_or_p_imp_p_or_right',
    rw p_exists_entails_eq_p_forall_entails,
    intro ec, cases ec with ec Hec,
    subst e, apply R.evt_sim },
  { simp [H] },
end

lemma conc_fine : ∀ e',
         (◇◻•W e') τ →
         (◻◇•CF e'.val) τ :=
begin
  intros e' H,
  have H' := system_sem.leads_to_sem ((R.events e).resched e') _ M₁,
  apply inf_often_of_leads_to H',
  rw p_and_comm,
  apply coincidence H,
  apply abs_coarse_and_fine _ _ _ M₁ _ abs_coarse abs_fine,
end

end schedules

include M₁
include R

theorem soundness : system_sem.ex ma τ :=
begin
  apply nondet.program.ex.mk,
  { apply R.sim_init,
    apply M₁.init },
  { intro i,
    apply R.sim,
    apply M₁.safety },
  { intros e COARSE₀ FINE₀,
    apply assume_neg _, intro ACT,
    have COARSE₁ :  (◇◻(•AC ma e ⋀ -⟦program.step_of ma e⟧)) τ,
    { rw [p_not_eq_not,not_henceforth,not_eventually] at ACT,
      apply stable_and_of_stable_of_stable COARSE₀ ACT },
    clear COARSE₀ ACT,
    cases conc_coarse ma mc R τ M₁ _ COARSE₁ FINE₀ with e' C_COARSE',
    have C_COARSE : (◇◻•CC mc e'.val) τ,
    { apply eventually_entails_eventually _ _ C_COARSE',
      apply henceforth_entails_henceforth,
      intro, apply and.right },
    have WIT : (◇◻•W ma mc R e e') τ,
    { apply stable_entails_stable _ _ C_COARSE',
      intro, apply and.left },
    have C_FINE := conc_fine ma mc R τ M₁ e COARSE₁ FINE₀ e' WIT,
    apply inf_often_entails_inf_often _ _ (M₁.liveness _ C_COARSE C_FINE),
    have H := R.evt_sim e'.val,
    rw [subtype.property e'] at H,
    apply H, },
end

end soundness

end nondet


def s1 := "Hello, "
def s2 := "Nifty!"
def s3 := s1 ++ s2

theorem t1 : s1 ++ s2 = s3 := _

theorem t2 : 4^2 = 16 := _

theorem t3 : s1 ++ s2 = s3 ∧ 5^2 = 25 := _

theorem t4 :
    ∀ (P Q R : Prop), (P ∧ Q) ∧ (Q ∧ R) → (P ∧ R) :=
    λ (P Q R : Prop),
        and.intro _ _


import category_theory.limits.preserves.limits
import category_theory.adjunction.evaluation
import algebra.group.ulift

import for_mathlib.ab4
import for_mathlib.AddCommGroup.exact
import for_mathlib.AddCommGroup.pt
import for_mathlib.AddCommGroup.ab4

import condensed.extr.equivalence

.

universe u

open category_theory
open category_theory.limits

instance : has_colimits (ExtrSheafProd.{u} Ab.{u+1}) :=
has_colimits_of_has_colimits_creates_colimits
(Condensed_ExtrSheafProd_equiv _).inverse

instance : has_limits (ExtrSheafProd.{u} Ab.{u+1}) :=
has_limits_of_has_limits_creates_limits
(Condensed_ExtrSheafProd_equiv _).inverse

instance : has_colimits_of_size.{u} Ab.{u+1} :=
has_colimits_of_size_shrink.{u u (u+1) (u+1)} Ab.{u+1}

open_locale classical

instance {C : Type (u+1)} [category.{u} C] : AB4 (C ⥤ Ab.{u+1}) :=
begin
  constructor,
  intros α X Y f hf,
  let t := _, change mono t,
  rw category_theory.nat_trans.mono_iff_mono_app,
  intros c,
  let eX : (∐ λ (a : α), X a).obj c ≅ (∐ λ (a : α), (X a).obj c) :=
    (is_colimit_of_preserves ((evaluation _ _).obj c)
      (colimit.is_colimit _)).cocone_point_unique_up_to_iso (colimit.is_colimit _)
    ≪≫ has_colimit.iso_of_nat_iso (discrete.nat_iso (λ _, iso.refl _)),
   let eY : (∐ λ (a : α), Y a).obj c ≅ (∐ λ (a : α), (Y a).obj c) :=
    (is_colimit_of_preserves ((evaluation _ _).obj c)
      (colimit.is_colimit _)).cocone_point_unique_up_to_iso (colimit.is_colimit _)
    ≪≫ has_colimit.iso_of_nat_iso (discrete.nat_iso (λ _, iso.refl _)),
  let tt : (∐ λ (a : α), (X a).obj c) ⟶ (∐ λ (a : α), (Y a).obj c) :=
    sigma.desc (λ a, (f a).app c ≫ sigma.ι _ a),
  haveI : mono tt,
  { dsimp [tt],
    apply AB4.cond, intros a, specialize hf a,
    rw category_theory.nat_trans.mono_iff_mono_app at hf,
    apply hf },
  suffices : t.app c = eX.hom ≫ tt ≫ eY.inv,
  { rw this, apply_instance },
  dsimp [eX, tt, t, eY],
  apply ((is_colimit_of_preserves ((evaluation _ _).obj c) (colimit.is_colimit _))).hom_ext,
  intros a,
  dsimp [is_colimit.cocone_point_unique_up_to_iso],
  simp only [category.assoc, ← nat_trans.comp_app, colimit.ι_desc],
  slice_rhs 0 1
  { erw ((is_colimit_of_preserves ((evaluation _ _).obj c) (colimit.is_colimit _))).fac },
  slice_rhs 0 1
  { erw colimit.ι_desc },
  dsimp,
  simp only [category.id_comp, colimit.ι_desc, cofan.mk_ι_app, category.assoc,
    has_colimit.iso_of_nat_iso_ι_inv, discrete.nat_iso_inv_app, functor.map_cocone_ι_app,
    colimit.cocone_ι, evaluation_obj_map],
  dsimp, simp, apply_instance
end

noncomputable
instance : creates_limits (ExtrSheafProd_to_presheaf.{u} Ab.{u+1}) :=
begin
  change creates_limits ((ExtrSheaf_ExtrSheafProd_equiv _).inverse ⋙
    Sheaf_to_presheaf _ _),
  apply_with category_theory.comp_creates_limits { instances := ff },
  apply_instance,
  exact @Sheaf.category_theory.Sheaf_to_presheaf.category_theory.creates_limits.{(u+2) u (u+1)}
    ExtrDisc.{u} _ ExtrDisc.proetale_topology Ab.{u+1} _ _,
end

instance : AB4 (ExtrSheafProd.{u} Ab.{u+1}) :=
AB4_of_preserves_colimits_of_reflects_limits_of_AB4
  (ExtrSheafProd_to_presheaf _)

-- TODO: Prove a lemma about transporting AB4 across an equivalence.
instance : AB4 (Condensed.{u} Ab.{u+1}) :=
AB4_of_preserves_colimits_of_reflects_limits_of_AB4
    (Condensed_ExtrSheafProd_equiv.{u} Ab.{u+1}).functor


import condensed.is_proetale_sheaf
import condensed.adjunctions
import category_theory.limits.filtered_colimit_commutes_finite_limit
import for_mathlib.AddCommGroup.explicit_limits

open category_theory
open category_theory.limits

universe u
variables
  {J : Type (u+1)} [small_category J] [is_filtered J]
  {C : Type (u+2)}
  [category.{u+1} C]
  [concrete_category.{u+1} C]
  [has_limits C]
  [has_colimits_of_shape J C]
  [preserves_colimits_of_shape J (forget C)]
  [reflects_limits (forget C)]
  [preserves_limits (forget C)]
  (F : J ⥤ Condensed.{u} C)

open opposite

namespace is_sheaf_colimit_presheaf_aux

namespace empty

variables (G : J ⥤ Profinite.{u}ᵒᵖ ⥤ C)

noncomputable
def comparison_component (j : J) :
  (G.obj j).obj (op Profinite.empty) ⟶ ⊤_ _ := terminal.from _

variables [∀ j, is_iso (comparison_component G j)]

noncomputable
def first_iso : (colimit G).obj (op Profinite.empty) ≅
  colimit (limit (functor.empty _ ⋙ G.flip)) :=
let e₁ := is_colimit_of_preserves ((evaluation _ _).obj (op Profinite.empty))
  (colimit.is_colimit G),
    e₂ := e₁.cocone_point_unique_up_to_iso (colimit.is_colimit _),
    e₃ : G ⋙ (evaluation Profiniteᵒᵖ C).obj (op Profinite.empty) ≅
      limit (functor.empty Profiniteᵒᵖ ⋙ G.flip) :=
      nat_iso.of_components
      (λ j,
        let e₄ := is_limit_of_preserves ((evaluation _ _).obj j)
          (limit.is_limit (functor.empty _ ⋙ G.flip)),
            e₅ := (limit.is_limit _).cone_point_unique_up_to_iso e₄,
            e₆ : functor.empty C ≅
              (functor.empty Profiniteᵒᵖ ⋙ G.flip) ⋙ (evaluation J C).obj j :=
              nat_iso.of_components (λ i, i.elim) (λ i, i.elim) in
        as_iso (comparison_component G j) ≪≫
          has_limit.iso_of_nat_iso e₆ ≪≫ e₅)
      begin
        intros X Y f, dsimp [comparison_component],
        apply (is_limit_of_preserves ((evaluation J C).obj Y)
          (limit.is_limit (functor.empty Profiniteᵒᵖ ⋙ G.flip))).hom_ext,
        intros j, cases j,
      end in
e₂ ≪≫ has_colimit.iso_of_nat_iso e₃

noncomputable
def second_iso : colimit (limit (functor.empty _ ⋙ G.flip)) ≅
  limit (colimit (functor.empty _ ⋙ G.flip).flip) :=
  colimit_limit_iso _

noncomputable
def third_iso : limit (colimit (functor.empty _ ⋙ G.flip).flip) ≅ ⊤_ _ :=
has_limit.iso_of_nat_iso $ nat_iso.of_components (λ i, i.elim) (λ i, i.elim)

noncomputable
def comparison : (colimit G).obj (op Profinite.empty) ⟶ ⊤_ _ := terminal.from _

theorem is_iso_comparison : is_iso (comparison G) :=
begin
  suffices : comparison G = (first_iso G).hom ≫ (second_iso G).hom ≫ (third_iso G).hom,
  { rw this, apply_instance },
  simp,
end

end empty

namespace prod

variables (X Y : Profinite.{u}) (G : J ⥤ Profinite.{u}ᵒᵖ ⥤ C)

noncomputable
def comparison_component (j : J) :
  (G.obj j).obj (op $ Profinite.sum X Y) ⟶ prod ((G.obj j).obj (op X)) ((G.obj j).obj (op Y)) :=
prod.lift ((G.obj j).map (Profinite.sum.inl _ _).op) ((G.obj j).map (Profinite.sum.inr _ _).op)

variables [∀ j, is_iso (comparison_component X Y G j)]

noncomputable
def first_iso_aux_aux (j) :
  (G ⋙ (evaluation Profiniteᵒᵖ C).obj (op (X.sum Y))).obj j ≅
  (G.flip.obj (op X) ⨯ G.flip.obj (op Y)).obj j :=
let e₄ : pair ((G.obj j).obj (op X)) ((G.obj j).obj (op Y)) ≅
  pair (G.flip.obj (op X)) (G.flip.obj (op Y)) ⋙ (evaluation J C).obj j :=
  nat_iso.of_components
  (λ p, match p with
    | walking_pair.left := iso.refl _
    | walking_pair.right := iso.refl _
    end) begin
      rintros (_|_) (_|_) (_|_), refl, refl,
    end in
as_iso (comparison_component X Y G j) ≪≫
  has_limit.iso_of_nat_iso e₄ ≪≫
  (limit.is_limit _).cone_point_unique_up_to_iso
    (is_limit_of_preserves ((evaluation _ _).obj j) (limit.is_limit _))

noncomputable
def first_iso_aux : G ⋙ (evaluation Profiniteᵒᵖ C).obj (op (X.sum Y)) ≅
  G.flip.obj (op X) ⨯ G.flip.obj (op Y) :=
nat_iso.of_components (λ j, first_iso_aux_aux X Y G j)
begin
  intros i j f, dsimp [comparison_component, first_iso_aux_aux],
  apply
    (is_limit_of_preserves ((evaluation J C).obj j)
      (limit.is_limit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))))).hom_ext,
  rintros (_|_),
  { dsimp [is_limit.cone_point_unique_up_to_iso],
    have h1 :=
      (is_limit_of_preserves ((evaluation J C).obj j)
        (limit.is_limit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))))).fac
          (limit.cone _) walking_pair.left,
    have h2 :=
      (is_limit_of_preserves ((evaluation J C).obj i)
        (limit.is_limit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))))).fac
          (limit.cone _) walking_pair.left,
    dsimp at h1 h2, simp [h1, reassoc_of h2],
    dsimp [first_iso_aux_aux._match_1], simp },
  { dsimp [is_limit.cone_point_unique_up_to_iso],
    have h1 :=
      (is_limit_of_preserves ((evaluation J C).obj j)
        (limit.is_limit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))))).fac
          (limit.cone _) walking_pair.right,
    have h2 :=
      (is_limit_of_preserves ((evaluation J C).obj i)
        (limit.is_limit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))))).fac
          (limit.cone _) walking_pair.right,
    dsimp at h1 h2, simp [h1, reassoc_of h2],
    dsimp [first_iso_aux_aux._match_1], simp },
end

noncomputable
def first_iso : (colimit G).obj (op $ Profinite.sum X Y) ≅
  colimit (prod (G.flip.obj (op X)) (G.flip.obj (op Y))) :=
let e₁ := is_colimit_of_preserves ((evaluation _ _).obj (op $ Profinite.sum X Y))
  (colimit.is_colimit G),
    e₂ := e₁.cocone_point_unique_up_to_iso (colimit.is_colimit _) in
e₂ ≪≫ has_colimit.iso_of_nat_iso (first_iso_aux X Y G)

noncomputable
def second_iso : colimit (prod (G.flip.obj (op X)) (G.flip.obj (op Y))) ≅
  limit (colimit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))).flip) :=
colimit_limit_iso _

noncomputable
def third_iso_aux_left :
  (colimit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))).flip).obj walking_pair.left ≅
  (colimit G).obj (op X) :=
let e₁ :=
  is_colimit_of_preserves ((evaluation _ _).obj walking_pair.left)
    (colimit.is_colimit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))).flip),
    e₂ :=
  is_colimit_of_preserves ((evaluation _ _).obj (op X))
    (colimit.is_colimit G) in
e₁.cocone_point_unique_up_to_iso e₂

noncomputable
def third_iso_aux_right :
  (colimit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))).flip).obj walking_pair.right ≅
  (colimit G).obj (op Y) :=
let e₁ :=
  is_colimit_of_preserves ((evaluation _ _).obj walking_pair.right)
    (colimit.is_colimit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))).flip),
    e₂ :=
  is_colimit_of_preserves ((evaluation _ _).obj (op Y))
    (colimit.is_colimit G) in
e₁.cocone_point_unique_up_to_iso e₂

/--/
noncomputable
def third_iso_aux : cone (pair (op X) (op Y) ⋙ colimit G) :=
{ X := limit (colimit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))).flip),
  π :=
  { app := λ p,
    match p with
    | walking_pair.left := limit.π _ walking_pair.left ≫ (third_iso_aux_left X Y G).hom
    | walking_pair.right := limit.π _ walking_pair.right ≫ (third_iso_aux_right X Y G).hom
    end,
    naturality' := admit } }

noncomputable
def third_iso_aux' : cone (colimit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))).flip) :=
{ X := limit (pair (op X) (op Y) ⋙ colimit G),
  π :=
  { app := λ p,
    match p with
    | walking_pair.left := limit.π _ walking_pair.left ≫ (third_iso_aux_left X Y G).inv
    | walking_pair.right := limit.π _ walking_pair.right ≫ (third_iso_aux_right X Y G).inv
    end,
    naturality' := admit } }
-/

noncomputable
def third_iso_aux : cone (colimit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))).flip) :=
{ X := prod ((colimit G).obj (op X)) ((colimit G).obj (op Y)),
  π :=
  { app := λ p,
    match p with
    | walking_pair.left := limits.prod.fst ≫ (third_iso_aux_left _ _ _).inv
    | walking_pair.right := limits.prod.snd ≫ (third_iso_aux_right _ _ _).inv
    end,
    naturality' := begin
      rintros (_|_) (_|_) (_|_),
      { dsimp [third_iso_aux._match_1], simp },
      { dsimp [third_iso_aux._match_1], simp },
    end } }

noncomputable
def third_iso :
  limit (colimit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))).flip)
    ≅ prod ((colimit G).obj (op X)) ((colimit G).obj (op Y)) :=
{ hom := prod.lift
    (limit.π _ walking_pair.left ≫ (third_iso_aux_left _ _ _).hom)
    (limit.π _ walking_pair.right ≫ (third_iso_aux_right _ _ _).hom),
  inv := limit.lift _ (third_iso_aux _ _ _),
  hom_inv_id' := begin
    ext (_|_),
    { simp only [category.assoc, limit.lift_π, category.id_comp],
      dsimp [third_iso_aux, third_iso_aux._match_1], simp },
    { simp only [category.assoc, limit.lift_π, category.id_comp],
      dsimp [third_iso_aux, third_iso_aux._match_1], simp },
  end,
  inv_hom_id' := begin
    ext,
    { simp only [prod.comp_lift, limit.lift_π_assoc, prod.lift_fst, category.id_comp],
      dsimp [third_iso_aux], simp, },
    { simp only [prod.comp_lift, limit.lift_π_assoc, prod.lift_snd, category.id_comp],
      dsimp [third_iso_aux], simp, },
  end }

/-
noncomputable
def fourth_iso_aux : cone (pair (op X) (op Y) ⋙ colimit G) :=
{ X := prod ((colimit G).obj (op X)) ((colimit G).obj (op Y)),
  π :=
  { app := λ p,
    match p with
    | walking_pair.left := limits.prod.fst
    | walking_pair.right := limits.prod.snd
    end,
    naturality' := admit } }

noncomputable
def fourth_iso : limit (pair (op X) (op Y) ⋙ colimit G) ≅
  prod ((colimit G).obj (op X)) ((colimit G).obj (op Y)) :=
{ hom := prod.lift (limit.π _ walking_pair.left) (limit.π _ walking_pair.right),
  inv := limit.lift _ (fourth_iso_aux _ _ _),
  hom_inv_id' := admit,
  inv_hom_id' := admit }
-/

noncomputable
def comparison : (colimit G).obj (op $ Profinite.sum X Y) ⟶
  prod ((colimit G).obj (op X)) ((colimit G).obj (op Y)) :=
prod.lift
  ((colimit G).map (Profinite.sum.inl _ _).op)
  ((colimit G).map (Profinite.sum.inr _ _).op)

lemma is_iso_comparison_aux_fst (j) :
  (colimit.ι G j).app (op (X.sum Y)) ≫ comparison X Y G ≫ limits.prod.fst =
    (colimit.ι G j).app (op (X.sum Y)) ≫
      (first_iso X Y G).hom ≫ (second_iso X Y G).hom ≫ (third_iso X Y G).hom ≫
      limits.prod.fst :=
begin
  dsimp [comparison, first_iso, second_iso, third_iso, colimit_limit_iso],
  simp only [prod.comp_lift, prod.lift_fst, category.assoc,
    has_limit.iso_of_nat_iso_hom_π_assoc, iso.symm_hom,
    colimit_flip_iso_comp_colim_inv_app,
    limit.cone_point_unique_up_to_iso_hom_comp_assoc, functor.map_cone_π_app,
    binary_fan.π_app_left],
  dsimp [has_colimit.iso_of_nat_iso, colim, colim_map, is_colimit.map,
    is_colimit.cocone_point_unique_up_to_iso,
    colimit_obj_iso_colimit_comp_evaluation,
    third_iso_aux, third_iso_aux_left, preserves_colimit_iso],
  have := (is_colimit_of_preserves
    ((evaluation Profiniteᵒᵖ C).obj (op (X.sum Y)))
    (colimit.is_colimit G)).fac _ j,
  dsimp at this, slice_rhs 1 2 { rw this }, clear this,
  simp only [colimit.cocone_ι, colimit.ι_desc, cocones.precompose_obj_ι,
    nat_trans.comp_app, category.assoc, flip_comp_evaluation_inv_app,
    functor.map_cocone_ι_app, evaluation_obj_map],
  dsimp [first_iso_aux, first_iso_aux_aux, comparison_component,
    is_limit.cone_point_unique_up_to_iso],
  simp only [has_limit.lift_iso_of_nat_iso_hom_assoc,
    category.id_comp, category.assoc],
  have := (is_limit_of_preserves ((evaluation J C).obj j)
    (limit.is_limit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))))).fac _
      walking_pair.left, dsimp at this,
  slice_rhs 2 3 { rw this }, clear this,
  simp only [limit.cone_π, category.assoc, limit.lift_π_assoc,
    cones.postcompose_obj_π, nat_trans.comp_app,
    binary_fan.mk_π_app_left, nat_iso.of_components.hom_app],
  have := (is_colimit_of_preserves ((evaluation _ C).obj walking_pair.left)
    (colimit.is_colimit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))).flip)).fac _ j,
  dsimp at this, slice_rhs 3 4 { rw this }, clear this,
  dsimp [first_iso_aux_aux._match_1], simp only [category.id_comp, nat_trans.naturality],
end

lemma is_iso_comparison_aux_snd (j) : (colimit.ι G j).app (op (X.sum Y)) ≫ comparison X Y G ≫
  limits.prod.snd = (colimit.ι G j).app (op (X.sum Y)) ≫
    (first_iso X Y G).hom ≫ (second_iso X Y G).hom ≫ (third_iso X Y G).hom ≫
    limits.prod.snd :=
begin
  dsimp [comparison, first_iso, second_iso, third_iso, colimit_limit_iso],
  simp only [prod.comp_lift, prod.lift_snd, category.assoc,
    has_limit.iso_of_nat_iso_hom_π_assoc, iso.symm_hom,
    colimit_flip_iso_comp_colim_inv_app,
    limit.cone_point_unique_up_to_iso_hom_comp_assoc, functor.map_cone_π_app,
    binary_fan.π_app_right],
  dsimp [has_colimit.iso_of_nat_iso, colim, colim_map, is_colimit.map,
    is_colimit.cocone_point_unique_up_to_iso,
    colimit_obj_iso_colimit_comp_evaluation,
    third_iso_aux, third_iso_aux_right, preserves_colimit_iso],
  have := (is_colimit_of_preserves
    ((evaluation Profiniteᵒᵖ C).obj (op (X.sum Y)))
    (colimit.is_colimit G)).fac _ j,
  dsimp at this, slice_rhs 1 2 { rw this }, clear this,
  simp only [colimit.cocone_ι, colimit.ι_desc, cocones.precompose_obj_ι,
    nat_trans.comp_app, category.assoc, flip_comp_evaluation_inv_app,
    functor.map_cocone_ι_app, evaluation_obj_map],
  dsimp [first_iso_aux, first_iso_aux_aux, comparison_component,
    is_limit.cone_point_unique_up_to_iso],
  simp only [has_limit.lift_iso_of_nat_iso_hom_assoc,
    category.id_comp, category.assoc],
  have := (is_limit_of_preserves ((evaluation J C).obj j)
    (limit.is_limit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))))).fac _
      walking_pair.right, dsimp at this,
  slice_rhs 2 3 { rw this }, clear this,
  simp only [limit.cone_π, category.assoc, limit.lift_π_assoc,
    cones.postcompose_obj_π, nat_trans.comp_app,
    binary_fan.mk_π_app_left, nat_iso.of_components.hom_app],
  have := (is_colimit_of_preserves ((evaluation _ C).obj walking_pair.right)
    (colimit.is_colimit (pair (G.flip.obj (op X)) (G.flip.obj (op Y))).flip)).fac _ j,
  dsimp at this, slice_rhs 3 4 { rw this }, clear this,
  dsimp [first_iso_aux_aux._match_1], simp only [category.id_comp, nat_trans.naturality],
end

lemma is_iso_comparison : is_iso (comparison X Y G) :=
begin
  suffices : (comparison X Y G) =
    (first_iso X Y G).hom ≫ (second_iso X Y G).hom ≫ (third_iso X Y G).hom,
  { rw this, apply_instance },
  ext,
  { simp only [category.assoc, is_iso_comparison_aux_fst] },
  { simp only [category.assoc, is_iso_comparison_aux_snd] }
end

end prod

namespace eq

variables {X Y : Profinite.{u}} (f : X ⟶ Y) (G : J ⥤ Profinite.{u}ᵒᵖ ⥤ C)

noncomputable
def comparison_component (j : J) :
  (G.obj j).obj (op $ Y) ⟶
  equalizer
    ((G.obj j).map (Profinite.pullback.fst f f).op)
    ((G.obj j).map (Profinite.pullback.snd f f).op) :=
equalizer.lift ((G.obj j).map f.op)
begin
  simp_rw [← (G.obj j).map_comp, ← op_comp, Profinite.pullback.condition],
end

variables [∀ j, is_iso (comparison_component f G j)]

def first_iso_aux_aux (j) : parallel_pair ((G.obj j).map (Profinite.pullback.fst f f).op)
  ((G.obj j).map (Profinite.pullback.snd f f).op) ≅
    parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
  (G.flip.map (Profinite.pullback.snd f f).op) ⋙
    (evaluation J C).obj j :=
nat_iso.of_components (λ p,
  match p with
  | walking_parallel_pair.zero := iso.refl _
  | walking_parallel_pair.one := iso.refl _
  end)
begin
  rintro (_|_) (_|_) (_|_),
  refl,
  dsimp [first_iso_aux_aux._match_1], simp,
  dsimp [first_iso_aux_aux._match_1], simp,
  refl,
end

noncomputable
def first_iso_aux : G ⋙ (evaluation Profiniteᵒᵖ C).obj (op Y) ≅
  equalizer (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op) :=
nat_iso.of_components (λ j,
  as_iso (comparison_component f G j)
    ≪≫
    has_limit.iso_of_nat_iso (first_iso_aux_aux _ _ _)
    ≪≫ (limit.is_limit _).cone_point_unique_up_to_iso
    (is_limit_of_preserves ((evaluation _ _).obj j) (limit.is_limit _)))
begin
  intros i j g, dsimp [comparison_component, first_iso_aux_aux],
  apply (is_limit_of_preserves ((evaluation J C).obj j)
    (limit.is_limit
    (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op)))).hom_ext,
  rintros (_|_),
  { dsimp [is_limit.cone_point_unique_up_to_iso],
    have := (is_limit_of_preserves ((evaluation J C).obj j)
      (limit.is_limit
      (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
      (G.flip.map (Profinite.pullback.snd f f).op)))).fac (limit.cone _)
      walking_parallel_pair.zero,
    dsimp at this, simp only [category.assoc, this], clear this,
    have := (is_limit_of_preserves ((evaluation J C).obj i)
      (limit.is_limit
      (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
      (G.flip.map (Profinite.pullback.snd f f).op)))).fac (limit.cone _)
      walking_parallel_pair.zero,
    dsimp at this, simp only [nat_trans.naturality, category.assoc, reassoc_of this], clear this,
    simp only [has_limit.iso_of_nat_iso_hom_π, nat_iso.of_components.hom_app,
      equalizer.lift_ι_assoc, functor.flip_obj_map, has_limit.iso_of_nat_iso_hom_π_assoc],
    dsimp [first_iso_aux_aux._match_1],
    simp only [category.comp_id, category.id_comp, nat_trans.naturality] },
  { dsimp [is_limit.cone_point_unique_up_to_iso],
    have := (is_limit_of_preserves ((evaluation J C).obj j)
      (limit.is_limit
      (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
      (G.flip.map (Profinite.pullback.snd f f).op)))).fac (limit.cone _)
      walking_parallel_pair.one,
    dsimp at this, simp only [category.assoc, this], clear this,
    have := (is_limit_of_preserves ((evaluation J C).obj i)
      (limit.is_limit
      (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
      (G.flip.map (Profinite.pullback.snd f f).op)))).fac (limit.cone _)
      walking_parallel_pair.one,
    dsimp at this, simp only [nat_trans.naturality, category.assoc, reassoc_of this], clear this,
    simp only [has_limit.iso_of_nat_iso_hom_π, nat_iso.of_components.hom_app,
      limit.lift_π_assoc, fork.of_ι_π_app, category.assoc, functor.flip_obj_map,
      has_limit.iso_of_nat_iso_hom_π_assoc],
    dsimp [first_iso_aux_aux._match_1],
    simp only [category.comp_id, category.id_comp,
      nat_trans.naturality, nat_trans.naturality_assoc] }
end

noncomputable
def first_iso : (colimit G).obj (op $ Y) ≅
  colimit (equalizer
    (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op)) :=
let e₁ := is_colimit_of_preserves
  ((evaluation _ _).obj (op $ Y)) (colimit.is_colimit G),
    e₂ := e₁.cocone_point_unique_up_to_iso (colimit.is_colimit _) in
e₂ ≪≫ has_colimit.iso_of_nat_iso (first_iso_aux f G)

noncomputable
def second_iso : colimit (equalizer
    (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op)) ≅
    limit (colimit (parallel_pair
      (G.flip.map (Profinite.pullback.fst f f).op)
      (G.flip.map (Profinite.pullback.snd f f).op)).flip) :=
colimit_limit_iso _

noncomputable
def third_iso_aux :
  (colimit (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op)).flip).obj
    walking_parallel_pair.zero ≅ (colimit G).obj (op X) :=
let e₁ :=
  is_colimit_of_preserves ((evaluation _ _).obj walking_parallel_pair.zero)
    (colimit.is_colimit (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op)).flip),
    e₂ := is_colimit_of_preserves ((evaluation _ _).obj (op X)) (colimit.is_colimit G) in
e₁.cocone_point_unique_up_to_iso e₂

noncomputable
def third_iso_aux'' :
  (colimit (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op)).flip).obj
    walking_parallel_pair.one ≅ (colimit G).obj (op $ Profinite.pullback f f) :=
let e₁ :=
  is_colimit_of_preserves ((evaluation _ _).obj walking_parallel_pair.one)
    (colimit.is_colimit (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op)).flip),
    e₂ := is_colimit_of_preserves ((evaluation _ _).obj (op $ Profinite.pullback f f))
    (colimit.is_colimit G) in
e₁.cocone_point_unique_up_to_iso e₂

lemma third_iso_aux_fst :
    (third_iso_aux f G).inv ≫ (colimit
    (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op)).flip).map
    walking_parallel_pair_hom.left = (colimit G).map (Profinite.pullback.fst f f).op ≫
    (third_iso_aux'' f G).inv :=
begin
  dsimp [third_iso_aux, third_iso_aux''],
  apply (is_colimit_of_preserves ((evaluation Profiniteᵒᵖ C).obj
  (op X)) (colimit.is_colimit G)).hom_ext, intros j,
  dsimp [is_colimit.cocone_point_unique_up_to_iso],
  have h1 := (is_colimit_of_preserves ((evaluation Profiniteᵒᵖ C).obj (op X))
    (colimit.is_colimit G)).fac _ j,
  have h2 := (is_colimit_of_preserves ((evaluation Profiniteᵒᵖ C).obj
    (op $ Profinite.pullback f f)) (colimit.is_colimit G)).fac _ j,
  dsimp at h1 h2,
  slice_lhs 1 2 { rw h1 }, clear h1,
  rw ← nat_trans.naturality_assoc,
  slice_rhs 2 3 { rw h2 }, clear h2,
  dsimp, rw ← nat_trans.naturality, refl
end

lemma third_iso_aux_snd :
    (third_iso_aux f G).inv ≫ (colimit
    (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op)).flip).map
    walking_parallel_pair_hom.right = (colimit G).map (Profinite.pullback.snd f f).op ≫
    (third_iso_aux'' f G).inv :=
begin
  dsimp [third_iso_aux, third_iso_aux''],
  apply (is_colimit_of_preserves ((evaluation Profiniteᵒᵖ C).obj
  (op X)) (colimit.is_colimit G)).hom_ext, intros j,
  dsimp [is_colimit.cocone_point_unique_up_to_iso],
  have h1 := (is_colimit_of_preserves ((evaluation Profiniteᵒᵖ C).obj (op X))
    (colimit.is_colimit G)).fac _ j,
  have h2 := (is_colimit_of_preserves ((evaluation Profiniteᵒᵖ C).obj
    (op $ Profinite.pullback f f)) (colimit.is_colimit G)).fac _ j,
  dsimp at h1 h2,
  slice_lhs 1 2 { rw h1 }, clear h1,
  rw ← nat_trans.naturality_assoc,
  slice_rhs 2 3 { rw h2 }, clear h2,
  dsimp, rw ← nat_trans.naturality, refl
end

noncomputable
def third_iso_aux' : cone (colimit (parallel_pair
      (G.flip.map (Profinite.pullback.fst f f).op)
      (G.flip.map (Profinite.pullback.snd f f).op)).flip) :=
{ X := equalizer
      ((colimit G).map (Profinite.pullback.fst f f).op)
      ((colimit G).map (Profinite.pullback.snd f f).op),
  π :=
  { app := λ p,
    match p with
    | walking_parallel_pair.zero := equalizer.ι _ _ ≫ (third_iso_aux _ _).inv
    | walking_parallel_pair.one := equalizer.ι _ _ ≫ (third_iso_aux f G).inv ≫
        category_theory.functor.map _ walking_parallel_pair_hom.left
    end,
  naturality' := begin
    rintro (_|_) (_|_) ⟨⟩,
    { dsimp, simp only [category.id_comp, category_theory.functor.map_id, category.comp_id], },
    { dsimp [third_iso_aux'._match_1], simp only [category.id_comp, category.assoc], },
    { dsimp [third_iso_aux'._match_1], simp only [category.id_comp, category.assoc],
      rw [third_iso_aux_fst, third_iso_aux_snd],
      simp only [category.assoc, equalizer.condition_assoc] },
    { dsimp, simp only [category.id_comp, category_theory.functor.map_id, category.comp_id], },
  end } }

noncomputable
def third_iso : limit (colimit (parallel_pair
      (G.flip.map (Profinite.pullback.fst f f).op)
      (G.flip.map (Profinite.pullback.snd f f).op)).flip) ≅
    equalizer
      ((colimit G).map (Profinite.pullback.fst f f).op)
      ((colimit G).map (Profinite.pullback.snd f f).op) :=
{ hom := equalizer.lift
    (limit.π _ walking_parallel_pair.zero ≫ (third_iso_aux f G).hom) begin
      have := third_iso_aux_fst f G, rw iso.eq_comp_inv at this, rw ← this, clear this,
      have := third_iso_aux_snd f G, rw iso.eq_comp_inv at this, rw ← this, clear this,
      simp only [category.assoc, iso.hom_inv_id_assoc],
      simp only [← category.assoc], congr' 1,
      let F := _, change limit.π F _ ≫ F.map _ = limit.π F _ ≫ F.map _,
      simp [limit.w F walking_parallel_pair_hom.left],
    end,
  inv := limit.lift _ (third_iso_aux' _ _),
  hom_inv_id' := begin
    ext (_|_),
    { simp only [category.assoc, limit.lift_π, category.id_comp],
      dsimp [third_iso_aux', third_iso_aux'._match_1],
      simp only [equalizer.lift_ι_assoc, category.assoc, iso.hom_inv_id, category.comp_id] },
    { simp only [category.assoc, limit.lift_π, category.id_comp],
      dsimp [third_iso_aux', third_iso_aux'._match_1],
      simp only [equalizer.lift_ι_assoc, category.assoc, iso.hom_inv_id_assoc,
        category.comp_id, category.id_comp, limit.w] }
  end,
  inv_hom_id' := begin
    ext,
    simp only [category.assoc, equalizer.lift_ι, limit.lift_π_assoc, category.id_comp],
    dsimp [third_iso_aux, third_iso_aux'],
    simp only [category.assoc, iso.inv_hom_id, category.comp_id],
  end }

noncomputable
def comparison :
  (colimit G).obj (op $ Y) ⟶
  equalizer
    ((colimit G).map (Profinite.pullback.fst f f).op)
    ((colimit G).map (Profinite.pullback.snd f f).op) :=
equalizer.lift ((colimit G).map f.op)
begin
  simp only [← functor.map_comp, ← op_comp, Profinite.pullback.condition],
end

theorem is_iso_comparison : is_iso (comparison f G) :=
begin
  suffices : comparison f G =
    (first_iso f G).hom ≫ (second_iso f G).hom ≫ (third_iso f G).hom,
  { rw this, apply_instance },
  ext,
  dsimp [comparison, first_iso, second_iso, third_iso, colimit_limit_iso],
  simp only [category.assoc, equalizer.lift_ι, has_limit.iso_of_nat_iso_hom_π_assoc,
    iso.symm_hom, colimit_flip_iso_comp_colim_inv_app,
    limit.cone_point_unique_up_to_iso_hom_comp_assoc, functor.map_cone_π_app,
    equalizer.fork_π_app_zero],
  dsimp [has_colimit.iso_of_nat_iso, is_colimit.cocone_point_unique_up_to_iso,
    colim, colim_map, is_colimit.map, colimit_obj_iso_colimit_comp_evaluation,
    preserves_colimit_iso, third_iso_aux],
  have := (is_colimit_of_preserves ((evaluation Profiniteᵒᵖ C).obj (op Y))
    (colimit.is_colimit G)).fac _ j, dsimp at this,
  slice_rhs 1 2 { rw this }, clear this,
  simp only [colimit.cocone_ι, colimit.ι_desc, cocones.precompose_obj_ι, nat_trans.comp_app,
    category.assoc, flip_comp_evaluation_inv_app, functor.map_cocone_ι_app, evaluation_obj_map],
  dsimp [first_iso_aux, comparison_component],
  simp only [has_limit.lift_iso_of_nat_iso_hom_assoc, category.id_comp, category.assoc],
  dsimp [is_limit.cone_point_unique_up_to_iso],
  have := (is_colimit_of_preserves ((evaluation walking_parallel_pair C).obj
    walking_parallel_pair.zero) (colimit.is_colimit
    (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op)).flip)).fac _ j,
  dsimp at this, slice_rhs 4 5 { rw this }, clear this,
  have := (is_limit_of_preserves ((evaluation J C).obj j)
    (limit.is_limit (parallel_pair (G.flip.map (Profinite.pullback.fst f f).op)
    (G.flip.map (Profinite.pullback.snd f f).op)))).fac _ walking_parallel_pair.zero,
  dsimp at this ⊢, slice_rhs 2 3 { erw this }, clear this,
  dsimp,
  simp only [limit.lift_π_assoc, cones.postcompose_obj_π, nat_trans.comp_app,
    fork.of_ι_π_app, category.assoc],
  dsimp [first_iso_aux_aux],
  simp only [category.id_comp, nat_trans.naturality],
end

end eq

end is_sheaf_colimit_presheaf_aux
open is_sheaf_colimit_presheaf_aux

/-
variables {K : Type (u+1)} [small_category K] [fin_category K]
  (E : K ⥤ Profinite.{u}ᵒᵖ) [has_limit E] (G : J ⥤ Profinite.{u}ᵒᵖ ⥤ C)
  [∀ j, preserves_limits_of_shape K (G.obj j)]

noncomputable
def comparison_map_component (j : J) : (G.obj j).obj (limit E) ⟶ limit (E ⋙ G.obj j) :=
limit.lift (E ⋙ G.obj j) $ (G.obj j).map_cone (limit.cone E)

noncomputable
def comparison_map : (colimit G).obj (limit E) ⟶ limit (E ⋙ colimit G) :=
limit.lift (E ⋙ colimit G) $ (colimit G).map_cone (limit.cone E)

noncomputable
def first_iso : (colimit G).obj (limit E) ≅ colimit (limit (E ⋙ G.flip)) :=
let e := is_colimit_of_preserves ((evaluation _ _).obj (limit E))
  (colimit.is_colimit G),
  ee := e.cocone_point_unique_up_to_iso (colimit.is_colimit _),
  tt : G ⋙ (evaluation Profiniteᵒᵖ C).obj (limit E) ≅ limit (E ⋙ G.flip) :=
    nat_iso.of_components (λ j, begin
      dsimp,
      refine (is_limit_of_preserves (G.obj j) (limit.is_limit E)).cone_point_unique_up_to_iso
        (limit.is_limit _) ≪≫ _,
      refine _ ≪≫ (limit.is_limit _).cone_point_unique_up_to_iso
        ((is_limit_of_preserves ((evaluation _ _).obj j) (limit.is_limit _))),
      dsimp,
      refine has_limit.iso_of_nat_iso _,
      refine nat_iso.of_components _ _,
      intros k, exact iso.refl _,
      intros k₁ k₂ f, dsimp, simp,
    end) admit in
ee ≪≫ has_colimit.iso_of_nat_iso tt

noncomputable
def second_iso : colimit (limit (E ⋙ G.flip)) ≅ limit (colimit (E ⋙ G.flip).flip) :=
  colimit_limit_iso _

noncomputable
def third_iso : limit (colimit (E ⋙ G.flip).flip) ≅ limit (E ⋙ colimit G) :=
has_limit.iso_of_nat_iso $
nat_iso.of_components (λ k,
  let ee := (is_colimit_of_preserves ((evaluation _ _).obj k)
    (colimit.is_colimit (E ⋙ G.flip).flip)).cocone_point_unique_up_to_iso
    (colimit.is_colimit _) in
  ee ≪≫
  begin
    dsimp,
    refine _ ≪≫
      (colimit.is_colimit _).cocone_point_unique_up_to_iso
      ((is_colimit_of_preserves ((evaluation _ _).obj (E.obj k)) (colimit.is_colimit _))),
    dsimp,
    refine has_colimit.iso_of_nat_iso _,
    refine nat_iso.of_components _ _,
    intros j, exact iso.refl _,
    intros i j f, dsimp, simp,
  end) admit

lemma is_iso : is_iso (comparison_map E G) :=
begin
  suffices : comparison_map E G =
    (first_iso E G).hom ≫ (second_iso E G).hom ≫ (third_iso E G).hom,
  { rw this, apply_instance },
  admit,
end

-- Use the comparison map above
variable (K)
def key : preserves_limits_of_shape K (colimit G) := admit

end is_sheaf_colimit_presheaf_aux
open is_sheaf_colimit_presheaf_aux

theorem empty_condition_iff_preserves (G : Profiniteᵒᵖ ⥤ C) :
  G.empty_condition' ↔
  nonempty (preserves_limits_of_shape (discrete pempty.{u+1}) G) := admit

theorem product_condition_iff_preserves (G : Profiniteᵒᵖ ⥤ C) :
  G.product_condition' ↔
  nonempty (preserves_limits_of_shape (discrete walking_pair.{u+1}) G) := admit

theorem equalizer_condition_iff_preserves (G : Profiniteᵒᵖ ⥤ C) :
  G.equalizer_condition' ↔
  nonempty (preserves_limits_of_shape (walking_parallel_pair.{u+1}) G) := admit
-/

lemma is_sheaf_colimit_presheaf :
  presheaf.is_sheaf proetale_topology (colimit (F ⋙ Sheaf_to_presheaf _ _)) :=
begin
  --rw is_sheaf_iff_is_sheaf_of_type,
  let G := (colimit (F ⋙ Sheaf_to_presheaf _ _)),
  let Gs := F ⋙ Sheaf_to_presheaf _ _,
  have hGs : ∀ j, presheaf.is_sheaf proetale_topology (Gs.obj j),
  { intros j, exact (F.obj j).2 },
  have hGsempty : ∀ j, (Gs.obj j).empty_condition',
  { intros j, specialize hGs j,
    rw (Gs.obj j).is_proetale_sheaf_tfae.out 0 3 at hGs,
    exact hGs.1 },
  have hGsprod : ∀ j, (Gs.obj j).product_condition',
  { intros j, specialize hGs j,
    rw (Gs.obj j).is_proetale_sheaf_tfae.out 0 3 at hGs,
    exact hGs.2.1 },
  have hGseq : ∀ j, (Gs.obj j).equalizer_condition',
  { intros j, specialize hGs j,
    rw (Gs.obj j).is_proetale_sheaf_tfae.out 0 3 at hGs,
    exact hGs.2.2 },
  rw G.is_proetale_sheaf_tfae.out 0 3,
  refine ⟨_,_,_⟩,
  { apply_with empty.is_iso_comparison { instances := ff },
    exact hGsempty,
    all_goals { apply_instance } },
  { intros X Y,
    apply_with prod.is_iso_comparison { instances := ff },
    intros j, apply hGsprod,
    all_goals { apply_instance } },
  { intros X Y f hf,
    apply_with eq.is_iso_comparison { instances := ff },
    intros j, apply hGseq, assumption' }
end

@[simps]
noncomputable
def filtered_cocone : cocone F :=
{ X := ⟨colimit (F ⋙ Sheaf_to_presheaf _ _), is_sheaf_colimit_presheaf _⟩,
  ι :=
  { app := λ j, Sheaf.hom.mk $ colimit.ι (F ⋙ Sheaf_to_presheaf _ _) j,
    naturality' := begin
      intros i j f,
      ext1, dsimp,
      simpa using colimit.w (F ⋙ Sheaf_to_presheaf _ _) f,
    end } }

noncomputable
def filtered_cocone_is_colimit : is_colimit (filtered_cocone F) :=
{ desc := λ S, Sheaf.hom.mk $ colimit.desc (F ⋙ Sheaf_to_presheaf _ _)
    ((Sheaf_to_presheaf _ _).map_cocone S),
  fac' := begin
    intros S j,
    ext1, dsimp,
    simp,
  end,
  uniq' := begin
    intros S m hm,
    ext1, dsimp,
    apply colimit.hom_ext,
    intros j, specialize hm j, apply_fun (λ e, e.val) at hm,
    dsimp at hm, simpa using hm,
  end } .

section

local attribute [-simp] forget_map_eq_coe

noncomputable
def preserves_limits_aux_1 (G : J ⥤ Condensed.{u} Ab.{u+1}) :
  colimit (G ⋙ Sheaf_to_presheaf proetale_topology Ab) ⋙ forget Ab ≅
  colimit (G ⋙ Sheaf_to_presheaf _ _ ⋙ (whiskering_right _ _ _).obj (forget Ab)) :=
nat_iso.of_components
begin
  intros X,
  let E := (G ⋙ Sheaf_to_presheaf _ _ ⋙ (whiskering_right _ _ _).obj (forget Ab)),
  let e₀ := colimit.is_colimit E,
  let e₁ := is_colimit_of_preserves ((evaluation _ _).obj X) e₀,
  refine _ ≪≫ (colimit.is_colimit _).cocone_point_unique_up_to_iso e₁,
  change (forget Ab).obj _ ≅ colimit _,
  let e₂ := colimit.is_colimit (G ⋙ Sheaf_to_presheaf proetale_topology Ab),
  let e₃ := is_colimit_of_preserves ((evaluation _ _).obj X) e₂,
  let e₄ := e₃.cocone_point_unique_up_to_iso (colimit.is_colimit _),
  refine (forget Ab).map_iso e₄ ≪≫ _,
  change (forget Ab).obj (colimit _) ≅ _,
  let e₅ := is_colimit_of_preserves (forget Ab)
    (colimit.is_colimit ((G ⋙ Sheaf_to_presheaf proetale_topology Ab)
    ⋙ (evaluation Profiniteᵒᵖ Ab).obj X)),
  exact e₅.cocone_point_unique_up_to_iso (colimit.is_colimit _),
end
begin
  intros X Y f, dsimp, simp only [category.assoc],
  dsimp [is_colimit.cocone_point_unique_up_to_iso],
  let E₀ := is_colimit_of_preserves ((evaluation Profiniteᵒᵖ Ab).obj X)
    (colimit.is_colimit (G ⋙ Sheaf_to_presheaf proetale_topology Ab)),
  let E := is_colimit_of_preserves (forget Ab) E₀,
  apply E.hom_ext, intros j, dsimp,

  -- Let's work on the LHS

  slice_lhs 1 3
  { simp only [← (forget Ab).map_comp],
    rw ← ((colimit.ι (G ⋙ Sheaf_to_presheaf proetale_topology Ab) j)).naturality_assoc, },
  have := (is_colimit_of_preserves ((evaluation Profiniteᵒᵖ Ab).obj Y)
    (colimit.is_colimit (G ⋙ Sheaf_to_presheaf proetale_topology Ab))).fac _ j,
  dsimp at this, rw this, clear this,
  dsimp,
  have := (is_colimit_of_preserves (forget Ab)
    (colimit.is_colimit ((G ⋙ Sheaf_to_presheaf proetale_topology Ab) ⋙
    (evaluation Profiniteᵒᵖ Ab).obj Y))).fac _ j,
  simp only [(forget Ab).map_comp, category.assoc],
  dsimp at this, slice_lhs 2 3 { rw this }, clear this,
  erw colimit.ι_desc,

  -- Now for the RHS

  slice_rhs 1 2 { rw ← (forget Ab).map_comp },
  have := (is_colimit_of_preserves ((evaluation Profiniteᵒᵖ Ab).obj X)
    (colimit.is_colimit (G ⋙ Sheaf_to_presheaf proetale_topology Ab))).fac _ j,
  dsimp at this, rw this, clear this,
  have := (is_colimit_of_preserves (forget Ab)
    (colimit.is_colimit ((G ⋙ Sheaf_to_presheaf proetale_topology Ab) ⋙
    (evaluation Profiniteᵒᵖ Ab).obj X))).fac _ j,
  dsimp at this, slice_rhs 1 2 { erw this }, clear this, erw colimit.ι_desc,
  dsimp, erw ← nat_trans.naturality, refl,
end

local attribute [-simp] types_comp_apply functor_to_types.comp

noncomputable
def preserves_limits_of_shape_of_filtered_aux (G : J ⥤ Condensed.{u} Ab.{u+1}) :
  Condensed_Ab_to_CondensedSet.{u}.map_cocone (filtered_cocone G) ≅
  filtered_cocone (G ⋙ Condensed_Ab_to_CondensedSet.{u}) :=
cocones.ext
{ hom := Sheaf.hom.mk $ (preserves_limits_aux_1 G).hom,
  inv := Sheaf.hom.mk $ (preserves_limits_aux_1 G).inv,
  hom_inv_id' := by { ext1, simp },
  inv_hom_id' := by { ext1, simp } }
begin
  intros j, ext, dsimp [preserves_limits_aux_1, is_colimit.cocone_point_unique_up_to_iso],

  simp only [← category.assoc, ← (forget Ab).map_comp],
  have := (is_colimit_of_preserves ((evaluation Profiniteᵒᵖ Ab).obj x)
    (colimit.is_colimit (G ⋙ Sheaf_to_presheaf proetale_topology Ab))).fac _ j,
  dsimp at this, rw this, clear this, dsimp, simp only [category.assoc],
  have := (is_colimit_of_preserves (forget Ab)
    (colimit.is_colimit ((G ⋙ Sheaf_to_presheaf proetale_topology Ab) ⋙
    (evaluation Profiniteᵒᵖ Ab).obj x))).fac _ j,
  dsimp at this, simp only [← category.assoc], rw this, clear this, erw colimit.ι_desc,
  refl,

end

end

noncomputable
instance Condensed_Ab_to_CondensedSet_preserves_limits_of_shape_of_filtered :
  preserves_colimits_of_shape J Condensed_Ab_to_CondensedSet.{u} :=
begin
  constructor,
  intros G,
  apply preserves_colimit_of_preserves_colimit_cocone (filtered_cocone_is_colimit G),
  apply is_colimit.of_iso_colimit (filtered_cocone_is_colimit
    (G ⋙ Condensed_Ab_to_CondensedSet)),
  exact (preserves_limits_of_shape_of_filtered_aux G).symm,
end