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

import for_mathlib.algebraic_topology.homotopical_algebra.model_category_axioms
import category_theory.limits.opposites
import category_theory.limits.shapes.comm_sq
import for_mathlib.category_theory.localization.predicate

noncomputable theory

open category_theory category_theory.limits

namespace algebraic_topology

variables (C : Type*) [category C]

class model_category extends category_with_fib_cof_weq C :=
(CM1axiom : has_finite_limits C ∧ has_finite_colimits C)
(CM2axiom : to_category_with_fib_cof_weq.CM2)
(CM3axiom : to_category_with_fib_cof_weq.CM3)
(CM4axiom : to_category_with_fib_cof_weq.CM4)
(CM5axiom : to_category_with_fib_cof_weq.CM5)

namespace model_category

variable {C}
variable [M : model_category C]
include M

def fib := M.fib
def cof := M.cof
def weq := M.weq
def triv_fib := M.to_category_with_fib_cof_weq.triv_fib
def triv_cof := M.to_category_with_fib_cof_weq.triv_cof

lemma CM1 : has_finite_limits C ∧ has_finite_colimits C := M.CM1axiom
lemma CM2 : (weq : morphism_property C).three_of_two := M.CM2axiom
lemma CM3 : M.to_category_with_fib_cof_weq.CM3 := M.CM3axiom
lemma CM3a : (weq : morphism_property C).is_stable_by_retract := CM3.weq
lemma CM3b : (fib : morphism_property C).is_stable_by_retract := CM3.fib
lemma CM3c : (cof : morphism_property C).is_stable_by_retract := CM3.cof
lemma CM4 : M.to_category_with_fib_cof_weq.CM4 := M.CM4axiom
lemma CM4a : (triv_cof : morphism_property C).has_lifting_property fib := CM4.1
lemma CM4b : (cof : morphism_property C).has_lifting_property triv_fib := CM4.2
lemma CM5 : M.to_category_with_fib_cof_weq.CM5 := M.CM5axiom
lemma CM5a : factorisation_axiom (triv_cof : morphism_property C) fib := CM5.1
lemma CM5b : factorisation_axiom (cof : morphism_property C) triv_fib := CM5.2

@[priority 100] instance : has_finite_limits C := CM1.1
@[priority 100] instance : has_finite_colimits C := CM1.2

instance : model_category Cᵒᵖ :=
{ to_category_with_fib_cof_weq := M.to_category_with_fib_cof_weq.op,
  CM1axiom := ⟨infer_instance, infer_instance⟩,
  CM2axiom := by simpa only [← M.to_category_with_fib_cof_weq.CM2_iff_op] using CM2axiom,
  CM3axiom := by simpa only [← M.to_category_with_fib_cof_weq.CM3_iff_op] using CM3axiom,
  CM4axiom := by simpa only [← M.to_category_with_fib_cof_weq.CM4_iff_op] using CM4axiom,
  CM5axiom := by simpa only [← M.to_category_with_fib_cof_weq.CM5_iff_op] using CM5axiom, }

variables {A B X Y Z : C} (i : A ⟶ B) {p : X ⟶ Y} {q : Y ⟶ Z} {f : X ⟶ Y}
  (hip : is_retract_hom i p)

class cofibration : Prop := (property : cof i)
class fibration : Prop := (property : fib i)
class weak_eq : Prop := (property : weq i)

variable {i}

@[priority 100] instance CM4a' [hi₁ : cofibration i] [hi₂ : weak_eq i] [hp : fibration p] :
  has_lifting_property i p := CM4a i ⟨hi₁.property, hi₂.property⟩ p hp.property
@[priority 100] instance CM4b' [hi : cofibration i] [hp₁ : fibration p] [hp₂ : weak_eq p] :
  has_lifting_property i p := CM4b i hi.property p ⟨hp₁.property, hp₂.property⟩

lemma cofibration_retract_stable [hp : cofibration p] : cofibration i :=
⟨CM3.cof i p hip hp.property⟩
lemma fibration_retract_stable [hp : fibration p] : fibration i :=
⟨CM3.fib i p hip hp.property⟩
lemma weq_retract_stable [hp : weak_eq p] : weak_eq i :=
⟨CM3.weq i p hip hp.property⟩

lemma cof_eq_llp_with_triv_fib : cof = (triv_fib : morphism_property C).llp_with :=
factorisation_axiom.eq_llp_with CM5b CM4b CM3.cof
lemma triv_fib_eq_rlp_with_cof : triv_fib = (cof : morphism_property C).rlp_with :=
factorisation_axiom.eq_rlp_with CM5b CM4b CM3.triv_fib
lemma triv_cof_eq_llp_with_fib : triv_cof = (fib : morphism_property C).llp_with :=
factorisation_axiom.eq_llp_with CM5a CM4a CM3.triv_cof
lemma fib_eq_rlp_with_triv_cof : fib = (triv_cof : morphism_property C).rlp_with :=
factorisation_axiom.eq_rlp_with CM5a CM4a CM3.fib

lemma cof_stable_under_composition : (cof : morphism_property C).stable_under_composition :=
by { rw cof_eq_llp_with_triv_fib, apply morphism_property.llp_with.stable_under_composition, }
lemma fib_stable_under_composition : (fib : morphism_property C).stable_under_composition :=
by { rw fib_eq_rlp_with_triv_cof, apply morphism_property.rlp_with.stable_under_composition, }

instance comp_weak_eq [hp : weak_eq p] [hq : weak_eq q] : weak_eq (p ≫ q) :=
⟨CM2.of_comp p q hp.property hq.property⟩
instance comp_cofibration [hp : cofibration p] [hq : cofibration q] : cofibration (p ≫ q) :=
⟨cof_stable_under_composition p q hp.property hq.property⟩
instance comp_fibration [hp : fibration p] [hq : fibration q] : fibration (p ≫ q) :=
⟨fib_stable_under_composition p q hp.property hq.property⟩

namespace weak_eq

variables (p q)

lemma of_comp_left (hp : weak_eq p) (hpq : weak_eq (p ≫ q)) : weak_eq q :=
⟨CM2.of_comp_left p q hp.property hpq.property⟩
lemma of_comp_left' [hp : weak_eq p] [hpq : weak_eq (p ≫ q)] : weak_eq q :=
of_comp_left p q hp hpq

lemma of_comp_right (hq : weak_eq q) (hpq : weak_eq (p ≫ q)) : weak_eq p :=
⟨CM2.of_comp_right p q hq.property hpq.property⟩
lemma of_comp_right' [hq : weak_eq q] [hpq : weak_eq (p ≫ q)] : weak_eq p :=
of_comp_right p q hq hpq

end weak_eq

lemma cof_contains_iso : morphism_property.isomorphisms C ⊆ cof :=
by { rw cof_eq_llp_with_triv_fib, apply morphism_property.llp_with.contains_iso, }
lemma fib_contains_iso : morphism_property.isomorphisms C ⊆ fib :=
by { rw fib_eq_rlp_with_triv_cof, apply morphism_property.rlp_with.contains_iso, }
lemma triv_cof_contains_iso : morphism_property.isomorphisms C ⊆ triv_cof :=
by { rw triv_cof_eq_llp_with_fib, apply morphism_property.llp_with.contains_iso, }
lemma triv_fib_contains_iso : morphism_property.isomorphisms C ⊆ triv_fib :=
by { rw triv_fib_eq_rlp_with_cof, apply morphism_property.rlp_with.contains_iso, }
lemma weq_contains_iso : morphism_property.isomorphisms C ⊆ weq :=
λ X Y f hf, (triv_cof_contains_iso f hf).2

@[priority 100] instance cofibration_of_is_iso [is_iso p] : cofibration p :=
⟨cof_contains_iso p (morphism_property.isomorphisms.infer_property _)⟩
@[priority 100] instance fibration_of_is_iso [is_iso p] : fibration p :=
⟨fib_contains_iso p (morphism_property.isomorphisms.infer_property _)⟩
@[priority 100] instance weak_eq_of_is_iso [is_iso p] : weak_eq p :=
⟨weq_contains_iso p (morphism_property.isomorphisms.infer_property _)⟩

instance CM5a_cofibration : cofibration (CM5a.i f) := ⟨(CM5a.i_property f).1⟩
instance CM5a_weak_eq : weak_eq (CM5a.i f) := ⟨(CM5a.i_property f).2⟩
instance CM5a_fibration : fibration (CM5a.p f) := ⟨CM5a.p_property f⟩

instance CM5b_cofibration : cofibration (CM5b.i f) := ⟨CM5b.i_property f⟩
instance CM5b_fibration : fibration (CM5b.p f) := ⟨(CM5b.p_property f).1⟩
instance CM5b_weak_eq : weak_eq (CM5b.p f) := ⟨(CM5b.p_property f).2⟩

lemma cof_is_stable_under_cobase_change : (cof : morphism_property C).stable_under_cobase_change :=
by { rw cof_eq_llp_with_triv_fib, apply morphism_property.llp_with.stable_under_cobase_change, }
lemma triv_cof_is_stable_under_cobase_change :
  (triv_cof : morphism_property C).stable_under_cobase_change :=
by { rw triv_cof_eq_llp_with_fib, apply morphism_property.llp_with.stable_under_cobase_change, }

lemma cof_is_stable_under_coproducts : (cof : morphism_property C).stable_under_coproducts :=
by { rw cof_eq_llp_with_triv_fib, apply morphism_property.llp_with.stable_under_coproducts, }
lemma triv_cof_is_stable_under_coproducts : (triv_cof : morphism_property C).stable_under_coproducts :=
by { rw triv_cof_eq_llp_with_fib, apply morphism_property.llp_with.stable_under_coproducts, }

lemma fib_is_stable_under_base_change :
  (fib : morphism_property C).stable_under_base_change :=
by { rw fib_eq_rlp_with_triv_cof, apply morphism_property.rlp_with.stable_under_base_change, }
lemma triv_fib_is_stable_under_base_change :
  (triv_fib : morphism_property C).stable_under_base_change :=
by { rw triv_fib_eq_rlp_with_cof, apply morphism_property.rlp_with.stable_under_base_change, }

lemma fib_is_stable_under_products : (fib : morphism_property C).stable_under_products :=
by { rw fib_eq_rlp_with_triv_cof, apply morphism_property.rlp_with.stable_under_products, }
lemma triv_fib_is_stable_under_products : (triv_fib : morphism_property C).stable_under_products :=
by { rw triv_fib_eq_rlp_with_cof, apply morphism_property.rlp_with.stable_under_products, }

lemma cof_respects_iso : (cof : morphism_property C).respects_iso :=
morphism_property.respects_iso.of_stable_under_composition_and_contains_iso
  cof_stable_under_composition cof_contains_iso
lemma fib_respects_iso : (fib : morphism_property C).respects_iso :=
morphism_property.respects_iso.of_stable_under_composition_and_contains_iso
  fib_stable_under_composition fib_contains_iso
lemma weq_respects_iso : (weq : morphism_property C).respects_iso :=
morphism_property.respects_iso.of_stable_under_composition_and_contains_iso
  CM2.of_comp weq_contains_iso

namespace cofibration

lemma op (hi : cofibration i) : fibration i.op := ⟨hi.property⟩
lemma unop {A B : Cᵒᵖ} {i : A ⟶ B} (hi : cofibration i) : fibration i.unop := ⟨hi.property⟩
lemma iff_cof : cofibration i ↔ cof i := ⟨λ h, h.property, λ h, ⟨h⟩⟩

lemma direct_image ⦃f : A ⟶ X⦄ ⦃i : A ⟶ B⦄ ⦃i' : X ⟶ Y⦄ ⦃g : B ⟶ Y⦄
  (h : is_pushout f i i' g) [hi : cofibration i] : cofibration i' :=
⟨cof_is_stable_under_cobase_change h hi.property⟩

lemma direct_image_is_weak_eq ⦃f : A ⟶ X⦄ ⦃i : A ⟶ B⦄ ⦃i' : X ⟶ Y⦄ ⦃g : B ⟶ Y⦄
  (h : is_pushout f i i' g) [hi₁ : cofibration i] [hi₂ : weak_eq i] : weak_eq i' :=
⟨(triv_cof_is_stable_under_cobase_change h ⟨hi₁.property, hi₂.property⟩).2⟩

instance {A X₁ X₂ : C} (f : A ⟶ X₁) (g : A ⟶ X₂) [hg : cofibration g] :
  cofibration (pushout.inl : X₁ ⟶ pushout f g) :=
⟨cof_is_stable_under_cobase_change.inl f g hg.property⟩

instance {A X₁ X₂ : C} (f : A ⟶ X₁) (g : A ⟶ X₂) [hf : cofibration f] :
  cofibration (pushout.inr : X₂ ⟶ pushout f g) :=
⟨cof_is_stable_under_cobase_change.inr f g hf.property⟩

instance {X₁ X₂ Y₁ Y₂ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) [h₁ : cofibration f₁] [h₂ : cofibration f₂] :
  cofibration (coprod.map f₁ f₂) :=
⟨cof_is_stable_under_coproducts.binary f₁ h₁.property f₂ h₂.property⟩

instance {X₁ X₂ Y₁ Y₂ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) [h₁ : cofibration f₁] [h₂ : cofibration f₂]
  [h₁' : weak_eq f₁] [h₂' : weak_eq f₂] :
  weak_eq (coprod.map f₁ f₂) :=
⟨(triv_cof_is_stable_under_coproducts.binary f₁ ⟨h₁.property, h₁'.property⟩
  f₂ ⟨h₂.property, h₂'.property⟩).2⟩

lemma respects_iso {X₁ X₂ Y₁ Y₂ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (e : arrow.mk f₁ ≅ arrow.mk f₂) :
  cofibration f₁ ↔ cofibration f₂ :=
by simpa only [iff_cof] using cof_respects_iso.arrow_mk_iso_iff e

end cofibration

namespace fibration

lemma op (hp : fibration p) : cofibration p.op := ⟨hp.property⟩
lemma unop {X Y : Cᵒᵖ} {p : X ⟶ Y} (hp : fibration p) : cofibration p.unop := ⟨hp.property⟩
lemma iff_fib : fibration i ↔ fib i := ⟨λ h, h.property, λ h, ⟨h⟩⟩

variable (p)
lemma iff_op : fibration p ↔ cofibration p.op := ⟨op, cofibration.unop⟩
lemma iff_unop {X Y : Cᵒᵖ} (p : X ⟶ Y) : fibration p ↔ cofibration p.unop := ⟨unop, cofibration.op⟩

lemma respects_iso {X₁ X₂ Y₁ Y₂ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (e : arrow.mk f₁ ≅ arrow.mk f₂) :
  fibration f₁ ↔ fibration f₂ :=
by simpa only [iff_fib] using fib_respects_iso.arrow_mk_iso_iff e

end fibration

namespace cofibration

variable (p)

lemma iff_op : cofibration p ↔ fibration p.op := ⟨op, fibration.unop⟩
lemma iff_unop {X Y : Cᵒᵖ} (p : X ⟶ Y) : cofibration p ↔ fibration p.unop := ⟨unop, fibration.op⟩

end cofibration

namespace weak_eq

lemma op (hp : weak_eq p) : weak_eq p.op := ⟨hp.property⟩
lemma unop {X Y : Cᵒᵖ} {p : X ⟶ Y} (hp : weak_eq p) : weak_eq p.unop := ⟨hp.property⟩
lemma iff_weq : weak_eq i ↔ weq i := ⟨λ h, h.property, λ h, ⟨h⟩⟩

instance {A X₁ X₂ : C} (f : A ⟶ X₁) (g : A ⟶ X₂) [hg₁ : cofibration g] [hg₂ : weak_eq g] :
  weak_eq (pushout.inl : X₁ ⟶ pushout f g) :=
⟨(triv_cof_is_stable_under_cobase_change.inl f g ⟨hg₁.property, hg₂.property⟩).2⟩

instance {A X₁ X₂ : C} (f : A ⟶ X₁) (g : A ⟶ X₂) [hf₁ : cofibration f] [hf₂ : weak_eq f] :
  weak_eq (pushout.inr : X₂ ⟶ pushout f g) :=
⟨(triv_cof_is_stable_under_cobase_change.inr f g ⟨hf₁.property, hf₂.property⟩).2⟩

lemma respects_iso {X₁ X₂ Y₁ Y₂ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (e : arrow.mk f₁ ≅ arrow.mk f₂) :
  weak_eq f₁ ↔ weak_eq f₂ :=
by simpa only [iff_weq] using weq_respects_iso.arrow_mk_iso_iff e

end weak_eq

variable (C)

@[derive category]
def Ho' := (weq : morphism_property C).localization

variable {C}

def L' : C ⥤ Ho' C := weq.Q

instance L'_is_localization : L'.is_localization (weq : morphism_property C) :=
by { dsimp [L'], apply_instance, }

variables {Ho : Type*} [category Ho] (L : C ⥤ Ho) [L.is_localization weq]

lemma is_iso_L_map' {X Y : C} (f : X ⟶ Y) (hf : weq f) : is_iso (L.map f) :=
localization.inverts L weq f hf

lemma is_iso_L_map {X Y : C} (f : X ⟶ Y) [weak_eq f] : is_iso (L.map f) :=
is_iso_L_map' L f weak_eq.property

end model_category

end algebraic_topology


import data.fintype tactic.find data.set.finite ring_theory.subring data.nat.choose tactic.find

open tactic expr lean interactive interactive.types
open set finset

meta def fold_test : expr → tactic (list (nat × string)) :=
λ e, do let l := e.fold [] (λ e n l, (n, e.to_string) :: l),
trace l, return l

meta def fold_test_type : expr → tactic (list (nat × string)) :=
λ e, do l ← e.fold (pure [])
  (λ e n l, (do t ← infer_type e, l ← l, return ((n, t.to_string) :: l)) <|> l),
  trace l, return l

meta def fold_test_target : tactic unit :=
target >>= fold_test >> skip

meta def fold_test_target_type : tactic unit :=
target >>= fold_test_type >> skip

/-- gets the type of any fintype in an expr -/
meta def get_fintype (e : expr) : tactic (list expr) :=
e.fold (pure []) $ λ e _ l, do l' ← l,
  (do t ← infer_type e,
  match t with
  | `(fintype _) := return (e::l')
  | _ := return l'
  end) <|> return l'

-- meta def is_fintype (e : expr) : tactic (list expr) :=
-- match e with
-- | (app n _) := if n.const_name = `fintype then return [e] else return []
-- | _         := return []
-- end

-- meta def is_fintype_type (e : expr) : tactic (list expr) :=
-- infer_type e >>= is_fintype

/-- checks is an expression is has type `fintype _` -/
meta def is_fintype (e : expr) : tactic bool :=
match e with
| (app n _) := if n.const_name = `fintype then return tt else return ff
| _         := return ff
end

/-- returns the type of an expr if it has type `fintype _` -/
meta def is_fintype_type (e : expr) : tactic expr :=
do f ← infer_type e,
  b ← is_fintype f,
  match b with
  | tt := return f
  | ff := failure
  end

-- meta def get_fintype' : expr → tactic (list expr)
-- | e := do l ← is_fintype_type e, match l with
--   | [] := match e with
--     | (mvar _ _ f)          := is_fintype f
--     | (local_const _ _ _ f) := is_fintype f
--     | (app f g)             := do lf ← get_fintype' f, lg ← get_fintype' g, return (lf ++ lg)
--     | _                     := return []
--     end
--   | _ := return l
-- end

-- meta def thing : tactic unit :=
-- do t ← target,
-- l ← get_fintype' t,
-- match l with
-- | [] := return ()
-- | (a :: l) := _match l >> pose `f none a >> reset_instance_cache >> skip
-- end
-- #print expr
-- lemma fintype_congr (α : Type*) [fintype α] (P : Π [fintype α], Prop) (h : P) (x : fintype α) : @P x :=
-- by convert h

-- meta def generalize_fintype : expr → tactic (list expr)
-- | `(@eq (%%u) (%%a) (%%b)) := match a with
--   | (mvar x y f)           := mcond (is_fintype f) (return [f]) failure
--   | (local_const _ _ _ f)  := mcond (is_fintype f) (return [f]) failure
--   | (app f g)              := do lf ← get_fintype f, lg ← get_fintype g, return (lf ++ lg)
--   | _                      := return []
--   end
-- | `((%%a) ↔ (%%b)) := match a with
--   | (mvar x y f)           := mcond (is_fintype f) (return [f]) failure
--   | (local_const _ _ _ f)  := mcond (is_fintype f) (return [f]) failure
--   | (app f g)              := do lf ← get_fintype f, lg ← get_fintype g, return (lf ++ lg)
--   | _                      := return []
--   end
-- | e := return []

-- #print expr.

-- meta def generalize_forall_aux (t : expr) (e : expr) (f : expr → expr) :
--   expr × (expr → expr) :=
-- cond (expr.alpha_eqv t e)
--   _
--   (e, f)

-- meta def generalize_forall (t : expr) : expr → (expr → expr) → tactic expr
-- | (const n l) f :=

-- #reduce tactic.skip
-- #reduce (return () : tactic unit)
-- example : false :=
-- let x : ℕ := 1 in
-- have hx : x = 1 := rfl,
-- begin
--   replace x := x,

-- end
#print cond._main
#print id_rhs
#find (tactic _ → option _)

meta def get_fintype' (e : expr) : tactic (list (expr × expr)) :=
e.fold (return []) $ λ e _ l, do l' ← l,
  (do t ← infer_type e,
  match t with
  | `(fintype _) := cond (has_var e) (return ((e, t) :: l')) (return l')
  | _ := return l'
  end) <|> return l'

meta def get_fintype_aux (e : expr) (t : expr) (l : tactic (list (expr × expr))) :
  tactic (list (expr × expr)) :=
  match t with
  | `(fintype _) := do l ← l, cond (has_var e) (return ((e, t) :: l)) (return l)
  | _ := l
  end

#eval (```((2 : ℕ) + 2) : expr ff).to_raw_fmt.to_string

#print expr.pi
meta def get_fintype₂ : expr → tactic (list (expr × expr))
| (const n l)           := do t ← infer_type (const n l), get_fintype_aux (const n l) t (pure [])
| (local_const n m i t) := get_fintype_aux (local_const n m i t) t (pure [])
| (app f x)             := do l₁ ← get_fintype₂ f, l₂ ← get_fintype₂ x, return (l₁ ++ l₂)
| (lam n i v e)         := do l₁ ← get_fintype₂ v, l₂ ← get_fintype₂ e, return (l₁ ++ l₂)
| (pi n i v e)          := do l₁ ← get_fintype₂ v, l₂ ← get_fintype₂ e, return (l₁ ++ l₂)
| _ := return []

#print simplify

#print monad
#print expr.replace
#reduce tactic
#print <|>
#print interaction_monad.result
#print tactic
#eval expr.get_nat_value

#print expr
#print tactic.simplify
meta def

meta def replace_fintype : Π (e : expr) (l : list (expr × expr)), tactic expr

example (s t : set ℕ) [fintype s] [fintype t] [decidable_pred t] (h : fintype.card ↥(s ∩ t) = 77) :
  fintype.card ↥(s ∪ t) = 9  :=
begin
  -- thing,
  -- fold_test_target_type,

end


import .homotopy

universes v u

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

namespace homotopy_theory.cylinder

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

-- A map j : A → X is the inclusion of a strong deformation retract if
-- it admits a retraction r : X → A for which j ∘ r is homotopic to
-- the identity rel j.
structure sdr_inclusion {a x : C} (j : a ⟶ x) :=
(r : x ⟶ a)
(h : r ∘ j = 𝟙 a)
(H : j ∘ r ≃ 𝟙 x rel j)

def is_sdr_inclusion {a x : C} (j : a ⟶ x) : Prop := nonempty (sdr_inclusion j)

lemma pushout_of_sdr_inclusion {a x a' x' : C} {j : a ⟶ x} {f : a ⟶ a'} {f' : x ⟶ x'}
  {j' : a' ⟶ x'} (po : Is_pushout j f f' j')
  (po' : Is_pushout (I &> j) (I &> f) (I &> f') (I &> j')) :
  is_sdr_inclusion j → is_sdr_inclusion j' :=
assume ⟨⟨r, h, ⟨H, Hrel⟩⟩⟩, begin
  refine ⟨⟨po.induced (f ∘ r) (𝟙 a') (by rw [←assoc, h]; simp), by simp, _⟩⟩,
  -- Now need to give a homotopy from j' ∘ r' (r' = the above induced
  -- map) to 𝟙 x', rel j'. We define the homotopy using H on I +> x,
  -- and the constant homotopy at the identity on I +> a'.
  refine ⟨⟨po'.induced (f' ∘ H.H) (j' ∘ p @> a') _, _, _⟩, _⟩,
  -- The above maps agree on I +> a, so we can form the induced map:
  { unfold homotopy.is_rel at Hrel, rw [←assoc, Hrel, p_nat_assoc],
    have : f' ∘ (j ∘ r ∘ j ∘ p @> a) = (f' ∘ j) ∘ (r ∘ j) ∘ p @> a, by simp,
    rw [this, po.commutes, h], dsimp, simp },
  -- The homotopy defined in this way starts at j' ∘ r' : x' → x':
  { apply po.uniqueness; rw i_nat_assoc; conv { to_rhs, rw ←assoc }; simp;
      rw ←assoc,
    { erw [H.Hi₀, assoc, po.commutes] },
    { rw [pi_components], simp } },
  -- ... and ends at 𝟙 x':
  { apply po.uniqueness; rw i_nat_assoc; simp; rw [←assoc],
    { erw H.Hi₁; simp }, { rw [pi_components], simp } },
  -- ... and is rel j:
  { unfold homotopy.is_rel,
    simp, congr, rw [←assoc], dsimp, simp }
end

end homotopy_theory.cylinder


import language.unitb.parser

open list -- unitb.parser

machine foo
variables x, y
invariants
  bar: x ∪ y ⊆ x
initialization
  x := ∅, y := ∅
events
  move
    when grd1 : ∅ ∈ x
    then end
  add_x begin x := y end
  swap begin x,y := y,x end
proofs
  bar :=
  begin
    simp [x_1,y_1], admit,
  end,

end

#print foo.correctness
-- #print prefix foo.event.swap
-- #print prefix foo.event.move
#print foo.event.swap.step'
#print foo.event.add_x.step'
#print foo.event.move.step'
#print foo.event.spec
#print foo.init'
#print foo.spec

example (s : foo.state) (J : foo.inv s) : true :=
begin
  induction s,
  dunfold foo.inv at J,
  induction J,
  admit
end

example (k : foo.state) : true :=
begin
  induction k,
  admit
end


/-
Copyright (c) 2022 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.preadditive.additive_functor
import category_theory.abelian.basic
import category_theory.limits.preserves.shapes.kernels
import category_theory.adjunction.limits

/-!
# Transferring "abelian-ness" across a functor

If `C` is an additive category, `D` is an abelian category,
we have `F : C ⥤ D` `G : D ⥤ C` (both preserving zero morphisms),
`G` is left exact (that is, preserves finite limits),
and further we have `adj : G ⊣ F` and `i : F ⋙ G ≅ 𝟭 C`,
then `C` is also abelian.

See https://stacks.math.columbia.edu/tag/03A3

## Notes
The hypotheses, following the statement from the Stacks project,
may appear suprising: we don't ask that the counit of the adjunction is an isomorphism,
but just that we have some potentially unrelated isomorphism `i : F ⋙ G ≅ 𝟭 C`.

However Lemma A1.1.1 from [Elephant] shows that in this situation the counit itself
must be an isomorphism, and thus that `C` is a reflective subcategory of `D`.

Someone may like to formalize that lemma, and restate this theorem in terms of `reflective`.
(That lemma has a nice string diagrammatic proof that holds in any bicategory.)
-/

noncomputable theory

namespace category_theory
open category_theory.limits

universes v u₁ u₂

namespace abelian_of_adjunction

variables {C : Type u₁} [category.{v} C] [preadditive C]
variables {D : Type u₂} [category.{v} D] [abelian D]
variables (F : C ⥤ D)
variables (G : D ⥤ C) [functor.preserves_zero_morphisms G]
variables (i : F ⋙ G ≅ 𝟭 C) (adj : G ⊣ F)

include i

/-- No point making this an instance, as it requires `i`. -/
lemma has_kernels [preserves_finite_limits G] : has_kernels C :=
{ has_limit := λ X Y f, begin
    have := nat_iso.naturality_1 i f,
    simp at this,
    rw ←this,
    haveI : has_kernel (G.map (F.map f) ≫ i.hom.app _) := limits.has_kernel_comp_mono _ _,
    apply limits.has_kernel_iso_comp,
  end }

include adj

/-- No point making this an instance, as it requires `i` and `adj`. -/
lemma has_cokernels : has_cokernels C :=
{ has_colimit := λ X Y f, begin
    haveI : preserves_colimits G := adj.left_adjoint_preserves_colimits,
    have := nat_iso.naturality_1 i f,
    simp at this,
    rw ←this,
    haveI : has_cokernel (G.map (F.map f) ≫ i.hom.app _) := limits.has_cokernel_comp_iso _ _,
    apply limits.has_cokernel_epi_comp,
  end }

variables [limits.has_cokernels C]

/-- Auxiliary construction for `coimage_iso_image` -/
def cokernel_iso {X Y : C} (f : X ⟶ Y) : G.obj (cokernel (F.map f)) ≅ cokernel f :=
begin
  -- We have to write an explicit `preserves_colimits` type here,
  -- as `left_adjoint_preserves_colimits` has universe variables.
  haveI : preserves_colimits G := adj.left_adjoint_preserves_colimits,
  calc G.obj (cokernel (F.map f))
      ≅ cokernel (G.map (F.map f)) : (as_iso (cokernel_comparison _ G)).symm
  ... ≅ cokernel (_ ≫ f ≫ _)       : cokernel_iso_of_eq (nat_iso.naturality_2 i f).symm
  ... ≅ cokernel (f ≫ _)           : cokernel_epi_comp _ _
  ... ≅ cokernel f                 : cokernel_comp_is_iso _ _
end

variables [limits.has_kernels C] [preserves_finite_limits G]

/-- Auxiliary construction for `coimage_iso_image` -/
def coimage_iso_image_aux {X Y : C} (f : X ⟶ Y) :
  kernel (G.map (cokernel.π (F.map f))) ≅ kernel (cokernel.π f) :=
begin
  haveI : preserves_colimits G := adj.left_adjoint_preserves_colimits,
  calc kernel (G.map (cokernel.π (F.map f)))
      ≅ kernel (cokernel.π (G.map (F.map f)) ≫ cokernel_comparison (F.map f) G)
          : kernel_iso_of_eq (π_comp_cokernel_comparison _ _).symm
  ... ≅ kernel (cokernel.π (G.map (F.map f))) : kernel_comp_mono _ _
  ... ≅ kernel (cokernel.π (_ ≫ f ≫ _) ≫ (cokernel_iso_of_eq _).hom)
          : kernel_iso_of_eq (π_comp_cokernel_iso_of_eq_hom (nat_iso.naturality_2 i f)).symm
  ... ≅ kernel (cokernel.π (_ ≫ f ≫ _))       : kernel_comp_mono _ _
  ... ≅ kernel (cokernel.π (f ≫ i.inv.app Y) ≫ (cokernel_epi_comp (i.hom.app X) _).inv)
          : kernel_iso_of_eq (by simp only [cokernel.π_desc, cokernel_epi_comp_inv])
  ... ≅ kernel (cokernel.π (f ≫ _))           : kernel_comp_mono _ _
  ... ≅ kernel (inv (i.inv.app Y) ≫ cokernel.π f ≫ (cokernel_comp_is_iso f (i.inv.app Y)).inv)
          : kernel_iso_of_eq (by simp only [cokernel.π_desc, cokernel_comp_is_iso_inv,
              iso.hom_inv_id_app_assoc, nat_iso.inv_inv_app])
  ... ≅ kernel (cokernel.π f ≫ _)             : kernel_is_iso_comp _ _
  ... ≅ kernel (cokernel.π f)                 : kernel_comp_mono _ _
end

variables [functor.preserves_zero_morphisms F]

/--
Auxiliary definition: the abelian coimage and abelian image agree.
We still need to check that this agrees with the canonical morphism.
-/
def coimage_iso_image {X Y : C} (f : X ⟶ Y) : abelian.coimage f ≅ abelian.image f :=
begin
  haveI : preserves_limits F := adj.right_adjoint_preserves_limits,
  haveI : preserves_colimits G := adj.left_adjoint_preserves_colimits,
  calc abelian.coimage f
      ≅ cokernel (kernel.ι f)                 : iso.refl _
  ... ≅ G.obj (cokernel (F.map (kernel.ι f))) : (cokernel_iso _ _ i adj _).symm
  ... ≅ G.obj (cokernel (kernel_comparison f F ≫ (kernel.ι (F.map f))))
                                              : G.map_iso (cokernel_iso_of_eq (by simp))
  ... ≅ G.obj (cokernel (kernel.ι (F.map f))) : G.map_iso (cokernel_epi_comp _ _)
  ... ≅ G.obj (abelian.coimage (F.map f))     : iso.refl _
  ... ≅ G.obj (abelian.image (F.map f))       : G.map_iso (abelian.coimage_iso_image _)
  ... ≅ G.obj (kernel (cokernel.π (F.map f))) : iso.refl _
  ... ≅ kernel (G.map (cokernel.π (F.map f))) : preserves_kernel.iso _ _
  ... ≅ kernel (cokernel.π f)                 : coimage_iso_image_aux F G i adj f
  ... ≅ abelian.image f                       : iso.refl _,
end

local attribute [simp] cokernel_iso coimage_iso_image coimage_iso_image_aux

-- The account of this proof in the Stacks project omits this calculation.
-- Happily it's little effort: our `[ext]` and `[simp]` lemmas only need a little guidance.
lemma coimage_iso_image_hom {X Y : C} (f : X ⟶ Y) :
  (coimage_iso_image F G i adj f).hom = abelian.coimage_image_comparison f :=
by { ext, simpa [-functor.map_comp, ←G.map_comp_assoc] using nat_iso.naturality_1 i f, }

end abelian_of_adjunction

open abelian_of_adjunction

/--
If `C` is an additive category, `D` is an abelian category,
we have `F : C ⥤ D` `G : D ⥤ C` (both preserving zero morphisms),
`G` is left exact (that is, preserves finite limits),
and further we have `adj : G ⊣ F` and `i : F ⋙ G ≅ 𝟭 C`,
then `C` is also abelian.

See https://stacks.math.columbia.edu/tag/03A3
-/
def abelian_of_adjunction
  {C : Type u₁} [category.{v} C] [preadditive C] [has_finite_products C]
  {D : Type u₂} [category.{v} D] [abelian D]
  (F : C ⥤ D) [functor.preserves_zero_morphisms F]
  (G : D ⥤ C) [functor.preserves_zero_morphisms G] [preserves_finite_limits G]
  (i : F ⋙ G ≅ 𝟭 C) (adj : G ⊣ F) : abelian C :=
begin
  haveI := has_kernels F G i, haveI := has_cokernels F G i adj,
  haveI : ∀ {X Y : C} (f : X ⟶ Y), is_iso (abelian.coimage_image_comparison f),
  { intros X Y f, rw ←coimage_iso_image_hom F G i adj f, apply_instance, },
  apply abelian.of_coimage_image_comparison_is_iso,
end

end category_theory


import for_mathlib.category_theory.morphism_property_misc
import category_theory.lifting_properties.basic
import for_mathlib.category_theory.lifting_properties.pullbacks
import for_mathlib.category_theory.lifting_properties.products
import for_mathlib.category_theory.lifting_properties.over

open category_theory.limits

namespace category_theory

variables {C : Type*} [category C]

namespace morphism_property

variables (F G : morphism_property C)

def has_lifting_property : Prop :=
∀ ⦃A B X Y : C⦄ (i : A ⟶ B) (hi : F i) (p : X ⟶ Y) (hp : G p), has_lifting_property i p

namespace has_lifting_property

variables {F G}

lemma property (h : has_lifting_property F G)
{A B X Y : C} {i : A ⟶ B} (hi : F i) {p : X ⟶ Y} (hp : G p) :
  category_theory.has_lifting_property i p := h i hi p hp

lemma op (h : has_lifting_property F G) :
  has_lifting_property G.op F.op :=
λ A B X Y i hi p hp, (h p.unop hp i.unop hi).op

lemma unop {F G : morphism_property Cᵒᵖ} (h : has_lifting_property F G) :
  has_lifting_property G.unop F.unop :=
λ A B X Y i hi p hp, (h p.op hp i.op hi).unop

variables (F G)
lemma iff_op : has_lifting_property F G ↔ has_lifting_property G.op F.op := ⟨op, unop⟩
lemma iff_unop (F' G' : morphism_property Cᵒᵖ) :
  has_lifting_property F' G' ↔ has_lifting_property G'.unop F'.unop := ⟨unop, op⟩

variables {F G}
lemma under (h : has_lifting_property F G) (M : C) :
  has_lifting_property (F.inverse_image (under.forget M)) (G.inverse_image (under.forget M)) :=
λ A B X Y i hi p hp, by { haveI := h _ hi _ hp, apply_instance, }

end has_lifting_property

@[simp]
def llp_with : morphism_property C :=
λ A B i, ∀ ⦃X Y : C⦄ (p : X ⟶ Y) (hp : G p), category_theory.has_lifting_property i p

@[simp]
def rlp_with : morphism_property C :=
λ X Y p, ∀ ⦃A B : C⦄ (i : A ⟶ B) (hi : F i), category_theory.has_lifting_property i p

lemma llp_with_op :
  F.op.llp_with = F.rlp_with.op :=
begin
  ext A B i,
  split,
  { intros h X Y p hp,
    rw category_theory.has_lifting_property.iff_op,
    exact h p.op hp, },
  { intros h X Y p hp,
    rw category_theory.has_lifting_property.iff_unop,
    exact h p.unop hp, },
end

lemma rlp_with_op :
  G.op.rlp_with = G.llp_with.op :=
begin
  ext A B i,
  split,
  { intros h X Y p hp,
    rw category_theory.has_lifting_property.iff_op,
    exact h p.op hp, },
  { intros h X Y p hp,
    rw category_theory.has_lifting_property.iff_unop,
    exact h p.unop hp, },
end

lemma llp_with_unop (G : morphism_property Cᵒᵖ) :
  G.unop.llp_with = G.rlp_with.unop :=
begin
  have h := rlp_with_op G.unop,
  rw G.op_unop at h,
  rw [h, unop_op],
end

lemma rlp_with_unop (F : morphism_property Cᵒᵖ) :
  F.unop.rlp_with = F.llp_with.unop :=
begin
  have h := llp_with_op F.unop,
  rw F.op_unop at h,
  rw [h, unop_op],
end

namespace llp_with

lemma contains_iso : isomorphisms C ⊆ G.llp_with :=
λ A B i hi X Y p hp, by { haveI : is_iso i := hi, apply_instance, }

lemma stable_under_composition : G.llp_with.stable_under_composition :=
λ A₁ A₂ A₃ i j hi hj X Y p hp, by { haveI := hi p hp, haveI := hj p hp, apply_instance, }

lemma respects_iso : G.llp_with.respects_iso :=
respects_iso.of_stable_under_composition_and_contains_iso
    (llp_with.stable_under_composition G) (llp_with.contains_iso G)

lemma stable_under_cobase_change : G.llp_with.stable_under_cobase_change :=
λ A A' B B' f g f' g' h hf X Y p hp, h.has_lifting_property_imp p (hf p hp)

lemma stable_under_coproducts : G.llp_with.stable_under_coproducts :=
⟨llp_with.respects_iso G,
  λ J A B hA hB i hi X Y p hp, by { haveI := λ j, hi j p hp, apply_instance, }⟩

end llp_with

namespace rlp_with

lemma contains_iso : isomorphisms C ⊆ F.rlp_with :=
λ X Y p hp A B i hi, by { haveI : is_iso p := hp, apply_instance, }

lemma stable_under_composition : F.rlp_with.stable_under_composition :=
λ X Y Z p q hp hq A B i hi, by { haveI := hp i hi, haveI := hq i hi, apply_instance, }

lemma respects_iso : F.rlp_with.respects_iso :=
respects_iso.of_stable_under_composition_and_contains_iso
    (rlp_with.stable_under_composition F) (rlp_with.contains_iso F)

lemma stable_under_base_change : F.rlp_with.stable_under_base_change :=
λ X' Y Y' X f g f' g' h hg A B i hi, h.has_lifting_property_imp i (hg i hi)

lemma stable_under_products : F.rlp_with.stable_under_products :=
⟨rlp_with.respects_iso F,
λ J X Y hX hY p hp A B i hi, by { haveI := λ j, hp j i hi, apply_instance, }⟩

end rlp_with

namespace stable_under_cobase_change

lemma coprod_inl {P : morphism_property C}
  (h : P.stable_under_cobase_change) (A B : C) [has_binary_coproduct A B]
  [has_initial C] (hB : P (initial.to B)) :
  P (coprod.inl : A ⟶ A ⨿ B) :=
h (is_pushout.of_has_binary_coproduct' A B) hB

lemma coprod_inr {P : morphism_property C}
  (h : P.stable_under_cobase_change) (A B : C) [has_binary_coproduct A B]
  [has_initial C] (hA : P (initial.to A)) :
  P (coprod.inr : B ⟶ A ⨿ B) :=
h (is_pushout.of_has_binary_coproduct' A B).flip hA

end stable_under_cobase_change

namespace stable_under_base_change

lemma prod_fst {P : morphism_property C}
  (h : P.stable_under_base_change) (X Y : C) [has_binary_product X Y]
  [has_terminal C] (hY : P (terminal.from Y)) :
  P (limits.prod.fst : X ⨯ Y ⟶ X) :=
h (is_pullback.of_has_binary_product' X Y).flip hY

lemma prod_snd {P : morphism_property C}
  (h : P.stable_under_base_change) (X Y : C) [has_binary_product X Y]
  [has_terminal C] (hX : P (terminal.from X)) :
  P (limits.prod.snd : X ⨯ Y ⟶ Y) :=
h (is_pullback.of_has_binary_product' X Y) hX

end stable_under_base_change

end morphism_property

end category_theory


/-
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, Floris van Doorn
-/
import category_theory.const
import category_theory.discrete_category
import category_theory.yoneda
import category_theory.reflects_isomorphisms

-- morphism levels before object levels. See note [category_theory universes].
universes v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄
open category_theory

variables {J : Type u₁} [category.{v₁} J]
variables {K : Type u₂} [category.{v₂} K]
variables {C : Type u₃} [category.{v₃} C]
variables {D : Type u₄} [category.{v₄} D]

open category_theory
open category_theory.category
open category_theory.functor
open opposite

namespace category_theory

namespace functor
variables {J C} (F : J ⥤ C)

/--
`F.cones` is the functor assigning to an object `X` the type of
natural transformations from the constant functor with value `X` to `F`.
An object representing this functor is a limit of `F`.
-/
@[simps]
def cones : Cᵒᵖ ⥤ Type (max u₁ v₃) := (const J).op ⋙ yoneda.obj F

/--
`F.cocones` is the functor assigning to an object `X` the type of
natural transformations from `F` to the constant functor with value `X`.
An object corepresenting this functor is a colimit of `F`.
-/
@[simps]
def cocones : C ⥤ Type (max u₁ v₃) := const J ⋙ coyoneda.obj (op F)

end functor

section
variables (J C)

/--
Functorially associated to each functor `J ⥤ C`, we have the `C`-presheaf consisting of
cones with a given cone point.
-/
@[simps] def cones : (J ⥤ C) ⥤ (Cᵒᵖ ⥤ Type (max u₁ v₃)) :=
{ obj := functor.cones,
  map := λ F G f, whisker_left (const J).op (yoneda.map f) }

/--
Contravariantly associated to each functor `J ⥤ C`, we have the `C`-copresheaf consisting of
cocones with a given cocone point.
-/
@[simps] def cocones : (J ⥤ C)ᵒᵖ ⥤ (C ⥤ Type (max u₁ v₃)) :=
{ obj := λ F, functor.cocones (unop F),
  map := λ F G f, whisker_left (const J) (coyoneda.map f) }

end

namespace limits

/--
A `c : cone F` is:
* an object `c.X` and
* a natural transformation `c.π : c.X ⟶ F` from the constant `c.X` functor to `F`.

`cone F` is equivalent, via `cone.equiv` below, to `Σ X, F.cones.obj X`.
-/
structure cone (F : J ⥤ C) :=
(X : C)
(π : (const J).obj X ⟶ F)

instance inhabited_cone (F : discrete punit ⥤ C) : inhabited (cone F) :=
⟨{ X := F.obj punit.star,
   π := { app := λ ⟨⟩, 𝟙 _ } }⟩

@[simp, reassoc] lemma cone.w {F : J ⥤ C} (c : cone F) {j j' : J} (f : j ⟶ j') :
  c.π.app j ≫ F.map f = c.π.app j' :=
by { rw ← c.π.naturality f, apply id_comp }

/--
A `c : cocone F` is
* an object `c.X` and
* a natural transformation `c.ι : F ⟶ c.X` from `F` to the constant `c.X` functor.

`cocone F` is equivalent, via `cone.equiv` below, to `Σ X, F.cocones.obj X`.
-/
structure cocone (F : J ⥤ C) :=
(X : C)
(ι : F ⟶ (const J).obj X)

instance inhabited_cocone (F : discrete punit ⥤ C) : inhabited (cocone F) :=
⟨{ X := F.obj punit.star,
   ι := { app := λ ⟨⟩, 𝟙 _ } }⟩

@[simp, reassoc] lemma cocone.w {F : J ⥤ C} (c : cocone F) {j j' : J} (f : j ⟶ j') :
  F.map f ≫ c.ι.app j' = c.ι.app j :=
by { rw c.ι.naturality f, apply comp_id }

variables {F : J ⥤ C}

namespace cone

/-- The isomorphism between a cone on `F` and an element of the functor `F.cones`. -/
@[simps]
def equiv (F : J ⥤ C) : cone F ≅ Σ X, F.cones.obj X :=
{ hom := λ c, ⟨op c.X, c.π⟩,
  inv := λ c, { X := c.1.unop, π := c.2 },
  hom_inv_id' := by { ext1, cases x, refl },
  inv_hom_id' := by { ext1, cases x, refl } }

/-- A map to the vertex of a cone naturally induces a cone by composition. -/
@[simps] def extensions (c : cone F) :
  yoneda.obj c.X ⋙ ulift_functor.{u₁} ⟶ F.cones :=
{ app := λ X f, (const J).map f.down ≫ c.π }

/-- A map to the vertex of a cone induces a cone by composition. -/
@[simps] def extend (c : cone F) {X : C} (f : X ⟶ c.X) : cone F :=
{ X := X,
  π := c.extensions.app (op X) ⟨f⟩ }

/-- Whisker a cone by precomposition of a functor. -/
@[simps] def whisker (E : K ⥤ J) (c : cone F) : cone (E ⋙ F) :=
{ X := c.X,
  π := whisker_left E c.π }

end cone

namespace cocone

/-- The isomorphism between a cocone on `F` and an element of the functor `F.cocones`. -/
def equiv (F : J ⥤ C) : cocone F ≅ Σ X, F.cocones.obj X :=
{ hom := λ c, ⟨c.X, c.ι⟩,
  inv := λ c, { X := c.1, ι := c.2 },
  hom_inv_id' := by { ext1, cases x, refl },
  inv_hom_id' := by { ext1, cases x, refl } }

/-- A map from the vertex of a cocone naturally induces a cocone by composition. -/
@[simps] def extensions (c : cocone F) : coyoneda.obj (op c.X) ⋙ ulift_functor.{u₁} ⟶ F.cocones :=
{ app := λ X f, c.ι ≫ (const J).map f.down }

/-- A map from the vertex of a cocone induces a cocone by composition. -/
@[simps] def extend (c : cocone F) {X : C} (f : c.X ⟶ X) : cocone F :=
{ X := X,
  ι := c.extensions.app X ⟨f⟩ }

/--
Whisker a cocone by precomposition of a functor. See `whiskering` for a functorial
version.
-/
@[simps] def whisker (E : K ⥤ J) (c : cocone F) : cocone (E ⋙ F) :=
{ X := c.X,
  ι := whisker_left E c.ι }

end cocone

/-- A cone morphism between two cones for the same diagram is a morphism of the cone points which
commutes with the cone legs. -/
@[ext] structure cone_morphism (A B : cone F) :=
(hom : A.X ⟶ B.X)
(w'  : ∀ j : J, hom ≫ B.π.app j = A.π.app j . obviously)

restate_axiom cone_morphism.w'
attribute [simp, reassoc] cone_morphism.w

instance inhabited_cone_morphism (A : cone F) : inhabited (cone_morphism A A) :=
⟨{ hom := 𝟙 _ }⟩

/-- The category of cones on a given diagram. -/
@[simps] instance cone.category : category (cone F) :=
{ hom  := λ A B, cone_morphism A B,
  comp := λ X Y Z f g, { hom := f.hom ≫ g.hom },
  id   := λ B, { hom := 𝟙 B.X } }

namespace cones
/-- To give an isomorphism between cones, it suffices to give an
  isomorphism between their vertices which commutes with the cone
  maps. -/
@[ext, simps] def ext {c c' : cone F}
  (φ : c.X ≅ c'.X) (w : ∀ j, c.π.app j = φ.hom ≫ c'.π.app j) : c ≅ c' :=
{ hom := { hom := φ.hom },
  inv := { hom := φ.inv, w' := λ j, φ.inv_comp_eq.mpr (w j) } }

/--
Given a cone morphism whose object part is an isomorphism, produce an
isomorphism of cones.
-/
lemma cone_iso_of_hom_iso {K : J ⥤ C} {c d : cone K} (f : c ⟶ d) [i : is_iso f.hom] :
  is_iso f :=
⟨⟨{ hom := inv f.hom,
    w' := λ j, (as_iso f.hom).inv_comp_eq.2 (f.w j).symm }, by tidy⟩⟩

/--
Functorially postcompose a cone for `F` by a natural transformation `F ⟶ G` to give a cone for `G`.
-/
@[simps] def postcompose {G : J ⥤ C} (α : F ⟶ G) : cone F ⥤ cone G :=
{ obj := λ c, { X := c.X, π := c.π ≫ α },
  map := λ c₁ c₂ f, { hom := f.hom } }

/-- Postcomposing a cone by the composite natural transformation `α ≫ β` is the same as
postcomposing by `α` and then by `β`. -/
@[simps]
def postcompose_comp {G H : J ⥤ C} (α : F ⟶ G) (β : G ⟶ H) :
  postcompose (α ≫ β) ≅ postcompose α ⋙ postcompose β :=
nat_iso.of_components (λ s, cones.ext (iso.refl _) (by tidy)) (by tidy)

/-- Postcomposing by the identity does not change the cone up to isomorphism. -/
@[simps]
def postcompose_id : postcompose (𝟙 F) ≅ 𝟭 (cone F) :=
nat_iso.of_components (λ s, cones.ext (iso.refl _) (by tidy)) (by tidy)

/--
If `F` and `G` are naturally isomorphic functors, then they have equivalent categories of
cones.
-/
@[simps]
def postcompose_equivalence {G : J ⥤ C} (α : F ≅ G) : cone F ≌ cone G :=
{ functor := postcompose α.hom,
  inverse := postcompose α.inv,
  unit_iso := nat_iso.of_components (λ s, cones.ext (iso.refl _) (by tidy)) (by tidy),
  counit_iso := nat_iso.of_components (λ s, cones.ext (iso.refl _) (by tidy)) (by tidy) }

/--
Whiskering on the left by `E : K ⥤ J` gives a functor from `cone F` to `cone (E ⋙ F)`.
-/
@[simps]
def whiskering (E : K ⥤ J) : cone F ⥤ cone (E ⋙ F) :=
{ obj := λ c, c.whisker E,
  map := λ c c' f, { hom := f.hom } }

/--
Whiskering by an equivalence gives an equivalence between categories of cones.
-/
@[simps]
def whiskering_equivalence (e : K ≌ J) :
  cone F ≌ cone (e.functor ⋙ F) :=
{ functor := whiskering e.functor,
  inverse := whiskering e.inverse ⋙ postcompose (e.inv_fun_id_assoc F).hom,
  unit_iso := nat_iso.of_components (λ s, cones.ext (iso.refl _) (by tidy)) (by tidy),
  counit_iso := nat_iso.of_components (λ s, cones.ext (iso.refl _)
  (begin
    intro k,
    dsimp, -- See library note [dsimp, simp]
    simpa [e.counit_app_functor] using s.w (e.unit_inv.app k),
  end)) (by tidy), }

/--
The categories of cones over `F` and `G` are equivalent if `F` and `G` are naturally isomorphic
(possibly after changing the indexing category by an equivalence).
-/
@[simps functor inverse unit_iso counit_iso]
def equivalence_of_reindexing {G : K ⥤ C}
  (e : K ≌ J) (α : e.functor ⋙ F ≅ G) : cone F ≌ cone G :=
(whiskering_equivalence e).trans (postcompose_equivalence α)

section
variable (F)

/-- Forget the cone structure and obtain just the cone point. -/
@[simps]
def forget : cone F ⥤ C :=
{ obj := λ t, t.X, map := λ s t f, f.hom }

variables (G : C ⥤ D)

/-- A functor `G : C ⥤ D` sends cones over `F` to cones over `F ⋙ G` functorially. -/
@[simps] def functoriality : cone F ⥤ cone (F ⋙ G) :=
{ obj := λ A,
  { X := G.obj A.X,
    π := { app := λ j, G.map (A.π.app j), naturality' := by intros; erw ←G.map_comp; tidy } },
  map := λ X Y f,
  { hom := G.map f.hom,
    w' := λ j, by simp [-cone_morphism.w, ←f.w j] } }

instance functoriality_full [full G] [faithful G] : full (functoriality F G) :=
{ preimage := λ X Y t,
  { hom := G.preimage t.hom,
    w' := λ j, G.map_injective (by simpa using t.w j) } }

instance functoriality_faithful [faithful G] : faithful (cones.functoriality F G) :=
{ map_injective' := λ X Y f g e, by { ext1, injection e, apply G.map_injective h_1 } }

/--
If `e : C ≌ D` is an equivalence of categories, then `functoriality F e.functor` induces an
equivalence between cones over `F` and cones over `F ⋙ e.functor`.
-/
@[simps]
def functoriality_equivalence (e : C ≌ D) : cone F ≌ cone (F ⋙ e.functor) :=
let f : (F ⋙ e.functor) ⋙ e.inverse ≅ F :=
  functor.associator _ _ _ ≪≫ iso_whisker_left _ (e.unit_iso).symm ≪≫ functor.right_unitor _ in
{ functor := functoriality F e.functor,
  inverse := (functoriality (F ⋙ e.functor) e.inverse) ⋙
    (postcompose_equivalence f).functor,
  unit_iso := nat_iso.of_components (λ c, cones.ext (e.unit_iso.app _) (by tidy)) (by tidy),
  counit_iso := nat_iso.of_components (λ c, cones.ext (e.counit_iso.app _) (by tidy)) (by tidy), }

/--
If `F` reflects isomorphisms, then `cones.functoriality F` reflects isomorphisms
as well.
-/
instance reflects_cone_isomorphism (F : C ⥤ D) [reflects_isomorphisms F] (K : J ⥤ C) :
  reflects_isomorphisms (cones.functoriality K F) :=
begin
  constructor,
  introsI,
  haveI : is_iso (F.map f.hom) :=
    (cones.forget (K ⋙ F)).map_is_iso ((cones.functoriality K F).map f),
  haveI := reflects_isomorphisms.reflects F f.hom,
  apply cone_iso_of_hom_iso
end

end

end cones

/-- A cocone morphism between two cocones for the same diagram is a morphism of the cocone points
which commutes with the cocone legs. -/
@[ext] structure cocone_morphism (A B : cocone F) :=
(hom : A.X ⟶ B.X)
(w'  : ∀ j : J, A.ι.app j ≫ hom = B.ι.app j . obviously)

instance inhabited_cocone_morphism (A : cocone F) : inhabited (cocone_morphism A A) :=
⟨{ hom := 𝟙 _ }⟩

restate_axiom cocone_morphism.w'
attribute [simp, reassoc] cocone_morphism.w

@[simps] instance cocone.category : category (cocone F) :=
{ hom  := λ A B, cocone_morphism A B,
  comp := λ _ _ _ f g,
  { hom := f.hom ≫ g.hom },
  id   := λ B, { hom := 𝟙 B.X } }

namespace cocones
/-- To give an isomorphism between cocones, it suffices to give an
  isomorphism between their vertices which commutes with the cocone
  maps. -/
@[ext, simps] def ext {c c' : cocone F}
  (φ : c.X ≅ c'.X) (w : ∀ j, c.ι.app j ≫ φ.hom = c'.ι.app j) : c ≅ c' :=
{ hom := { hom := φ.hom },
  inv := { hom := φ.inv, w' := λ j, φ.comp_inv_eq.mpr (w j).symm } }

/--
Given a cocone morphism whose object part is an isomorphism, produce an
isomorphism of cocones.
-/
lemma cocone_iso_of_hom_iso {K : J ⥤ C} {c d : cocone K} (f : c ⟶ d) [i : is_iso f.hom] :
  is_iso f :=
⟨⟨{ hom := inv f.hom,
    w' := λ j, (as_iso f.hom).comp_inv_eq.2 (f.w j).symm }, by tidy⟩⟩

/-- Functorially precompose a cocone for `F` by a natural transformation `G ⟶ F` to give a cocone
for `G`. -/
@[simps] def precompose {G : J ⥤ C} (α : G ⟶ F) : cocone F ⥤ cocone G :=
{ obj := λ c, { X := c.X, ι := α ≫ c.ι },
  map := λ c₁ c₂ f, { hom := f.hom } }

/-- Precomposing a cocone by the composite natural transformation `α ≫ β` is the same as
precomposing by `β` and then by `α`. -/
def precompose_comp {G H : J ⥤ C} (α : F ⟶ G) (β : G ⟶ H) :
  precompose (α ≫ β) ≅ precompose β ⋙ precompose α :=
nat_iso.of_components (λ s, cocones.ext (iso.refl _) (by tidy)) (by tidy)

/-- Precomposing by the identity does not change the cocone up to isomorphism. -/
def precompose_id : precompose (𝟙 F) ≅ 𝟭 (cocone F) :=
nat_iso.of_components (λ s, cocones.ext (iso.refl _) (by tidy)) (by tidy)

/--
If `F` and `G` are naturally isomorphic functors, then they have equivalent categories of
cocones.
-/
@[simps]
def precompose_equivalence {G : J ⥤ C} (α : G ≅ F) : cocone F ≌ cocone G :=
{ functor := precompose α.hom,
  inverse := precompose α.inv,
  unit_iso := nat_iso.of_components (λ s, cocones.ext (iso.refl _) (by tidy)) (by tidy),
  counit_iso := nat_iso.of_components (λ s, cocones.ext (iso.refl _) (by tidy)) (by tidy) }

/--
Whiskering on the left by `E : K ⥤ J` gives a functor from `cocone F` to `cocone (E ⋙ F)`.
-/
@[simps]
def whiskering (E : K ⥤ J) : cocone F ⥤ cocone (E ⋙ F) :=
{ obj := λ c, c.whisker E,
  map := λ c c' f, { hom := f.hom, } }

/--
Whiskering by an equivalence gives an equivalence between categories of cones.
-/
@[simps]
def whiskering_equivalence (e : K ≌ J) :
  cocone F ≌ cocone (e.functor ⋙ F) :=
{ functor := whiskering e.functor,
  inverse := whiskering e.inverse ⋙
    precompose ((functor.left_unitor F).inv ≫ (whisker_right (e.counit_iso).inv F) ≫
      (functor.associator _ _ _).inv),
  unit_iso := nat_iso.of_components (λ s, cocones.ext (iso.refl _) (by tidy)) (by tidy),
  counit_iso := nat_iso.of_components (λ s, cocones.ext (iso.refl _)
  (begin
    intro k,
    dsimp,
    simpa [e.counit_inv_app_functor k] using s.w (e.unit.app k),
  end)) (by tidy), }

/--
The categories of cocones over `F` and `G` are equivalent if `F` and `G` are naturally isomorphic
(possibly after changing the indexing category by an equivalence).
-/
@[simps functor_obj]
def equivalence_of_reindexing {G : K ⥤ C}
  (e : K ≌ J) (α : e.functor ⋙ F ≅ G) : cocone F ≌ cocone G :=
(whiskering_equivalence e).trans (precompose_equivalence α.symm)

section
variable (F)

/-- Forget the cocone structure and obtain just the cocone point. -/
@[simps]
def forget : cocone F ⥤ C :=
{ obj := λ t, t.X, map := λ s t f, f.hom }

variables (G : C ⥤ D)

/-- A functor `G : C ⥤ D` sends cocones over `F` to cocones over `F ⋙ G` functorially. -/
@[simps] def functoriality : cocone F ⥤ cocone (F ⋙ G) :=
{ obj := λ A,
  { X := G.obj A.X,
    ι := { app := λ j, G.map (A.ι.app j), naturality' := by intros; erw ←G.map_comp; tidy } },
  map := λ _ _ f,
  { hom := G.map f.hom,
    w'  := by intros; rw [←functor.map_comp, cocone_morphism.w] } }

instance functoriality_full [full G] [faithful G] : full (functoriality F G) :=
{ preimage := λ X Y t,
  { hom := G.preimage t.hom,
    w' := λ j, G.map_injective (by simpa using t.w j) } }

instance functoriality_faithful [faithful G] : faithful (functoriality F G) :=
{ map_injective' := λ X Y f g e, by { ext1, injection e, apply G.map_injective h_1 } }

/--
If `e : C ≌ D` is an equivalence of categories, then `functoriality F e.functor` induces an
equivalence between cocones over `F` and cocones over `F ⋙ e.functor`.
-/
@[simps]
def functoriality_equivalence (e : C ≌ D) : cocone F ≌ cocone (F ⋙ e.functor) :=
let f : (F ⋙ e.functor) ⋙ e.inverse ≅ F :=
  functor.associator _ _ _ ≪≫ iso_whisker_left _ (e.unit_iso).symm ≪≫ functor.right_unitor _ in
{ functor := functoriality F e.functor,
  inverse := (functoriality (F ⋙ e.functor) e.inverse) ⋙
    (precompose_equivalence f.symm).functor,
  unit_iso := nat_iso.of_components (λ c, cocones.ext (e.unit_iso.app _) (by tidy)) (by tidy),
  counit_iso := nat_iso.of_components (λ c, cocones.ext (e.counit_iso.app _)
  begin
    -- Unfortunately this doesn't work by `tidy`.
    -- In this configuration `simp` reaches a dead-end and needs help.
    intros j,
    dsimp,
    simp only [←equivalence.counit_inv_app_functor, iso.inv_hom_id_app, map_comp,
      equivalence.fun_inv_map, assoc, id_comp, iso.inv_hom_id_app_assoc],
    dsimp, simp, -- See note [dsimp, simp].
  end)
  (λ c c' f, by { ext, dsimp, simp, dsimp, simp, }), }

/--
If `F` reflects isomorphisms, then `cocones.functoriality F` reflects isomorphisms
as well.
-/
instance reflects_cocone_isomorphism (F : C ⥤ D) [reflects_isomorphisms F] (K : J ⥤ C) :
  reflects_isomorphisms (cocones.functoriality K F) :=
begin
  constructor,
  introsI,
  haveI : is_iso (F.map f.hom) :=
    (cocones.forget (K ⋙ F)).map_is_iso ((cocones.functoriality K F).map f),
  haveI := reflects_isomorphisms.reflects F f.hom,
  apply cocone_iso_of_hom_iso
end

end
end cocones

end limits

namespace functor

variables {F : J ⥤ C} {G : J ⥤ C} (H : C ⥤ D)

open category_theory.limits

/-- The image of a cone in C under a functor G : C ⥤ D is a cone in D. -/
@[simps]
def map_cone   (c : cone F)   : cone (F ⋙ H)   := (cones.functoriality F H).obj c
/-- The image of a cocone in C under a functor G : C ⥤ D is a cocone in D. -/
@[simps]
def map_cocone (c : cocone F) : cocone (F ⋙ H) := (cocones.functoriality F H).obj c

/-- Given a cone morphism `c ⟶ c'`, construct a cone morphism on the mapped cones functorially.  -/
def map_cone_morphism   {c c' : cone F}   (f : c ⟶ c')   :
  H.map_cone c ⟶ H.map_cone c' := (cones.functoriality F H).map f

/-- Given a cocone morphism `c ⟶ c'`, construct a cocone morphism on the mapped cocones
functorially. -/
def map_cocone_morphism {c c' : cocone F} (f : c ⟶ c') :
  H.map_cocone c ⟶ H.map_cocone c' := (cocones.functoriality F H).map f

/-- If `H` is an equivalence, we invert `H.map_cone` and get a cone for `F` from a cone
for `F ⋙ H`.-/
def map_cone_inv [is_equivalence H]
  (c : cone (F ⋙ H)) : cone F :=
(limits.cones.functoriality_equivalence F (as_equivalence H)).inverse.obj c

/-- `map_cone` is the left inverse to `map_cone_inv`. -/
def map_cone_map_cone_inv {F : J ⥤ D} (H : D ⥤ C) [is_equivalence H] (c : cone (F ⋙ H)) :
  map_cone H (map_cone_inv H c) ≅ c :=
(limits.cones.functoriality_equivalence F (as_equivalence H)).counit_iso.app c

/-- `map_cone` is the right inverse to `map_cone_inv`. -/
def map_cone_inv_map_cone {F : J ⥤ D} (H : D ⥤ C) [is_equivalence H] (c : cone F) :
  map_cone_inv H (map_cone H c) ≅ c :=
(limits.cones.functoriality_equivalence F (as_equivalence H)).unit_iso.symm.app c
/-- If `H` is an equivalence, we invert `H.map_cone` and get a cone for `F` from a cone
for `F ⋙ H`.-/

def map_cocone_inv [is_equivalence H]
  (c : cocone (F ⋙ H)) : cocone F :=
(limits.cocones.functoriality_equivalence F (as_equivalence H)).inverse.obj c

/-- `map_cocone` is the left inverse to `map_cocone_inv`. -/
def map_cocone_map_cocone_inv {F : J ⥤ D} (H : D ⥤ C) [is_equivalence H] (c : cocone (F ⋙ H)) :
  map_cocone H (map_cocone_inv H c) ≅ c :=
(limits.cocones.functoriality_equivalence F (as_equivalence H)).counit_iso.app c

/-- `map_cocone` is the right inverse to `map_cocone_inv`. -/
def map_cocone_inv_map_cocone {F : J ⥤ D} (H : D ⥤ C) [is_equivalence H] (c : cocone F) :
  map_cocone_inv H (map_cocone H c) ≅ c :=
(limits.cocones.functoriality_equivalence F (as_equivalence H)).unit_iso.symm.app c

/-- `functoriality F _ ⋙ postcompose (whisker_left F _)` simplifies to `functoriality F _`. -/
@[simps]
def functoriality_comp_postcompose {H H' : C ⥤ D} (α : H ≅ H') :
  cones.functoriality F H ⋙ cones.postcompose (whisker_left F α.hom) ≅ cones.functoriality F H' :=
nat_iso.of_components (λ c, cones.ext (α.app _) (by tidy)) (by tidy)

/--
For `F : J ⥤ C`, given a cone `c : cone F`, and a natural isomorphism `α : H ≅ H'` for functors
`H H' : C ⥤ D`, the postcomposition of the cone `H.map_cone` using the isomorphism `α` is
isomorphic to the cone `H'.map_cone`.
-/
@[simps]
def postcompose_whisker_left_map_cone {H H' : C ⥤ D} (α : H ≅ H') (c : cone F) :
  (cones.postcompose (whisker_left F α.hom : _)).obj (H.map_cone c) ≅ H'.map_cone c :=
(functoriality_comp_postcompose α).app c

/--
`map_cone` commutes with `postcompose`. In particular, for `F : J ⥤ C`, given a cone `c : cone F`, a
natural transformation `α : F ⟶ G` and a functor `H : C ⥤ D`, we have two obvious ways of producing
a cone over `G ⋙ H`, and they are both isomorphic.
-/
@[simps]
def map_cone_postcompose {α : F ⟶ G} {c} :
  H.map_cone ((cones.postcompose α).obj c) ≅
  (cones.postcompose (whisker_right α H : _)).obj (H.map_cone c) :=
cones.ext (iso.refl _) (by tidy)

/--
`map_cone` commutes with `postcompose_equivalence`
-/
@[simps]
def map_cone_postcompose_equivalence_functor {α : F ≅ G} {c} :
  H.map_cone ((cones.postcompose_equivalence α).functor.obj c) ≅
    (cones.postcompose_equivalence (iso_whisker_right α H : _)).functor.obj (H.map_cone c) :=
cones.ext (iso.refl _) (by tidy)

/-- `functoriality F _ ⋙ precompose (whisker_left F _)` simplifies to `functoriality F _`. -/
@[simps]
def functoriality_comp_precompose {H H' : C ⥤ D} (α : H ≅ H') :
   cocones.functoriality F H ⋙ cocones.precompose (whisker_left F α.inv)
 ≅ cocones.functoriality F H' :=
nat_iso.of_components (λ c, cocones.ext (α.app _) (by tidy)) (by tidy)

/--
For `F : J ⥤ C`, given a cocone `c : cocone F`, and a natural isomorphism `α : H ≅ H'` for functors
`H H' : C ⥤ D`, the precomposition of the cocone `H.map_cocone` using the isomorphism `α` is
isomorphic to the cocone `H'.map_cocone`.
-/
@[simps]
def precompose_whisker_left_map_cocone {H H' : C ⥤ D} (α : H ≅ H') (c : cocone F) :
  (cocones.precompose (whisker_left F α.inv : _)).obj (H.map_cocone c) ≅ H'.map_cocone c :=
(functoriality_comp_precompose α).app c

/--
`map_cocone` commutes with `precompose`. In particular, for `F : J ⥤ C`, given a cocone
`c : cocone F`, a natural transformation `α : F ⟶ G` and a functor `H : C ⥤ D`, we have two obvious
ways of producing a cocone over `G ⋙ H`, and they are both isomorphic.
-/
@[simps]
def map_cocone_precompose {α : F ⟶ G} {c} :
  H.map_cocone ((cocones.precompose α).obj c) ≅
  (cocones.precompose (whisker_right α H : _)).obj (H.map_cocone c) :=
cocones.ext (iso.refl _) (by tidy)

/--
`map_cocone` commutes with `precompose_equivalence`
-/
@[simps]
def map_cocone_precompose_equivalence_functor {α : F ≅ G} {c} :
  H.map_cocone ((cocones.precompose_equivalence α).functor.obj c) ≅
    (cocones.precompose_equivalence (iso_whisker_right α H : _)).functor.obj (H.map_cocone c) :=
cocones.ext (iso.refl _) (by tidy)

/--
`map_cone` commutes with `whisker`
-/
@[simps]
def map_cone_whisker {E : K ⥤ J} {c : cone F} :
  H.map_cone (c.whisker E) ≅ (H.map_cone c).whisker E :=
cones.ext (iso.refl _) (by tidy)

/--
`map_cocone` commutes with `whisker`
-/
@[simps]
def map_cocone_whisker {E : K ⥤ J} {c : cocone F} :
  H.map_cocone (c.whisker E) ≅ (H.map_cocone c).whisker E :=
cocones.ext (iso.refl _) (by tidy)

end functor

end category_theory

namespace category_theory.limits

section
variables {F : J ⥤ C}

/-- Change a `cocone F` into a `cone F.op`. -/
@[simps] def cocone.op (c : cocone F) : cone F.op :=
{ X := op c.X,
  π :=
  { app := λ j, (c.ι.app (unop j)).op,
    naturality' := λ j j' f, quiver.hom.unop_inj (by tidy) } }

/-- Change a `cone F` into a `cocone F.op`. -/
@[simps] def cone.op (c : cone F) : cocone F.op :=
{ X := op c.X,
  ι :=
  { app := λ j, (c.π.app (unop j)).op,
    naturality' := λ j j' f, quiver.hom.unop_inj (by tidy) } }

/-- Change a `cocone F.op` into a `cone F`. -/
@[simps] def cocone.unop (c : cocone F.op) : cone F :=
{ X := unop c.X,
  π :=
  { app := λ j, (c.ι.app (op j)).unop,
    naturality' := λ j j' f, quiver.hom.op_inj (c.ι.naturality f.op).symm } }

/-- Change a `cone F.op` into a `cocone F`. -/
@[simps] def cone.unop (c : cone F.op) : cocone F :=
{ X := unop c.X,
  ι :=
  { app := λ j, (c.π.app (op j)).unop,
    naturality' := λ j j' f, quiver.hom.op_inj (c.π.naturality f.op).symm } }

variables (F)

/--
The category of cocones on `F`
is equivalent to the opposite category of
the category of cones on the opposite of `F`.
-/
@[simps]
def cocone_equivalence_op_cone_op : cocone F ≌ (cone F.op)ᵒᵖ :=
{ functor :=
  { obj := λ c, op (cocone.op c),
    map := λ X Y f, quiver.hom.op
    { hom := f.hom.op,
      w' := λ j, by { apply quiver.hom.unop_inj, dsimp, simp, }, } },
  inverse :=
  { obj := λ c, cone.unop (unop c),
    map := λ X Y f,
    { hom := f.unop.hom.unop,
      w' := λ j, by { apply quiver.hom.op_inj, dsimp, simp, }, } },
  unit_iso := nat_iso.of_components (λ c, cocones.ext (iso.refl _) (by tidy)) (by tidy),
  counit_iso := nat_iso.of_components (λ c,
    by { induction c using opposite.rec,
         dsimp, apply iso.op, exact cones.ext (iso.refl _) (by tidy), })
    begin
      intros,
      have hX : X = op (unop X) := rfl,
      revert hX,
      generalize : unop X = X',
      rintro rfl,
      have hY : Y = op (unop Y) := rfl,
      revert hY,
      generalize : unop Y = Y',
      rintro rfl,
      apply quiver.hom.unop_inj,
      apply cone_morphism.ext,
      dsimp, simp,
    end,
  functor_unit_iso_comp' := λ c, begin apply quiver.hom.unop_inj, ext, dsimp, simp, end }

end

section
variables {F : J ⥤ Cᵒᵖ}

/-- Change a cocone on `F.left_op : Jᵒᵖ ⥤ C` to a cocone on `F : J ⥤ Cᵒᵖ`. -/
-- Here and below we only automatically generate the `@[simp]` lemma for the `X` field,
-- as we can write a simpler `rfl` lemma for the components of the natural transformation by hand.
@[simps {rhs_md := semireducible, simp_rhs := tt}]
def cone_of_cocone_left_op (c : cocone F.left_op) : cone F :=
{ X := op c.X,
  π := nat_trans.remove_left_op (c.ι ≫ (const.op_obj_unop (op c.X)).hom) }

/-- Change a cone on `F : J ⥤ Cᵒᵖ` to a cocone on `F.left_op : Jᵒᵖ ⥤ C`. -/
@[simps {rhs_md := semireducible, simp_rhs := tt}]
def cocone_left_op_of_cone (c : cone F) : cocone (F.left_op) :=
{ X := unop c.X,
  ι := nat_trans.left_op c.π }

/-- Change a cone on `F.left_op : Jᵒᵖ ⥤ C` to a cocone on `F : J ⥤ Cᵒᵖ`. -/
/- When trying use `@[simps]` to generate the `ι_app` field of this definition, `@[simps]` tries to
  reduce the RHS using `expr.dsimp` and `expr.simp`, but for some reason the expression is not
  being simplified properly. -/
@[simps X]
def cocone_of_cone_left_op (c : cone F.left_op) : cocone F :=
{ X := op c.X,
  ι := nat_trans.remove_left_op ((const.op_obj_unop (op c.X)).hom ≫ c.π) }

@[simp] lemma cocone_of_cone_left_op_ι_app (c : cone F.left_op) (j) :
  (cocone_of_cone_left_op c).ι.app j = (c.π.app (op j)).op :=
by { dsimp [cocone_of_cone_left_op], simp }

/-- Change a cocone on `F : J ⥤ Cᵒᵖ` to a cone on `F.left_op : Jᵒᵖ ⥤ C`. -/
@[simps {rhs_md := semireducible, simp_rhs := tt}]
def cone_left_op_of_cocone (c : cocone F) : cone (F.left_op) :=
{ X := unop c.X,
  π := nat_trans.left_op c.ι }

end

end category_theory.limits

namespace category_theory.functor

open category_theory.limits

variables {F : J ⥤ C}

section
variables (G : C ⥤ D)

/-- The opposite cocone of the image of a cone is the image of the opposite cocone. -/
@[simps {rhs_md := semireducible}]
def map_cone_op (t : cone F) : (G.map_cone t).op ≅ (G.op.map_cocone t.op) :=
cocones.ext (iso.refl _) (by tidy)

/-- The opposite cone of the image of a cocone is the image of the opposite cone. -/
@[simps {rhs_md := semireducible}]
def map_cocone_op {t : cocone F} : (G.map_cocone t).op ≅ (G.op.map_cone t.op) :=
cones.ext (iso.refl _) (by tidy)

end

end category_theory.functor