/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.category.Group.basic
import category_theory.single_obj
import category_theory.limits.functor_category
import category_theory.limits.preserves.basic
import category_theory.adjunction.limits
import category_theory.monoidal.functor_category
import category_theory.monoidal.transport
import category_theory.monoidal.rigid.of_equivalence
import category_theory.monoidal.rigid.functor_category
import category_theory.monoidal.linear
import category_theory.monoidal.braided
import category_theory.monoidal.types
import category_theory.abelian.functor_category
import category_theory.abelian.transfer
import category_theory.conj
import category_theory.linear.functor_category

/-!
# `Action V G`, the category of actions of a monoid `G` inside some category `V`.

The prototypical example is `V = Module R`,
where `Action (Module R) G` is the category of `R`-linear representations of `G`.

We check `Action V G ≌ (single_obj G ⥤ V)`,
and construct the restriction functors `res {G H : Mon} (f : G ⟶ H) : Action V H ⥤ Action V G`.

* When `V` has (co)limits so does `Action V G`.
* When `V` is monoidal, braided, or symmetric, so is `Action V G`.
* When `V` is preadditive, linear, or abelian so is `Action V G`.
-/

universes u v

open category_theory
open category_theory.limits

variables (V : Type (u+1)) [large_category V]

/--
An `Action V G` represents a bundled action of
the monoid `G` on an object of some category `V`.

As an example, when `V = Module R`, this is an `R`-linear representation of `G`,
while when `V = Type` this is a `G`-action.
-/
-- Note: this is _not_ a categorical action of `G` on `V`.
structure Action (G : Mon.{u}) :=
(V : V)
(ρ : G ⟶ Mon.of (End V))

namespace Action
variable {V}

@[simp]
lemma ρ_one {G : Mon.{u}} (A : Action V G) : A.ρ 1 = 𝟙 A.V :=
by { rw [monoid_hom.map_one], refl, }

/-- When a group acts, we can lift the action to the group of automorphisms. -/
@[simps]
def ρ_Aut {G : Group.{u}} (A : Action V (Mon.of G)) : G ⟶ Group.of (Aut A.V) :=
{ to_fun := λ g,
  { hom := A.ρ g,
    inv := A.ρ (g⁻¹ : G),
    hom_inv_id' := ((A.ρ).map_mul (g⁻¹ : G) g).symm.trans (by rw [inv_mul_self, ρ_one]),
    inv_hom_id' := ((A.ρ).map_mul g (g⁻¹ : G)).symm.trans (by rw [mul_inv_self, ρ_one]), },
  map_one' := by { ext, exact A.ρ.map_one },
  map_mul' := λ x y, by { ext, exact A.ρ.map_mul x y }, }

variable (G : Mon.{u})

section

instance inhabited' : inhabited (Action (Type u) G) := ⟨⟨punit, 1⟩⟩

/-- The trivial representation of a group. -/
def trivial : Action AddCommGroup G :=
{ V := AddCommGroup.of punit,
  ρ := 1, }

instance : inhabited (Action AddCommGroup G) := ⟨trivial G⟩
end

variables {G V}

/--
A homomorphism of `Action V G`s is a morphism between the underlying objects,
commuting with the action of `G`.
-/
@[ext]
structure hom (M N : Action V G) :=
(hom : M.V ⟶ N.V)
(comm' : ∀ g : G, M.ρ g ≫ hom = hom ≫ N.ρ g . obviously)

restate_axiom hom.comm'

namespace hom

/-- The identity morphism on a `Action V G`. -/
@[simps]
def id (M : Action V G) : Action.hom M M :=
{ hom := 𝟙 M.V }

instance (M : Action V G) : inhabited (Action.hom M M) := ⟨id M⟩

/--
The composition of two `Action V G` homomorphisms is the composition of the underlying maps.
-/
@[simps]
def comp {M N K : Action V G} (p : Action.hom M N) (q : Action.hom N K) :
  Action.hom M K :=
{ hom := p.hom ≫ q.hom,
  comm' := λ g, by rw [←category.assoc, p.comm, category.assoc, q.comm, ←category.assoc] }

end hom

instance : category (Action V G) :=
{ hom := λ M N, hom M N,
  id := λ M, hom.id M,
  comp := λ M N K f g, hom.comp f g, }

@[simp]
lemma id_hom (M : Action V G) : (𝟙 M : hom M M).hom = 𝟙 M.V := rfl
@[simp]
lemma comp_hom {M N K : Action V G} (f : M ⟶ N) (g : N ⟶ K) :
  (f ≫ g : hom M K).hom = f.hom ≫ g.hom :=
rfl

/-- Construct an isomorphism of `G` actions/representations
from an isomorphism of the the underlying objects,
where the forward direction commutes with the group action. -/
@[simps]
def mk_iso {M N : Action V G} (f : M.V ≅ N.V) (comm : ∀ g : G, M.ρ g ≫ f.hom = f.hom ≫ N.ρ g) :
  M ≅ N :=
{ hom :=
  { hom := f.hom,
    comm' := comm, },
  inv :=
  { hom := f.inv,
    comm' := λ g, by { have w := comm g =≫ f.inv, simp at w, simp [w], }, }}

@[priority 100]
instance is_iso_of_hom_is_iso {M N : Action V G} (f : M ⟶ N) [is_iso f.hom] : is_iso f :=
by { convert is_iso.of_iso (mk_iso (as_iso f.hom) f.comm), ext, refl, }

instance is_iso_hom_mk {M N : Action V G} (f : M.V ⟶ N.V) [is_iso f] (w) :
  @is_iso _ _ M N ⟨f, w⟩ :=
is_iso.of_iso (mk_iso (as_iso f) w)

namespace functor_category_equivalence

/-- Auxilliary definition for `functor_category_equivalence`. -/
@[simps]
def functor : Action V G ⥤ (single_obj G ⥤ V) :=
{ obj := λ M,
  { obj := λ _, M.V,
    map := λ _ _ g, M.ρ g,
    map_id' := λ _, M.ρ.map_one,
    map_comp' := λ _ _ _ g h, M.ρ.map_mul h g, },
  map := λ M N f,
  { app := λ _, f.hom,
    naturality' := λ _ _ g, f.comm g, } }

/-- Auxilliary definition for `functor_category_equivalence`. -/
@[simps]
def inverse : (single_obj G ⥤ V) ⥤ Action V G :=
{ obj := λ F,
  { V := F.obj punit.star,
    ρ :=
    { to_fun := λ g, F.map g,
      map_one' := F.map_id punit.star,
      map_mul' := λ g h, F.map_comp h g, } },
  map := λ M N f,
  { hom := f.app punit.star,
    comm' := λ g, f.naturality g, } }.

/-- Auxilliary definition for `functor_category_equivalence`. -/
@[simps]
def unit_iso : 𝟭 (Action V G) ≅ functor ⋙ inverse :=
nat_iso.of_components (λ M, mk_iso ((iso.refl _)) (by tidy)) (by tidy).

/-- Auxilliary definition for `functor_category_equivalence`. -/
@[simps]
def counit_iso : inverse ⋙ functor ≅ 𝟭 (single_obj G ⥤ V) :=
nat_iso.of_components (λ M, nat_iso.of_components (by tidy) (by tidy)) (by tidy).

end functor_category_equivalence

section
open functor_category_equivalence

variables (V G)

/--
The category of actions of `G` in the category `V`
is equivalent to the functor category `single_obj G ⥤ V`.
-/
def functor_category_equivalence : Action V G ≌ (single_obj G ⥤ V) :=
{ functor := functor,
  inverse := inverse,
  unit_iso := unit_iso,
  counit_iso := counit_iso, }

attribute [simps] functor_category_equivalence

lemma functor_category_equivalence.functor_def :
  (functor_category_equivalence V G).functor = functor_category_equivalence.functor := rfl

lemma functor_category_equivalence.inverse_def :
  (functor_category_equivalence V G).inverse = functor_category_equivalence.inverse := rfl

instance [has_finite_products V] : has_finite_products (Action V G) :=
{ out := λ n, adjunction.has_limits_of_shape_of_equivalence
    (Action.functor_category_equivalence _ _).functor }

instance [has_finite_limits V] : has_finite_limits (Action V G) :=
{ out := λ J _ _, by exactI adjunction.has_limits_of_shape_of_equivalence
    (Action.functor_category_equivalence _ _).functor }

instance [has_limits V] : has_limits (Action V G) :=
adjunction.has_limits_of_equivalence (Action.functor_category_equivalence _ _).functor

instance [has_colimits V] : has_colimits (Action V G) :=
adjunction.has_colimits_of_equivalence (Action.functor_category_equivalence _ _).functor

end

section forget

variables (V G)

/-- (implementation) The forgetful functor from bundled actions to the underlying objects.

Use the `category_theory.forget` API provided by the `concrete_category` instance below,
rather than using this directly.
-/
@[simps]
def forget : Action V G ⥤ V :=
{ obj := λ M, M.V,
  map := λ M N f, f.hom, }

instance : faithful (forget V G) :=
{ map_injective' := λ X Y f g w, hom.ext _ _ w, }

instance [concrete_category V] : concrete_category (Action V G) :=
{ forget := forget V G ⋙ (concrete_category.forget V), }

instance has_forget_to_V [concrete_category V] : has_forget₂ (Action V G) V :=
{ forget₂ := forget V G }

/-- The forgetful functor is intertwined by `functor_category_equivalence` with
evaluation at `punit.star`. -/
def functor_category_equivalence_comp_evaluation :
  (functor_category_equivalence V G).functor ⋙ (evaluation _ _).obj punit.star ≅ forget V G :=
iso.refl _

noncomputable instance [has_limits V] : limits.preserves_limits (forget V G) :=
limits.preserves_limits_of_nat_iso
  (Action.functor_category_equivalence_comp_evaluation V G)

noncomputable instance [has_colimits V] : preserves_colimits (forget V G) :=
preserves_colimits_of_nat_iso
  (Action.functor_category_equivalence_comp_evaluation V G)

-- TODO construct categorical images?

end forget

lemma iso.conj_ρ {M N : Action V G} (f : M ≅ N) (g : G) :
   N.ρ g = (((forget V G).map_iso f).conj (M.ρ g)) :=
by { rw [iso.conj_apply, iso.eq_inv_comp], simp [f.hom.comm'] }

section has_zero_morphisms
variables [has_zero_morphisms V]

instance : has_zero_morphisms (Action V G) :=
{ has_zero := λ X Y, ⟨⟨0, by { intro g, simp }⟩⟩,
  comp_zero' := λ P Q f R, by { ext1, simp },
  zero_comp' := λ P Q R f, by { ext1, simp }, }

instance forget_preserves_zero_morphisms : functor.preserves_zero_morphisms (forget V G) := {}
instance forget₂_preserves_zero_morphisms [concrete_category V] :
  functor.preserves_zero_morphisms (forget₂ (Action V G) V) := {}
instance functor_category_equivalence_preserves_zero_morphisms :
  functor.preserves_zero_morphisms (functor_category_equivalence V G).functor := {}

end has_zero_morphisms

section preadditive
variables [preadditive V]

instance : preadditive (Action V G) :=
{ hom_group := λ X Y,
  { zero := ⟨0, by simp⟩,
    add := λ f g, ⟨f.hom + g.hom, by simp [f.comm, g.comm]⟩,
    neg := λ f, ⟨-f.hom, by simp [f.comm]⟩,
    zero_add := by { intros, ext, exact zero_add _, },
    add_zero := by { intros, ext, exact add_zero _, },
    add_assoc := by { intros, ext, exact add_assoc _ _ _, },
    add_left_neg := by { intros, ext, exact add_left_neg _, },
    add_comm := by { intros, ext, exact add_comm _ _, }, },
  add_comp' := by { intros, ext, exact preadditive.add_comp _ _ _ _ _ _, },
  comp_add' := by { intros, ext, exact preadditive.comp_add _ _ _ _ _ _, }, }

instance forget_additive :
  functor.additive (forget V G) := {}
instance forget₂_additive [concrete_category V] :
  functor.additive (forget₂ (Action V G) V) := {}
instance functor_category_equivalence_additive :
  functor.additive (functor_category_equivalence V G).functor := {}

@[simp] lemma zero_hom {X Y : Action V G} : (0 : X ⟶ Y).hom = 0 := rfl
@[simp] lemma neg_hom {X Y : Action V G} (f : X ⟶ Y) : (-f).hom = -f.hom := rfl
@[simp] lemma add_hom {X Y : Action V G} (f g : X ⟶ Y) : (f + g).hom = f.hom + g.hom := rfl
@[simp] lemma sum_hom {X Y : Action V G} {ι : Type*} (f : ι → (X ⟶ Y)) (s : finset ι) :
  (s.sum f).hom = s.sum (λ i, (f i).hom) := (forget V G).map_sum f s

end preadditive

section linear
variables [preadditive V] {R : Type*} [semiring R] [linear R V]

instance : linear R (Action V G) :=
{ hom_module := λ X Y,
  { smul := λ r f, ⟨r • f.hom, by simp [f.comm]⟩,
    one_smul := by { intros, ext, exact one_smul _ _, },
    smul_zero := by { intros, ext, exact smul_zero _, },
    zero_smul := by { intros, ext, exact zero_smul _ _, },
    add_smul := by { intros, ext, exact add_smul _ _ _, },
    smul_add := by { intros, ext, exact smul_add _ _ _, },
    mul_smul := by { intros, ext, exact mul_smul _ _ _, }, },
  smul_comp' := by { intros, ext, exact linear.smul_comp _ _ _ _ _ _, },
  comp_smul' := by { intros, ext, exact linear.comp_smul _ _ _ _ _ _, }, }

instance forget_linear :
  functor.linear R (forget V G) := {}
instance forget₂_linear [concrete_category V] :
  functor.linear R (forget₂ (Action V G) V) := {}
instance functor_category_equivalence_linear :
  functor.linear R (functor_category_equivalence V G).functor := {}

@[simp] lemma smul_hom {X Y : Action V G} (r : R) (f : X ⟶ Y) : (r • f).hom = r • f.hom := rfl

end linear

section abelian
/-- Auxilliary construction for the `abelian (Action V G)` instance. -/
def abelian_aux : Action V G ≌ (ulift.{u} (single_obj G) ⥤ V) :=
(functor_category_equivalence V G).trans (equivalence.congr_left ulift.equivalence)

noncomputable instance [abelian V] : abelian (Action V G) :=
abelian_of_equivalence abelian_aux.functor

end abelian

section monoidal
variables [monoidal_category V]

instance : monoidal_category (Action V G) :=
monoidal.transport (Action.functor_category_equivalence _ _).symm

@[simp] lemma tensor_unit_V : (𝟙_ (Action V G)).V = 𝟙_ V := rfl
@[simp]

/-- Given an object `X` isomorphic to the tensor unit of `V`, `X` equipped with the trivial action
is isomorphic to the tensor unit of `Action V G`. -/
def tensor_unit_iso {X : V} (f : 𝟙_ V ≅ X) :
  𝟙_ (Action V G) ≅ Action.mk X 1 :=
Action.mk_iso f (λ g, by simp only [monoid_hom.one_apply, End.one_def, category.id_comp f.hom,
  tensor_unit_rho, category.comp_id])

variables (V G)

/-- When `V` is monoidal the forgetful functor `Action V G` to `V` is monoidal. -/
@[simps]
def forget_monoidal : monoidal_functor (Action V G) V :=
{ ε := 𝟙 _,
  μ := λ X Y, 𝟙 _,
  ..Action.forget _ _, }

instance forget_monoidal_faithful : faithful (forget_monoidal V G).to_functor :=
by { change faithful (forget V G), apply_instance, }

section
variables [braided_category V]

instance : braided_category (Action V G) :=
braided_category_of_faithful (forget_monoidal V G) (λ X Y, mk_iso (β_ _ _) (by tidy)) (by tidy)

/-- When `V` is braided the forgetful functor `Action V G` to `V` is braided. -/
@[simps]
def forget_braided : braided_functor (Action V G) V :=
{ ..forget_monoidal _ _, }

instance forget_braided_faithful : faithful (forget_braided V G).to_functor :=
by { change faithful (forget V G), apply_instance, }

end

instance [symmetric_category V] : symmetric_category (Action V G) :=
symmetric_category_of_faithful (forget_braided V G)

section
variables [preadditive V] [monoidal_preadditive V]

local attribute [simp] monoidal_preadditive.tensor_add monoidal_preadditive.add_tensor

instance : monoidal_preadditive (Action V G) := {}

variables {R : Type*} [semiring R] [linear R V] [monoidal_linear R V]

instance : monoidal_linear R (Action V G) := {}

end

variables (V G)
noncomputable theory

/-- Upgrading the functor `Action V G ⥤ (single_obj G ⥤ V)` to a monoidal functor. -/
def functor_category_monoidal_equivalence : monoidal_functor (Action V G) (single_obj G ⥤ V) :=
monoidal.from_transported (Action.functor_category_equivalence _ _).symm

instance : is_equivalence ((functor_category_monoidal_equivalence V G).to_functor) :=
by { change is_equivalence (Action.functor_category_equivalence _ _).functor, apply_instance, }

@[simp] lemma functor_category_monoidal_equivalence.μ_app (A B : Action V G) :
  ((functor_category_monoidal_equivalence V G).μ A B).app punit.star = 𝟙 _ :=
begin
  dunfold functor_category_monoidal_equivalence,
  simp only [monoidal.from_transported_to_lax_monoidal_functor_μ],
  show (𝟙 A.V ⊗ 𝟙 B.V) ≫ 𝟙 (A.V ⊗ B.V) ≫ (𝟙 A.V ⊗ 𝟙 B.V) = 𝟙 (A.V ⊗ B.V),
  simp only [monoidal_category.tensor_id, category.comp_id],
end

@[simp] lemma functor_category_monoidal_equivalence.μ_iso_inv_app (A B : Action V G) :
  ((functor_category_monoidal_equivalence V G).μ_iso A B).inv.app punit.star = 𝟙 _ :=
begin
  rw [←nat_iso.app_inv, ←is_iso.iso.inv_hom],
  refine is_iso.inv_eq_of_hom_inv_id _,
  rw [category.comp_id, nat_iso.app_hom, monoidal_functor.μ_iso_hom,
    functor_category_monoidal_equivalence.μ_app],
end

@[simp] lemma functor_category_monoidal_equivalence.ε_app :
  (functor_category_monoidal_equivalence V G).ε.app punit.star = 𝟙 _ :=
begin
  dunfold functor_category_monoidal_equivalence,
  simp only [monoidal.from_transported_to_lax_monoidal_functor_ε],
  show 𝟙 (monoidal_category.tensor_unit V) ≫ _ = 𝟙 (monoidal_category.tensor_unit V),
  rw [nat_iso.is_iso_inv_app, category.id_comp],
  exact is_iso.inv_id,
end

@[simp] lemma functor_category_monoidal_equivalence.inv_counit_app_hom (A : Action V G) :
  ((functor_category_monoidal_equivalence _ _).inv.adjunction.counit.app A).hom = 𝟙 _ :=
rfl

@[simp] lemma functor_category_monoidal_equivalence.counit_app (A : single_obj G ⥤ V) :
  ((functor_category_monoidal_equivalence _ _).adjunction.counit.app A).app punit.star = 𝟙 _ := rfl

@[simp] lemma functor_category_monoidal_equivalence.inv_unit_app_app
  (A : single_obj G ⥤ V) :
  ((functor_category_monoidal_equivalence _ _).inv.adjunction.unit.app A).app
  punit.star = 𝟙 _ := rfl

@[simp] lemma functor_category_monoidal_equivalence.unit_app_hom (A : Action V G) :
  ((functor_category_monoidal_equivalence _ _).adjunction.unit.app A).hom = 𝟙 _ :=
rfl

@[simp] lemma functor_category_monoidal_equivalence.functor_map {A B : Action V G} (f : A ⟶ B) :
  (functor_category_monoidal_equivalence _ _).map f
    = functor_category_equivalence.functor.map f := rfl

@[simp] lemma functor_category_monoidal_equivalence.inverse_map
  {A B : single_obj G ⥤ V} (f : A ⟶ B) :
  (functor_category_monoidal_equivalence _ _).inv.map f
    = functor_category_equivalence.inverse.map f := rfl

variables (H : Group.{u})

instance [right_rigid_category V] : right_rigid_category (single_obj (H : Mon.{u}) ⥤ V) :=
by { change right_rigid_category (single_obj H ⥤ V), apply_instance }

/-- If `V` is right rigid, so is `Action V G`. -/
instance [right_rigid_category V] : right_rigid_category (Action V H) :=
right_rigid_category_of_equivalence (functor_category_monoidal_equivalence V _)

instance [left_rigid_category V] : left_rigid_category (single_obj (H : Mon.{u}) ⥤ V) :=
by { change left_rigid_category (single_obj H ⥤ V), apply_instance }

/-- If `V` is left rigid, so is `Action V G`. -/
instance [left_rigid_category V] : left_rigid_category (Action V H) :=
left_rigid_category_of_equivalence (functor_category_monoidal_equivalence V _)

instance [rigid_category V] : rigid_category (single_obj (H : Mon.{u}) ⥤ V) :=
by { change rigid_category (single_obj H ⥤ V), apply_instance }

/-- If `V` is rigid, so is `Action V G`. -/
instance [rigid_category V] : rigid_category (Action V H) :=
rigid_category_of_equivalence (functor_category_monoidal_equivalence V _)

variables {V H} (X : Action V H)

@[simp] lemma right_dual_V [right_rigid_category V] : (Xᘁ).V = (X.V)ᘁ := rfl

@[simp] lemma left_dual_V [left_rigid_category V] : (ᘁX).V = ᘁ(X.V) := rfl

@[simp] lemma right_dual_ρ [right_rigid_category V] (h : H) : (Xᘁ).ρ h = (X.ρ (h⁻¹ : H))ᘁ :=
by { rw ←single_obj.inv_as_inv, refl }

@[simp] lemma left_dual_ρ [left_rigid_category V] (h : H) : (ᘁX).ρ h = ᘁ(X.ρ (h⁻¹ : H)) :=
by { rw ←single_obj.inv_as_inv, refl }

end monoidal

/-- Actions/representations of the trivial group are just objects in the ambient category. -/
def Action_punit_equivalence : Action V (Mon.of punit) ≌ V :=
{ functor := forget V _,
  inverse :=
  { obj := λ X, ⟨X, 1⟩,
    map := λ X Y f, ⟨f, λ ⟨⟩, by simp⟩, },
  unit_iso := nat_iso.of_components (λ X, mk_iso (iso.refl _) (λ ⟨⟩, by simpa using ρ_one X))
    (by tidy),
  counit_iso := nat_iso.of_components (λ X, iso.refl _) (by tidy), }

variables (V)
/--
The "restriction" functor along a monoid homomorphism `f : G ⟶ H`,
taking actions of `H` to actions of `G`.

(This makes sense for any homomorphism, but the name is natural when `f` is a monomorphism.)
-/
@[simps]
def res {G H : Mon} (f : G ⟶ H) : Action V H ⥤ Action V G :=
{ obj := λ M,
  { V := M.V,
    ρ := f ≫ M.ρ },
  map := λ M N p,
  { hom := p.hom,
    comm' := λ g, p.comm (f g) } }

/--
The natural isomorphism from restriction along the identity homomorphism to
the identity functor on `Action V G`.
-/
def res_id {G : Mon} : res V (𝟙 G) ≅ 𝟭 (Action V G) :=
nat_iso.of_components (λ M, mk_iso (iso.refl _) (by tidy)) (by tidy)

attribute [simps] res_id

/--
The natural isomorphism from the composition of restrictions along homomorphisms
to the restriction along the composition of homomorphism.
-/
def res_comp {G H K : Mon} (f : G ⟶ H) (g : H ⟶ K) : res V g ⋙ res V f ≅ res V (f ≫ g) :=
nat_iso.of_components (λ M, mk_iso (iso.refl _) (by tidy)) (by tidy)

attribute [simps] res_comp

-- TODO promote `res` to a pseudofunctor from
-- the locally discrete bicategory constructed from `Monᵒᵖ` to `Cat`, sending `G` to `Action V G`.

variables {G} {H : Mon.{u}} (f : G ⟶ H)

instance res_additive [preadditive V] : (res V f).additive := {}

variables {R : Type*} [semiring R]

instance res_linear [preadditive V] [linear R V] : (res V f).linear R := {}

/-- Bundles a type `H` with a multiplicative action of `G` as an `Action`. -/
def of_mul_action (G H : Type u) [monoid G] [mul_action G H] : Action (Type u) (Mon.of G) :=
{ V := H,
  ρ := @mul_action.to_End_hom _ _ _ (by assumption) }

@[simp] lemma of_mul_action_apply {G H : Type u} [monoid G] [mul_action G H] (g : G) (x : H) :
  (of_mul_action G H).ρ g x = (g • x : H) :=
rfl

/-- Given a family `F` of types with `G`-actions, this is the limit cone demonstrating that the
product of `F` as types is a product in the category of `G`-sets. -/
def of_mul_action_limit_cone {ι : Type v} (G : Type (max v u)) [monoid G]
  (F : ι → Type (max v u)) [Π i : ι, mul_action G (F i)] :
  limit_cone (discrete.functor (λ i : ι, Action.of_mul_action G (F i))) :=
{ cone :=
  { X := Action.of_mul_action G (Π i : ι, F i),
    π :=
    { app := λ i, ⟨λ x, x i.as, λ g, by ext; refl⟩,
      naturality' := λ i j x,
      begin
        ext,
        discrete_cases,
        cases x,
        congr
      end } },
  is_limit :=
  { lift := λ s,
    { hom := λ x i, (s.π.app ⟨i⟩).hom x,
      comm' := λ g,
      begin
        ext x j,
        dsimp,
        exact congr_fun ((s.π.app ⟨j⟩).comm g) x,
      end },
    fac' := λ s j,
    begin
      ext,
      dsimp,
      congr,
      rw discrete.mk_as,
    end,
    uniq' := λ s f h,
    begin
      ext x j,
      dsimp at *,
      rw ←h ⟨j⟩,
      congr,
    end } }

/-- The `G`-set `G`, acting on itself by left multiplication. -/
@[simps] def left_regular (G : Type u) [monoid G] : Action (Type u) (Mon.of G) :=
Action.of_mul_action G G

/-- The `G`-set `Gⁿ`, acting on itself by left multiplication. -/
@[simps] def diagonal (G : Type u) [monoid G] (n : ℕ) : Action (Type u) (Mon.of G) :=
Action.of_mul_action G (fin n → G)

/-- We have `fin 1 → G ≅ G` as `G`-sets, with `G` acting by left multiplication. -/
def diagonal_one_iso_left_regular (G : Type u) [monoid G] :
  diagonal G 1 ≅ left_regular G := Action.mk_iso (equiv.fun_unique _ _).to_iso (λ g, rfl)

/-- Given `X : Action (Type u) (Mon.of G)` for `G` a group, then `G × X` (with `G` acting as left
multiplication on the first factor and by `X.ρ` on the second) is isomorphic as a `G`-set to
`G × X` (with `G` acting as left multiplication on the first factor and trivially on the second).
The isomorphism is given by `(g, x) ↦ (g, g⁻¹ • x)`. -/
@[simps] def left_regular_tensor_iso (G : Type u) [group G]
  (X : Action (Type u) (Mon.of G)) :
  left_regular G ⊗ X ≅ left_regular G ⊗ Action.mk X.V 1 :=
{ hom :=
  { hom := λ g, ⟨g.1, (X.ρ (g.1⁻¹ : G) g.2 : X.V)⟩,
    comm' := λ g, funext $ λ x, prod.ext rfl $
      show (X.ρ ((g * x.1)⁻¹ : G) * X.ρ g) x.2 = _,
      by simpa only [mul_inv_rev, ←X.ρ.map_mul, inv_mul_cancel_right] },
  inv :=
  { hom := λ g, ⟨g.1, X.ρ g.1 g.2⟩,
    comm' := λ g, funext $ λ x, prod.ext rfl $
      by simpa only [tensor_rho, types_comp_apply, tensor_apply, left_regular_ρ_apply, map_mul] },
  hom_inv_id' := hom.ext _ _ (funext $ λ x, prod.ext rfl $
    show (X.ρ x.1 * X.ρ (x.1⁻¹ : G)) x.2 = _,
      by simpa only [←X.ρ.map_mul, mul_inv_self, X.ρ.map_one]),
  inv_hom_id' := hom.ext _ _ (funext $ λ x, prod.ext rfl $
    show (X.ρ (x.1⁻¹ : G) * X.ρ x.1) _ = _,
      by simpa only [←X.ρ.map_mul, inv_mul_self, X.ρ.map_one]) }

/-- The natural isomorphism of `G`-sets `Gⁿ⁺¹ ≅ G × Gⁿ`, where `G` acts by left multiplication on
each factor. -/
@[simps] def diagonal_succ (G : Type u) [monoid G] (n : ℕ) :
  diagonal G (n + 1) ≅ left_regular G ⊗ diagonal G n :=
mk_iso (equiv.pi_fin_succ_above_equiv _ 0).to_iso (λ g, rfl)

end Action

namespace category_theory.functor

variables {V} {W : Type (u+1)} [large_category W]

/-- A functor between categories induces a functor between
the categories of `G`-actions within those categories. -/
@[simps]
def map_Action (F : V ⥤ W) (G : Mon.{u}) : Action V G ⥤ Action W G :=
{ obj := λ M,
  { V := F.obj M.V,
    ρ :=
    { to_fun := λ g, F.map (M.ρ g),
      map_one' := by simp only [End.one_def, Action.ρ_one, F.map_id],
      map_mul' := λ g h, by simp only [End.mul_def, F.map_comp, map_mul], }, },
  map := λ M N f,
  { hom := F.map f.hom,
    comm' := λ g, by { dsimp, rw [←F.map_comp, f.comm, F.map_comp], }, },
  map_id' := λ M, by { ext, simp only [Action.id_hom, F.map_id], },
  map_comp' := λ M N P f g, by { ext, simp only [Action.comp_hom, F.map_comp], }, }

variables (F : V ⥤ W) (G : Mon.{u}) [preadditive V] [preadditive W]

instance map_Action_preadditive [F.additive] : (F.map_Action G).additive := {}

variables {R : Type*} [semiring R] [category_theory.linear R V] [category_theory.linear R W]

instance map_Action_linear [F.additive] [F.linear R] : (F.map_Action G).linear R := {}

end category_theory.functor

namespace category_theory.monoidal_functor

open Action
variables {V} {W : Type (u+1)} [large_category W] [monoidal_category V] [monoidal_category W]
  (F : monoidal_functor V W) (G : Mon.{u})

/-- A monoidal functor induces a monoidal functor between
the categories of `G`-actions within those categories. -/
@[simps] def map_Action :
  monoidal_functor (Action V G) (Action W G) :=
{ ε :=
  { hom := F.ε,
    comm' := λ g,
    by { dsimp, erw [category.id_comp, category_theory.functor.map_id, category.comp_id], }, },
  μ := λ X Y,
  { hom := F.μ X.V Y.V,
    comm' := λ g, F.to_lax_monoidal_functor.μ_natural (X.ρ g) (Y.ρ g), },
  ε_is_iso := by apply_instance,
  μ_is_iso := by apply_instance,
  μ_natural' := by { intros, ext, dsimp, simp, },
  associativity' := by { intros, ext, dsimp, simp, dsimp, simp, }, -- See note [dsimp, simp].
  left_unitality' := by { intros, ext, dsimp, simp, dsimp, simp, },
  right_unitality' := by { intros, ext, dsimp, simp, dsimp, simp, },
  ..F.to_functor.map_Action G, }

@[simp] lemma map_Action_ε_inv_hom :
  (inv (F.map_Action G).ε).hom = inv F.ε :=
begin
  ext,
  simp only [←F.map_Action_to_lax_monoidal_functor_ε_hom G, ←Action.comp_hom,
    is_iso.hom_inv_id, id_hom],
end

@[simp] lemma map_Action_μ_inv_hom (X Y : Action V G) :
  (inv ((F.map_Action G).μ X Y)).hom = inv (F.μ X.V Y.V) :=
begin
  ext,
  simpa only [←F.map_Action_to_lax_monoidal_functor_μ_hom G, ←Action.comp_hom,
    is_iso.hom_inv_id, id_hom],
end

end category_theory.monoidal_functor


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Floris van Doorn
-/
import category_theory.limits.filtered
import category_theory.limits.shapes.finite_products
import category_theory.discrete_category
import tactic.equiv_rw

/-!
# Limits in `C` give colimits in `Cᵒᵖ`.

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

We also give special cases for (co)products,
(co)equalizers, and pullbacks / pushouts.

-/

universes v₁ v₂ u₁ u₂

noncomputable theory

open category_theory
open category_theory.functor
open opposite

namespace category_theory.limits

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

/-- Turn a colimit for `F : J ⥤ C` into a limit for `F.op : Jᵒᵖ ⥤ Cᵒᵖ`. -/
@[simps] def is_limit_cocone_op (F : J ⥤ C) {c : cocone F} (hc : is_colimit c) :
  is_limit c.op :=
{ lift := λ s, (hc.desc s.unop).op,
  fac' := λ s j, quiver.hom.unop_inj (by simpa),
  uniq' := λ s m w,
  begin
    refine quiver.hom.unop_inj (hc.hom_ext (λ j, quiver.hom.op_inj _)),
    simpa only [quiver.hom.unop_op, is_colimit.fac] using w (op j)
  end }

/-- Turn a limit for `F : J ⥤ C` into a colimit for `F.op : Jᵒᵖ ⥤ Cᵒᵖ`. -/
@[simps] def is_colimit_cone_op (F : J ⥤ C) {c : cone F} (hc : is_limit c) :
  is_colimit c.op :=
{ desc := λ s, (hc.lift s.unop).op,
  fac' := λ s j, quiver.hom.unop_inj (by simpa),
  uniq' := λ s m w,
  begin
    refine quiver.hom.unop_inj (hc.hom_ext (λ j, quiver.hom.op_inj _)),
    simpa only [quiver.hom.unop_op, is_limit.fac] using w (op j)
  end }

/-- Turn a colimit for `F : J ⥤ Cᵒᵖ` into a limit for `F.left_op : Jᵒᵖ ⥤ C`. -/
@[simps] def is_limit_cone_left_op_of_cocone (F : J ⥤ Cᵒᵖ) {c : cocone F} (hc : is_colimit c) :
  is_limit (cone_left_op_of_cocone c) :=
{ lift := λ s, (hc.desc (cocone_of_cone_left_op s)).unop,
  fac' :=  λ s j, quiver.hom.op_inj $ by simpa only [cone_left_op_of_cocone_π_app, op_comp,
    quiver.hom.op_unop, is_colimit.fac, cocone_of_cone_left_op_ι_app],
  uniq' := λ s m w,
  begin
    refine quiver.hom.op_inj (hc.hom_ext (λ j, quiver.hom.unop_inj _)),
    simpa only [quiver.hom.op_unop, is_colimit.fac, cocone_of_cone_left_op_ι_app] using w (op j)
  end }

/-- Turn a limit of `F : J ⥤ Cᵒᵖ` into a colimit of `F.left_op : Jᵒᵖ ⥤ C`. -/
@[simps] def is_colimit_cocone_left_op_of_cone (F : J ⥤ Cᵒᵖ) {c : cone F} (hc : is_limit c) :
  is_colimit (cocone_left_op_of_cone c) :=
{ desc := λ s, (hc.lift (cone_of_cocone_left_op s)).unop,
  fac' := λ s j, quiver.hom.op_inj $ by simpa only [cocone_left_op_of_cone_ι_app, op_comp,
    quiver.hom.op_unop, is_limit.fac, cone_of_cocone_left_op_π_app],
  uniq' := λ s m w,
  begin
    refine quiver.hom.op_inj (hc.hom_ext (λ j, quiver.hom.unop_inj _)),
    simpa only [quiver.hom.op_unop, is_limit.fac, cone_of_cocone_left_op_π_app] using w (op j)
  end }

/-- Turn a colimit for `F : Jᵒᵖ ⥤ C` into a limit for `F.right_op : J ⥤ Cᵒᵖ`. -/
@[simps] def is_limit_cone_right_op_of_cocone (F : Jᵒᵖ ⥤ C) {c : cocone F} (hc : is_colimit c) :
  is_limit (cone_right_op_of_cocone c) :=
{ lift := λ s, (hc.desc (cocone_of_cone_right_op s)).op,
  fac' := λ s j, quiver.hom.unop_inj (by simpa),
  uniq' := λ s m w,
  begin
    refine quiver.hom.unop_inj (hc.hom_ext (λ j, quiver.hom.op_inj _)),
    simpa only [quiver.hom.unop_op, is_colimit.fac] using w (unop j)
  end }

/-- Turn a limit for `F : Jᵒᵖ ⥤ C` into a colimit for `F.right_op : J ⥤ Cᵒᵖ`. -/
@[simps] def is_colimit_cocone_right_op_of_cone (F : Jᵒᵖ ⥤ C) {c : cone F} (hc : is_limit c) :
  is_colimit (cocone_right_op_of_cone c) :=
{ desc := λ s, (hc.lift (cone_of_cocone_right_op s)).op,
  fac' := λ s j, quiver.hom.unop_inj (by simpa),
  uniq' := λ s m w,
  begin
    refine quiver.hom.unop_inj (hc.hom_ext (λ j, quiver.hom.op_inj _)),
    simpa only [quiver.hom.unop_op, is_limit.fac] using w (unop j)
  end }

/-- Turn a colimit for `F : Jᵒᵖ ⥤ Cᵒᵖ` into a limit for `F.unop : J ⥤ C`. -/
@[simps] def is_limit_cone_unop_of_cocone (F : Jᵒᵖ ⥤ Cᵒᵖ) {c : cocone F} (hc : is_colimit c) :
  is_limit (cone_unop_of_cocone c) :=
{ lift := λ s, (hc.desc (cocone_of_cone_unop s)).unop,
  fac' := λ s j, quiver.hom.op_inj (by simpa),
  uniq' := λ s m w,
  begin
    refine quiver.hom.op_inj (hc.hom_ext (λ j, quiver.hom.unop_inj _)),
    simpa only [quiver.hom.op_unop, is_colimit.fac] using w (unop j)
  end }

/-- Turn a limit of `F : Jᵒᵖ ⥤ Cᵒᵖ` into a colimit of `F.unop : J ⥤ C`. -/
@[simps] def is_colimit_cocone_unop_of_cone (F : Jᵒᵖ ⥤ Cᵒᵖ) {c : cone F} (hc : is_limit c) :
  is_colimit (cocone_unop_of_cone c) :=
{ desc := λ s, (hc.lift (cone_of_cocone_unop s)).unop,
  fac' := λ s j, quiver.hom.op_inj (by simpa),
  uniq' := λ s m w,
  begin
    refine quiver.hom.op_inj (hc.hom_ext (λ j, quiver.hom.unop_inj _)),
    simpa only [quiver.hom.op_unop, is_limit.fac] using w (unop j)
  end }

/-- Turn a colimit for `F.op : Jᵒᵖ ⥤ Cᵒᵖ` into a limit for `F : J ⥤ C`. -/
@[simps] def is_limit_cocone_unop (F : J ⥤ C) {c : cocone F.op} (hc : is_colimit c) :
  is_limit c.unop :=
{ lift := λ s, (hc.desc s.op).unop,
  fac' := λ s j, quiver.hom.op_inj (by simpa),
  uniq' := λ s m w,
  begin
    refine quiver.hom.op_inj (hc.hom_ext (λ j, quiver.hom.unop_inj _)),
    simpa only [quiver.hom.op_unop, is_colimit.fac] using w (unop j)
  end }

/-- Turn a limit for `F.op : Jᵒᵖ ⥤ Cᵒᵖ` into a colimit for `F : J ⥤ C`. -/
@[simps] def is_colimit_cone_unop (F : J ⥤ C) {c : cone F.op} (hc : is_limit c) :
  is_colimit c.unop :=
{ desc := λ s, (hc.lift s.op).unop,
  fac' := λ s j, quiver.hom.op_inj (by simpa),
  uniq' := λ s m w,
  begin
    refine quiver.hom.op_inj (hc.hom_ext (λ j, quiver.hom.unop_inj _)),
    simpa only [quiver.hom.op_unop, is_limit.fac] using w (unop j)
  end }

/-- Turn a colimit for `F.left_op : Jᵒᵖ ⥤ C` into a limit for `F : J ⥤ Cᵒᵖ`. -/
@[simps] def is_limit_cone_of_cocone_left_op (F : J ⥤ Cᵒᵖ) {c : cocone F.left_op}
  (hc : is_colimit c) : is_limit (cone_of_cocone_left_op c) :=
{ lift := λ s, (hc.desc (cocone_left_op_of_cone s)).op,
  fac' := λ s j, quiver.hom.unop_inj $ by simpa only [cone_of_cocone_left_op_π_app, unop_comp,
    quiver.hom.unop_op, is_colimit.fac, cocone_left_op_of_cone_ι_app],
  uniq' := λ s m w,
  begin
    refine quiver.hom.unop_inj (hc.hom_ext (λ j, quiver.hom.op_inj _)),
    simpa only [quiver.hom.unop_op, is_colimit.fac, cone_of_cocone_left_op_π_app] using w (unop j)
  end }

/-- Turn a limit of `F.left_op : Jᵒᵖ ⥤ C` into a colimit of `F : J ⥤ Cᵒᵖ`. -/
@[simps] def is_colimit_cocone_of_cone_left_op (F : J ⥤ Cᵒᵖ) {c : cone (F.left_op)}
  (hc : is_limit c) : is_colimit (cocone_of_cone_left_op c) :=
{ desc := λ s, (hc.lift (cone_left_op_of_cocone s)).op,
  fac' := λ s j, quiver.hom.unop_inj $ by simpa only [cocone_of_cone_left_op_ι_app, unop_comp,
    quiver.hom.unop_op, is_limit.fac, cone_left_op_of_cocone_π_app],
  uniq' := λ s m w,
  begin
    refine quiver.hom.unop_inj (hc.hom_ext (λ j, quiver.hom.op_inj _)),
    simpa only [quiver.hom.unop_op, is_limit.fac, cocone_of_cone_left_op_ι_app] using w (unop j)
  end }

/-- Turn a colimit for `F.right_op : J ⥤ Cᵒᵖ` into a limit for `F : Jᵒᵖ ⥤ C`. -/
@[simps] def is_limit_cone_of_cocone_right_op (F : Jᵒᵖ ⥤ C) {c : cocone F.right_op}
  (hc : is_colimit c) : is_limit (cone_of_cocone_right_op c) :=
{ lift := λ s, (hc.desc (cocone_right_op_of_cone s)).unop,
  fac' := λ s j, quiver.hom.op_inj (by simpa),
  uniq' := λ s m w,
  begin
    refine quiver.hom.op_inj (hc.hom_ext (λ j, quiver.hom.unop_inj _)),
    simpa only [quiver.hom.op_unop, is_colimit.fac] using w (op j)
  end }

/-- Turn a limit for `F.right_op : J ⥤ Cᵒᵖ` into a limit for `F : Jᵒᵖ ⥤ C`. -/
@[simps] def is_colimit_cocone_of_cone_right_op (F : Jᵒᵖ ⥤ C) {c : cone F.right_op}
  (hc : is_limit c) : is_colimit (cocone_of_cone_right_op c) :=
{ desc := λ s, (hc.lift (cone_right_op_of_cocone s)).unop,
  fac' := λ s j, quiver.hom.op_inj (by simpa),
  uniq' := λ s m w,
  begin
    refine quiver.hom.op_inj (hc.hom_ext (λ j, quiver.hom.unop_inj _)),
    simpa only [quiver.hom.op_unop, is_limit.fac] using w (op j)
  end }

/-- Turn a colimit for `F.unop : J ⥤ C` into a limit for `F : Jᵒᵖ ⥤ Cᵒᵖ`. -/
@[simps] def is_limit_cone_of_cocone_unop (F : Jᵒᵖ ⥤ Cᵒᵖ) {c : cocone F.unop} (hc : is_colimit c) :
  is_limit (cone_of_cocone_unop c) :=
{ lift := λ s, (hc.desc (cocone_unop_of_cone s)).op,
  fac' := λ s j, quiver.hom.unop_inj (by simpa),
  uniq' := λ s m w,
  begin
    refine quiver.hom.unop_inj (hc.hom_ext (λ j, quiver.hom.op_inj _)),
    simpa only [quiver.hom.unop_op, is_colimit.fac] using w (op j)
  end }

/-- Turn a limit for `F.unop : J ⥤ C` into a colimit for `F : Jᵒᵖ ⥤ Cᵒᵖ`. -/
@[simps] def is_colimit_cone_of_cocone_unop (F : Jᵒᵖ ⥤ Cᵒᵖ) {c : cone F.unop} (hc : is_limit c) :
  is_colimit (cocone_of_cone_unop c) :=
{ desc := λ s, (hc.lift (cone_unop_of_cocone s)).op,
  fac' := λ s j, quiver.hom.unop_inj (by simpa),
  uniq' := λ s m w,
  begin
    refine quiver.hom.unop_inj (hc.hom_ext (λ j, quiver.hom.op_inj _)),
    simpa only [quiver.hom.unop_op, is_limit.fac] using w (op j)
  end }

/--
If `F.left_op : Jᵒᵖ ⥤ C` has a colimit, we can construct a limit for `F : J ⥤ Cᵒᵖ`.
-/
lemma has_limit_of_has_colimit_left_op (F : J ⥤ Cᵒᵖ) [has_colimit F.left_op] : has_limit F :=
has_limit.mk
{ cone := cone_of_cocone_left_op (colimit.cocone F.left_op),
  is_limit := is_limit_cone_of_cocone_left_op _ (colimit.is_colimit _) }

lemma has_limit_of_has_colimit_op (F : J ⥤ C) [has_colimit F.op] : has_limit F :=
has_limit.mk
{ cone := (colimit.cocone F.op).unop,
  is_limit := is_limit_cocone_unop _ (colimit.is_colimit _) }

/--
If `C` has colimits of shape `Jᵒᵖ`, we can construct limits in `Cᵒᵖ` of shape `J`.
-/
lemma has_limits_of_shape_op_of_has_colimits_of_shape [has_colimits_of_shape Jᵒᵖ C] :
  has_limits_of_shape J Cᵒᵖ :=
{ has_limit := λ F, has_limit_of_has_colimit_left_op F }

lemma has_limits_of_shape_of_has_colimits_of_shape_op [has_colimits_of_shape Jᵒᵖ Cᵒᵖ] :
  has_limits_of_shape J C :=
{ has_limit := λ F, has_limit_of_has_colimit_op F }

local attribute [instance] has_limits_of_shape_op_of_has_colimits_of_shape

/--
If `C` has colimits, we can construct limits for `Cᵒᵖ`.
-/
instance has_limits_op_of_has_colimits [has_colimits C] : has_limits Cᵒᵖ := ⟨infer_instance⟩

lemma has_limits_of_has_colimits_op [has_colimits Cᵒᵖ] : has_limits C :=
{ has_limits_of_shape := λ J hJ, by exactI has_limits_of_shape_of_has_colimits_of_shape_op }

instance has_cofiltered_limits_op_of_has_filtered_colimits
  [has_filtered_colimits_of_size.{v₂ u₂} C] : has_cofiltered_limits_of_size.{v₂ u₂} Cᵒᵖ :=
{ has_limits_of_shape := λ I hI₁ hI₂, by exactI has_limits_of_shape_op_of_has_colimits_of_shape }

lemma has_cofiltered_limits_of_has_filtered_colimits_op
  [has_filtered_colimits_of_size.{v₂ u₂} Cᵒᵖ] : has_cofiltered_limits_of_size.{v₂ u₂} C :=
{ has_limits_of_shape := λ I hI₂ hI₂, by exactI has_limits_of_shape_of_has_colimits_of_shape_op }

/--
If `F.left_op : Jᵒᵖ ⥤ C` has a limit, we can construct a colimit for `F : J ⥤ Cᵒᵖ`.
-/
lemma has_colimit_of_has_limit_left_op (F : J ⥤ Cᵒᵖ) [has_limit F.left_op] : has_colimit F :=
has_colimit.mk
{ cocone := cocone_of_cone_left_op (limit.cone F.left_op),
  is_colimit := is_colimit_cocone_of_cone_left_op _ (limit.is_limit _) }

lemma has_colimit_of_has_limit_op (F : J ⥤ C) [has_limit F.op] : has_colimit F :=
has_colimit.mk
{ cocone := (limit.cone F.op).unop,
  is_colimit := is_colimit_cone_unop _ (limit.is_limit _) }

/--
If `C` has colimits of shape `Jᵒᵖ`, we can construct limits in `Cᵒᵖ` of shape `J`.
-/
instance has_colimits_of_shape_op_of_has_limits_of_shape [has_limits_of_shape Jᵒᵖ C] :
  has_colimits_of_shape J Cᵒᵖ :=
{ has_colimit := λ F, has_colimit_of_has_limit_left_op F }

lemma has_colimits_of_shape_of_has_limits_of_shape_op [has_limits_of_shape Jᵒᵖ Cᵒᵖ] :
  has_colimits_of_shape J C :=
{ has_colimit := λ F, has_colimit_of_has_limit_op F }

/--
If `C` has limits, we can construct colimits for `Cᵒᵖ`.
-/
instance has_colimits_op_of_has_limits [has_limits C] : has_colimits Cᵒᵖ := ⟨infer_instance⟩

lemma has_colimits_of_has_limits_op [has_limits Cᵒᵖ] : has_colimits C :=
{ has_colimits_of_shape := λ J hJ, by exactI has_colimits_of_shape_of_has_limits_of_shape_op }

instance has_filtered_colimits_op_of_has_cofiltered_limits
  [has_cofiltered_limits_of_size.{v₂ u₂} C] : has_filtered_colimits_of_size.{v₂ u₂} Cᵒᵖ :=
{ has_colimits_of_shape := λ I hI₁ hI₂, by exactI infer_instance }

lemma has_filtered_colimits_of_has_cofiltered_limits_op
  [has_cofiltered_limits_of_size.{v₂ u₂} Cᵒᵖ] : has_filtered_colimits_of_size.{v₂ u₂} C :=
{ has_colimits_of_shape := λ I hI₁ hI₂, by exactI has_colimits_of_shape_of_has_limits_of_shape_op }

variables (X : Type v₂)
/--
If `C` has products indexed by `X`, then `Cᵒᵖ` has coproducts indexed by `X`.
-/
instance has_coproducts_of_shape_opposite [has_products_of_shape X C] :
  has_coproducts_of_shape X Cᵒᵖ :=
begin
  haveI : has_limits_of_shape (discrete X)ᵒᵖ C :=
    has_limits_of_shape_of_equivalence (discrete.opposite X).symm,
  apply_instance
end

lemma has_coproducts_of_shape_of_opposite [has_products_of_shape X Cᵒᵖ] :
  has_coproducts_of_shape X C :=
begin
  haveI : has_limits_of_shape (discrete X)ᵒᵖ Cᵒᵖ :=
    has_limits_of_shape_of_equivalence (discrete.opposite X).symm,
  exact has_colimits_of_shape_of_has_limits_of_shape_op
end

/--
If `C` has coproducts indexed by `X`, then `Cᵒᵖ` has products indexed by `X`.
-/
instance has_products_of_shape_opposite [has_coproducts_of_shape X C] :
  has_products_of_shape X Cᵒᵖ :=
begin
  haveI : has_colimits_of_shape (discrete X)ᵒᵖ C :=
    has_colimits_of_shape_of_equivalence (discrete.opposite X).symm,
  apply_instance
end

lemma has_products_of_shape_of_opposite [has_coproducts_of_shape X Cᵒᵖ] :
  has_products_of_shape X C :=
begin
  haveI : has_colimits_of_shape (discrete X)ᵒᵖ Cᵒᵖ :=
    has_colimits_of_shape_of_equivalence (discrete.opposite X).symm,
  exact has_limits_of_shape_of_has_colimits_of_shape_op
end

instance has_products_opposite [has_coproducts.{v₂} C] : has_products.{v₂} Cᵒᵖ :=
λ X, infer_instance

lemma has_products_of_opposite [has_coproducts.{v₂} Cᵒᵖ] : has_products.{v₂} C :=
λ X, has_products_of_shape_of_opposite X

instance has_coproducts_opposite [has_products.{v₂} C] : has_coproducts.{v₂} Cᵒᵖ :=
λ X, infer_instance

lemma has_coproducts_of_opposite [has_products.{v₂} Cᵒᵖ] : has_coproducts.{v₂} C :=
λ X, has_coproducts_of_shape_of_opposite X

instance has_finite_coproducts_opposite [has_finite_products C] : has_finite_coproducts Cᵒᵖ :=
{ out := λ n, limits.has_coproducts_of_shape_opposite _ }

lemma has_finite_coproducts_of_opposite [has_finite_products Cᵒᵖ] : has_finite_coproducts C :=
{ out := λ n, has_coproducts_of_shape_of_opposite _ }

instance has_finite_products_opposite [has_finite_coproducts C] : has_finite_products Cᵒᵖ :=
{ out := λ n, infer_instance }

lemma has_finite_products_of_opposite [has_finite_coproducts Cᵒᵖ] : has_finite_products C :=
{ out := λ n, has_products_of_shape_of_opposite _ }

instance has_equalizers_opposite [has_coequalizers C] : has_equalizers Cᵒᵖ :=
begin
  haveI : has_colimits_of_shape walking_parallel_pairᵒᵖ C :=
    has_colimits_of_shape_of_equivalence walking_parallel_pair_op_equiv,
  apply_instance
end

instance has_coequalizers_opposite [has_equalizers C] : has_coequalizers Cᵒᵖ :=
begin
  haveI : has_limits_of_shape walking_parallel_pairᵒᵖ C :=
    has_limits_of_shape_of_equivalence walking_parallel_pair_op_equiv,
  apply_instance
end

instance has_finite_colimits_opposite [has_finite_limits C] :
  has_finite_colimits Cᵒᵖ :=
{ out := λ J 𝒟 𝒥, by { resetI, apply_instance, }, }

instance has_finite_limits_opposite [has_finite_colimits C] :
  has_finite_limits Cᵒᵖ :=
{ out := λ J 𝒟 𝒥, by { resetI, apply_instance, }, }

instance has_pullbacks_opposite [has_pushouts C] : has_pullbacks Cᵒᵖ :=
begin
  haveI : has_colimits_of_shape walking_cospanᵒᵖ C :=
    has_colimits_of_shape_of_equivalence walking_cospan_op_equiv.symm,
  apply has_limits_of_shape_op_of_has_colimits_of_shape,
end

instance has_pushouts_opposite [has_pullbacks C] : has_pushouts Cᵒᵖ :=
begin
  haveI : has_limits_of_shape walking_spanᵒᵖ C :=
    has_limits_of_shape_of_equivalence walking_span_op_equiv.symm,
  apply_instance
end

/-- The canonical isomorphism relating `span f.op g.op` and `(cospan f g).op` -/
@[simps]
def span_op {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) :
  span f.op g.op ≅ walking_cospan_op_equiv.inverse ⋙ (cospan f g).op :=
nat_iso.of_components (by { rintro (_|_|_); refl, })
  (by { rintros (_|_|_) (_|_|_) f; cases f; tidy, })

/-- The canonical isomorphism relating `(cospan f g).op` and `span f.op g.op` -/
@[simps]
def op_cospan {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) :
  (cospan f g).op ≅ walking_cospan_op_equiv.functor ⋙ span f.op g.op :=
calc (cospan f g).op ≅ 𝟭 _ ⋙ (cospan f g).op : by refl
... ≅ (walking_cospan_op_equiv.functor ⋙ walking_cospan_op_equiv.inverse) ⋙ (cospan f g).op :
  iso_whisker_right walking_cospan_op_equiv.unit_iso _
... ≅ walking_cospan_op_equiv.functor ⋙ (walking_cospan_op_equiv.inverse ⋙ (cospan f g).op) :
  functor.associator _ _ _
... ≅ walking_cospan_op_equiv.functor ⋙ span f.op g.op : iso_whisker_left _ (span_op f g).symm

/-- The canonical isomorphism relating `cospan f.op g.op` and `(span f g).op` -/
@[simps]
def cospan_op {X Y Z : C} (f : X ⟶ Y) (g : X ⟶ Z) :
  cospan f.op g.op ≅ walking_span_op_equiv.inverse ⋙ (span f g).op :=
nat_iso.of_components (by { rintro (_|_|_); refl, })
  (by { rintros (_|_|_) (_|_|_) f; cases f; tidy, })

/-- The canonical isomorphism relating `(span f g).op` and `cospan f.op g.op` -/
@[simps]
def op_span {X Y Z : C} (f : X ⟶ Y) (g : X ⟶ Z) :
  (span f g).op ≅ walking_span_op_equiv.functor ⋙ cospan f.op g.op :=
calc (span f g).op ≅ 𝟭 _ ⋙ (span f g).op : by refl
... ≅ (walking_span_op_equiv.functor ⋙ walking_span_op_equiv.inverse) ⋙ (span f g).op :
  iso_whisker_right walking_span_op_equiv.unit_iso _
... ≅ walking_span_op_equiv.functor ⋙ (walking_span_op_equiv.inverse ⋙ (span f g).op) :
  functor.associator _ _ _
... ≅ walking_span_op_equiv.functor ⋙ cospan f.op g.op :
  iso_whisker_left _ (cospan_op f g).symm

namespace pushout_cocone

/-- The obvious map `pushout_cocone f g → pullback_cone f.unop g.unop` -/
@[simps (lemmas_only)]
def unop {X Y Z : Cᵒᵖ} {f : X ⟶ Y} {g : X ⟶ Z} (c : pushout_cocone f g) :
  pullback_cone f.unop g.unop :=
cocone.unop ((cocones.precompose (op_cospan f.unop g.unop).hom).obj
  (cocone.whisker walking_cospan_op_equiv.functor c))

@[simp]
lemma unop_fst {X Y Z : Cᵒᵖ} {f : X ⟶ Y} {g : X ⟶ Z} (c : pushout_cocone f g) :
  c.unop.fst = c.inl.unop :=
by { change (_ : limits.cone _).π.app _ = _,
  simp only [pushout_cocone.ι_app_left, pushout_cocone.unop_π_app], tidy }

@[simp]
lemma unop_snd {X Y Z : Cᵒᵖ} {f : X ⟶ Y} {g : X ⟶ Z} (c : pushout_cocone f g) :
  c.unop.snd = c.inr.unop :=
by { change (_ : limits.cone _).π.app _ = _,
  simp only [pushout_cocone.unop_π_app, pushout_cocone.ι_app_right], tidy, }

/-- The obvious map `pushout_cocone f.op g.op → pullback_cone f g` -/
@[simps (lemmas_only)]
def op {X Y Z : C} {f : X ⟶ Y} {g : X ⟶ Z} (c : pushout_cocone f g) :
  pullback_cone f.op g.op :=
(cones.postcompose ((cospan_op f g).symm).hom).obj
  (cone.whisker walking_span_op_equiv.inverse (cocone.op c))

@[simp]
lemma op_fst {X Y Z : C} {f : X ⟶ Y} {g : X ⟶ Z} (c : pushout_cocone f g) :
  c.op.fst = c.inl.op :=
by { change (_ : limits.cone _).π.app _ = _, apply category.comp_id, }

@[simp]
lemma op_snd {X Y Z : C} {f : X ⟶ Y} {g : X ⟶ Z} (c : pushout_cocone f g) :
  c.op.snd = c.inr.op :=
by { change (_ : limits.cone _).π.app _ = _, apply category.comp_id, }

end pushout_cocone

namespace pullback_cone

/-- The obvious map `pullback_cone f g → pushout_cocone f.unop g.unop` -/
@[simps (lemmas_only)]
def unop {X Y Z : Cᵒᵖ} {f : X ⟶ Z} {g : Y ⟶ Z} (c : pullback_cone f g) :
  pushout_cocone f.unop g.unop :=
cone.unop ((cones.postcompose (op_span f.unop g.unop).symm.hom).obj
  (cone.whisker walking_span_op_equiv.functor c))

@[simp]
lemma unop_inl {X Y Z : Cᵒᵖ} {f : X ⟶ Z} {g : Y ⟶ Z} (c : pullback_cone f g) :
  c.unop.inl = c.fst.unop :=
begin
  change ((_ : limits.cocone _).ι.app _) = _,
  dsimp only [unop, op_span],
  simp, dsimp, simp, dsimp, simp
end

@[simp]
lemma unop_inr {X Y Z : Cᵒᵖ} {f : X ⟶ Z} {g : Y ⟶ Z} (c : pullback_cone f g) :
  c.unop.inr = c.snd.unop :=
begin
  change ((_ : limits.cocone _).ι.app _) = _,
  apply quiver.hom.op_inj,
  simp [unop_ι_app], dsimp, simp,
  apply category.comp_id,
end

/-- The obvious map `pullback_cone f g → pushout_cocone f.op g.op` -/
@[simps (lemmas_only)]
def op {X Y Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} (c : pullback_cone f g) :
  pushout_cocone f.op g.op :=
(cocones.precompose (span_op f g).hom).obj
  (cocone.whisker walking_cospan_op_equiv.inverse (cone.op c))

@[simp] lemma op_inl {X Y Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} (c : pullback_cone f g) :
  c.op.inl = c.fst.op :=
by { change (_ : limits.cocone _).ι.app _ = _, apply category.id_comp, }

@[simp] lemma op_inr {X Y Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} (c : pullback_cone f g) :
  c.op.inr = c.snd.op :=
by { change (_ : limits.cocone _).ι.app _ = _, apply category.id_comp, }

/-- If `c` is a pullback cone, then `c.op.unop` is isomorphic to `c`. -/
def op_unop {X Y Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} (c : pullback_cone f g) : c.op.unop ≅ c :=
pullback_cone.ext (iso.refl _) (by simp) (by simp)

/-- If `c` is a pullback cone in `Cᵒᵖ`, then `c.unop.op` is isomorphic to `c`. -/
def unop_op {X Y Z : Cᵒᵖ} {f : X ⟶ Z} {g : Y ⟶ Z} (c : pullback_cone f g) : c.unop.op ≅ c :=
pullback_cone.ext (iso.refl _) (by simp) (by simp)

end pullback_cone

namespace pushout_cocone

/-- If `c` is a pushout cocone, then `c.op.unop` is isomorphic to `c`. -/
def op_unop {X Y Z : C} {f : X ⟶ Y} {g : X ⟶ Z} (c : pushout_cocone f g) : c.op.unop ≅ c :=
pushout_cocone.ext (iso.refl _) (by simp) (by simp)

/-- If `c` is a pushout cocone in `Cᵒᵖ`, then `c.unop.op` is isomorphic to `c`. -/
def unop_op {X Y Z : Cᵒᵖ} {f : X ⟶ Y} {g : X ⟶ Z} (c : pushout_cocone f g) : c.unop.op ≅ c :=
pushout_cocone.ext (iso.refl _) (by simp) (by simp)

/-- A pushout cone is a colimit cocone if and only if the corresponding pullback cone
in the opposite category is a limit cone. -/
def is_colimit_equiv_is_limit_op  {X Y Z : C} {f : X ⟶ Y} {g : X ⟶ Z} (c : pushout_cocone f g) :
  is_colimit c ≃ is_limit c.op :=
begin
  apply equiv_of_subsingleton_of_subsingleton,
  { intro h,
    equiv_rw is_limit.postcompose_hom_equiv _ _,
    equiv_rw (is_limit.whisker_equivalence_equiv walking_span_op_equiv.symm).symm,
    exact is_limit_cocone_op _ h, },
  { intro h,
    equiv_rw is_colimit.equiv_iso_colimit c.op_unop.symm,
    apply is_colimit_cone_unop,
    equiv_rw is_limit.postcompose_hom_equiv _ _,
    equiv_rw (is_limit.whisker_equivalence_equiv _).symm,
    exact h, }
end

/-- A pushout cone is a colimit cocone in `Cᵒᵖ` if and only if the corresponding pullback cone
in `C` is a limit cone. -/
def is_colimit_equiv_is_limit_unop  {X Y Z : Cᵒᵖ} {f : X ⟶ Y} {g : X ⟶ Z}
  (c : pushout_cocone f g) : is_colimit c ≃ is_limit c.unop :=
begin
  apply equiv_of_subsingleton_of_subsingleton,
  { intro h,
    apply is_limit_cocone_unop,
    equiv_rw is_colimit.precompose_hom_equiv _ _,
    equiv_rw (is_colimit.whisker_equivalence_equiv _).symm,
    exact h, },
  { intro h,
    equiv_rw is_colimit.equiv_iso_colimit c.unop_op.symm,
    equiv_rw is_colimit.precompose_hom_equiv _ _,
    equiv_rw (is_colimit.whisker_equivalence_equiv walking_cospan_op_equiv.symm).symm,
    exact is_colimit_cone_op _ h, },
end

end pushout_cocone

namespace pullback_cone

/-- A pullback cone is a limit cone if and only if the corresponding pushout cocone
in the opposite category is a colimit cocone. -/
def is_limit_equiv_is_colimit_op  {X Y Z : C} {f : X ⟶ Z} {g : Y ⟶ Z}
  (c : pullback_cone f g) : is_limit c ≃ is_colimit c.op :=
(is_limit.equiv_iso_limit c.op_unop).symm.trans c.op.is_colimit_equiv_is_limit_unop.symm

/-- A pullback cone is a limit cone in `Cᵒᵖ` if and only if the corresponding pushout cocone
in `C` is a colimit cocone. -/
def is_limit_equiv_is_colimit_unop  {X Y Z : Cᵒᵖ} {f : X ⟶ Z} {g : Y ⟶ Z}
  (c : pullback_cone f g) : is_limit c ≃ is_colimit c.unop :=
(is_limit.equiv_iso_limit c.unop_op).symm.trans c.unop.is_colimit_equiv_is_limit_op.symm

end pullback_cone

section pullback

open opposite

/-- The pullback of `f` and `g` in `C` is isomorphic to the pushout of
`f.op` and `g.op` in `Cᵒᵖ`. -/
noncomputable
def pullback_iso_unop_pushout {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z)
  [has_pullback f g] [has_pushout f.op g.op] : pullback f g ≅ unop (pushout f.op g.op) :=
is_limit.cone_point_unique_up_to_iso (limit.is_limit _)
  ((pushout_cocone.is_colimit_equiv_is_limit_unop _) (colimit.is_colimit (span f.op g.op)))

@[simp, reassoc]
lemma pullback_iso_unop_pushout_inv_fst {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z)
  [has_pullback f g] [has_pushout f.op g.op] :
  (pullback_iso_unop_pushout f g).inv ≫ pullback.fst =
    (pushout.inl : _ ⟶ pushout f.op g.op).unop :=
(is_limit.cone_point_unique_up_to_iso_inv_comp _ _ _).trans (by simp)

@[simp, reassoc]
lemma pullback_iso_unop_pushout_inv_snd {X Y Z : C} (f : X ⟶ Z)
  (g : Y ⟶ Z) [has_pullback f g] [has_pushout f.op g.op] :
  (pullback_iso_unop_pushout f g).inv ≫ pullback.snd =
    (pushout.inr : _ ⟶ pushout f.op g.op).unop :=
(is_limit.cone_point_unique_up_to_iso_inv_comp _ _ _).trans (by simp)

@[simp, reassoc]
lemma pullback_iso_unop_pushout_hom_inl {X Y Z : C} (f : X ⟶ Z)
  (g : Y ⟶ Z) [has_pullback f g] [has_pushout f.op g.op] :
  pushout.inl ≫ (pullback_iso_unop_pushout f g).hom.op = pullback.fst.op :=
begin
  apply quiver.hom.unop_inj,
  dsimp,
  rw [← pullback_iso_unop_pushout_inv_fst, iso.hom_inv_id_assoc],
end

@[simp, reassoc]

end pullback

section pushout

/-- The pushout of `f` and `g` in `C` is isomorphic to the pullback of
 `f.op` and `g.op` in `Cᵒᵖ`. -/
noncomputable
def pushout_iso_unop_pullback {X Y Z : C} (f : X ⟶ Z) (g : X ⟶ Y)
  [has_pushout f g] [has_pullback f.op g.op] : pushout f g ≅ unop (pullback f.op g.op) :=
is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit _)
  ((pullback_cone.is_limit_equiv_is_colimit_unop _) (limit.is_limit (cospan f.op g.op)))
.
@[simp, reassoc]
lemma pushout_iso_unop_pullback_inl_hom {X Y Z : C} (f : X ⟶ Z) (g : X ⟶ Y)
  [has_pushout f g] [has_pullback f.op g.op] :
  pushout.inl ≫ (pushout_iso_unop_pullback f g).hom =
    (pullback.fst : pullback f.op g.op ⟶ _).unop :=
(is_colimit.comp_cocone_point_unique_up_to_iso_hom _ _ _).trans (by simp)

@[simp, reassoc]
lemma pushout_iso_unop_pullback_inr_hom {X Y Z : C} (f : X ⟶ Z) (g : X ⟶ Y)
  [has_pushout f g] [has_pullback f.op g.op] :
  pushout.inr ≫ (pushout_iso_unop_pullback f g).hom =
    (pullback.snd : pullback f.op g.op ⟶ _).unop :=
(is_colimit.comp_cocone_point_unique_up_to_iso_hom _ _ _).trans (by simp)

@[simp]
lemma pushout_iso_unop_pullback_inv_fst {X Y Z : C} (f : X ⟶ Z) (g : X ⟶ Y)
  [has_pushout f g] [has_pullback f.op g.op] :
  (pushout_iso_unop_pullback f g).inv.op ≫ pullback.fst = pushout.inl.op :=
begin
  apply quiver.hom.unop_inj,
  dsimp,
  rw [← pushout_iso_unop_pullback_inl_hom, category.assoc, iso.hom_inv_id, category.comp_id],
end

@[simp]
lemma pushout_iso_unop_pullback_inv_snd {X Y Z : C} (f : X ⟶ Z) (g : X ⟶ Y)
  [has_pushout f g] [has_pullback f.op g.op] :
  (pushout_iso_unop_pullback f g).inv.op ≫ pullback.snd = pushout.inr.op :=
begin
  apply quiver.hom.unop_inj,
  dsimp,
  rw [← pushout_iso_unop_pullback_inr_hom, category.assoc, iso.hom_inv_id, category.comp_id],
end

end pushout

end category_theory.limits


/-
Copyright (c) 2014 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import algebra.order.monoid.with_top
import data.nat.basic

/-!
# Lemma about the coercion `ℕ → with_bot ℕ`.

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

An orphaned lemma about casting from `ℕ` to `with_bot ℕ`,
exiled here to minimize imports to `data.rat.order` for porting purposes.
-/

theorem nat.cast_with_top (n : ℕ) :
  @coe ℕ (with_top ℕ) (@coe_to_lift _ _ nat.cast_coe) n = n := rfl

theorem nat.cast_with_bot (n : ℕ) :
  @coe ℕ (with_bot ℕ) (@coe_to_lift _ _ nat.cast_coe) n = n := rfl


import for_mathlib.snake_lemma2
import category_theory.abelian.homology
import for_mathlib.exact_seq2

noncomputable theory

open category_theory category_theory.limits

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

namespace category_theory

local notation `kernel_map`   := kernel.map _ _ _ _
local notation `cokernel_map` := cokernel.map _ _ _ _

namespace snake

lemma col_exact_aux (X : cochain_complex 𝒜 ℤ) : exact_seq 𝒜
[ (kernel.ι (homological_complex.d_to X 0))
, (kernel.lift (homological_complex.d_from X 0)
    (homological_complex.d_to X 0) (by simp))
, (homology.π' (homological_complex.d_to X 0)
    (homological_complex.d_from X 0) (by simp))] :=
begin
  apply exact_seq.cons,
  { rw abelian.exact_iff,
    refine ⟨by { ext, simp }, _⟩,
    have :
      kernel.ι (kernel.lift (homological_complex.d_from X 0) (homological_complex.d_to X 0) _) =
      kernel.lift _ (kernel.ι _) _ ≫ kernel.ι (homological_complex.d_to X 0),
    by { simp },
    rw this,
    simp only [category.assoc, cokernel.condition, comp_zero],
    have : homological_complex.d_to X 0 =
      kernel.lift (homological_complex.d_from X 0) (homological_complex.d_to X 0) (by simp) ≫
      kernel.ι _, by simp,
    slice_lhs 2 3 { rw this },
    rw kernel.condition_assoc,
    simp },
  { rw ← exact_iff_exact_seq,
    change exact _ (_ ≫ _),
    rw exact_comp_iso,
    apply abelian.exact_cokernel }
end

lemma row_exact₁_aux (X Y Z : cochain_complex 𝒜 ℤ)
  (f : X ⟶ Y) (g : Y ⟶ Z) (h : exact (f.f (-1)) (g.f (-1)))
  [epi (g.f (-1))] [epi (g.f 0)] [epi (g.f 1)]
  [mono (f.f (-1))] [mono (f.f 0)] [mono (f.f 1)] :
  exact (homological_complex.hom.prev f 0) (homological_complex.hom.prev g 0) :=
begin
  rw [f.prev_eq, g.prev_eq],
  rotate 2, exact (-1), swap, exact (-1), simp, swap, simp,
  simp,
  rw [← category.assoc, exact_comp_iso],
  apply category_theory.exact_comp_inv_hom_comp _ h,
end

lemma row_exact₂_aux (X Y Z : cochain_complex 𝒜 ℤ)
  (f : X ⟶ Y) (g : Y ⟶ Z) (h0 : exact (f.f 0) (g.f 0)) (h1 : exact (f.f 1) (g.f 1))
  [epi (g.f (-1))] [epi (g.f 0)] [epi (g.f 1)]
  [mono (f.f (-1))] [mono (f.f 0)] [mono (f.f 1)] :
  exact
    (kernel.lift (homological_complex.d_from Y 0)
       (kernel.ι (homological_complex.d_from X 0) ≫ f.f 0)
       (by simp))
    (kernel.lift (homological_complex.d_from Z 0)
       (kernel.ι (homological_complex.d_from Y 0) ≫ g.f 0)
       (by simp)) :=
begin
  haveI : mono (homological_complex.hom.next f 0),
  { rw f.next_eq,
    rotate 2, exact 1, swap, simp,
    apply_with mono_comp { instances := ff },
    swap,
    apply_with mono_comp { instances := ff },
    all_goals { apply_instance } },
  have : exact (homological_complex.hom.next f 0) (homological_complex.hom.next g 0),
  { rw [f.next_eq, g.next_eq],
    rotate 2, exact 1, swap, exact 1, simp, swap, simp,
    simp,
    rw [← category.assoc, exact_comp_iso],
    apply category_theory.exact_comp_inv_hom_comp _ h1 },
  have S := mk_of_sequence_hom
    (X.X 0)
    (Y.X 0)
    (Z.X 0)
    (X.X_next 0)
    (Y.X_next 0)
    (Z.X_next 0)
    (f.f 0) (g.f 0) (X.d_from 0) (Y.d_from 0) (Z.d_from 0)
    (f.next 0) (g.next 0) (by simp) (by simp) h0 this,
  exact S.six_term_exact_seq.pair,
end

lemma mk_of_homology (X Y Z : cochain_complex 𝒜 ℤ)
  (f : X ⟶ Y) (g : Y ⟶ Z)
  (hn1 : exact (f.f (-1)) (g.f (-1))) (h0 : exact (f.f 0) (g.f 0)) (h1 : exact (f.f 1) (g.f 1))
  [epi (g.f (-1))] [epi (g.f 0)] [epi (g.f 1)]
  [mono (f.f (-1))] [mono (f.f 0)] [mono (f.f 1)] :
  snake
  -- the objects
         (kernel (X.d_to 0))             (kernel (Y.d_to 0))              (kernel (Z.d_to 0))
            (X.X_prev 0)                    (Y.X_prev 0)                     (Z.X_prev 0)
        (kernel (X.d_from 0))           (kernel (Y.d_from 0))            (kernel (Z.d_from 0))
  ((homology_functor _ _ 0).obj X) ((homology_functor _ _ 0).obj Y) ((homology_functor _ _ 0).obj Z)
  -- the maps
  (kernel.map _ _ (f.prev _) (f.f _) (by simp)) (kernel.map _ _ (g.prev _) (g.f _) (by simp))
  (kernel.ι _) (kernel.ι _) (kernel.ι _)
  (f.prev _) (g.prev _)
  (kernel.lift _ (X.d_to _) (by simp)) (kernel.lift _ (Y.d_to _) (by simp)) (kernel.lift _ (Z.d_to _) (by simp))
  (kernel.map _ _ (f.f _) (f.next _) (by simp)) (kernel.map _ _ (g.f _) (g.next _) (by simp))
  (homology.π' _ _ _) (homology.π' _ _ _) (homology.π' _ _ _)
  ((homology_functor _ _ _).map f) ((homology_functor _ _ _).map g) :=
{ row_exact₁ := row_exact₁_aux _ _ _ _ _ hn1,
  row_exact₂ := row_exact₂_aux _ _ _ _ _ h0 h1,
  row_epi := begin
    rw g.prev_eq,
    rotate 2, exact (-1),
    swap, simp,
    apply_with epi_comp { instances := ff },
    swap,
    apply_with epi_comp { instances := ff },
    all_goals { apply_instance }
  end,
  row_mono := infer_instance,
  col_exact_a := col_exact_aux _,
  col_exact_b := col_exact_aux _,
  col_exact_c := col_exact_aux _,
  col_mono_a := infer_instance,
  col_mono_b := infer_instance,
  col_mono_c := infer_instance,
  col_epi_a := epi_comp _ _,
  col_epi_b := epi_comp _ _,
  col_epi_c := epi_comp _ _,
  sq_a₀ := by simp,
  sq_b₀ := by simp,
  sq_a₁ := by { ext, simp },
  sq_b₁ := by { ext, simp },
  sq_a₂ := by simp,
  sq_b₂ := by simp }

end snake

end category_theory


/-
Copyright (c) 2022 Mario Carneiro, Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Heather Macbeth, Yaël Dillies
-/
import Std.Lean.Parser
import Mathlib.Tactic.NormNum.Core
import Mathlib.Tactic.Clear!
import Mathlib.Order.Basic
import Mathlib.Algebra.Order.Invertible
import Mathlib.Algebra.Order.Ring.Defs
import Mathlib.Data.Nat.Cast.Basic
import Qq

/-!
## `positivity` core functionality

This file sets up the `positivity` tactic and the `@[positivity]` attribute,
which allow for plugging in new positivity functionality around a positivity-based driver.
The actual behavior is in `@[positivity]`-tagged definitions in `Tactic.Positivity.Basic`
and elsewhere.
-/
open Lean hiding Rat
open Lean.Meta Qq Lean.Elab Term

/-- Attribute for identifying `positivity` extensions. -/
syntax (name := positivity) "positivity" term,+ : attr

lemma ne_of_ne_of_eq' (hab : (a : α) ≠ c) (hbc : a = b) : b ≠ c := hbc ▸ hab

namespace Mathlib.Meta.Positivity

instance : Repr (QQ α) := inferInstanceAs (Repr Expr)

variable {α : Q(Type u)} (zα : Q(Zero $α)) (pα : Q(PartialOrder $α))

/-- The result of `positivity` running on an expression `e` of type `α`. -/
inductive Strictness (e : Q($α)) where
  | positive (pf : Q(0 < $e))
  | nonnegative (pf : Q(0 ≤ $e))
  | nonzero (pf : Q($e ≠ 0))
  | none
  deriving Repr

/-- Gives a generic description of the `positivity` result. -/
def Strictness.toString : Strictness zα pα e → String
  | positive _ => "positive"
  | nonnegative _ => "nonnegative"
  | nonzero _ => "nonzero"
  | none => "none"

/-- An extension for `positivity`. -/
structure PositivityExt where
  /-- Attempts to prove a expression `e : α` is `>0`, `≥0`, or `≠0`. -/
  eval {u} {α : Q(Type u)} (zα : Q(Zero $α)) (pα : Q(PartialOrder $α)) (e : Q($α)) :
    MetaM (Strictness zα pα e)

/-- Read a `positivity` extension from a declaration of the right type. -/
def mkPositivityExt (n : Name) : ImportM PositivityExt := do
  let { env, opts, .. } ← read
  IO.ofExcept <| unsafe env.evalConstCheck PositivityExt opts ``PositivityExt n

/-- Each `positivity` extension is labelled with a collection of patterns
which determine the expressions to which it should be applied. -/
abbrev Entry := Array (Array (DiscrTree.Key true)) × Name

/-- Environment extensions for `positivity` declarations -/
initialize positivityExt : PersistentEnvExtension Entry (Entry × PositivityExt)
    (List Entry × DiscrTree PositivityExt true) ←
  -- we only need this to deduplicate entries in the DiscrTree
  have : BEq PositivityExt := ⟨fun _ _ => false⟩
  let insert kss v dt := kss.foldl (fun dt ks => dt.insertCore ks v) dt
  registerPersistentEnvExtension {
    mkInitial := pure ([], {})
    addImportedFn := fun s => do
      let dt ← s.foldlM (init := {}) fun dt s => s.foldlM (init := dt) fun dt (kss, n) => do
        pure (insert kss (← mkPositivityExt n) dt)
      pure ([], dt)
    addEntryFn := fun (entries, s) ((kss, n), ext) => ((kss, n) :: entries, insert kss ext s)
    exportEntriesFn := fun s => s.1.reverse.toArray
  }

initialize registerBuiltinAttribute {
  name := `positivity
  descr := "adds a positivity extension"
  applicationTime := .afterCompilation
  add := fun declName stx kind => match stx with
    | `(attr| positivity $es,*) => do
      unless kind == AttributeKind.global do
        throwError "invalid attribute 'positivity', must be global"
      let env ← getEnv
      unless (env.getModuleIdxFor? declName).isNone do
        throwError "invalid attribute 'positivity', declaration is in an imported module"
      if (IR.getSorryDep env declName).isSome then return -- ignore in progress definitions
      let ext ← mkPositivityExt declName
      let keys ← MetaM.run' <| es.getElems.mapM fun stx => do
        let e ← TermElabM.run' <| withSaveInfoContext <| withAutoBoundImplicit <|
          withReader ({ · with ignoreTCFailures := true }) do
            let e ← elabTerm stx none
            let (_, _, e) ← lambdaMetaTelescope (← mkLambdaFVars (← getLCtx).getFVars e)
            return e
        DiscrTree.mkPath e
      setEnv <| positivityExt.addEntry env ((keys, declName), ext)
    | _ => throwUnsupportedSyntax
}

lemma lt_of_le_of_ne' [PartialOrder A] :
    (a : A) ≤ b → b ≠ a → a < b := fun h₁ h₂ => lt_of_le_of_ne h₁ h₂.symm

lemma pos_of_isNat [StrictOrderedSemiring A]
    (h : NormNum.IsNat e n) (w : Nat.ble 1 n = true) : 0 < (e : A) := by
  rw [NormNum.IsNat.to_eq h rfl]
  apply Nat.cast_pos.2
  simpa using w

lemma nonneg_of_isNat [OrderedSemiring A]
    (h : NormNum.IsNat e n) : 0 ≤ (e : A) := by
  rw [NormNum.IsNat.to_eq h rfl]
  exact Nat.cast_nonneg n

lemma nz_of_isNegNat [StrictOrderedRing A]
    (h : NormNum.IsInt e (.negOfNat n)) (w : Nat.ble 1 n = true) : (e : A) ≠ 0 := by
  rw [NormNum.IsInt.neg_to_eq h rfl]
  simp only [ne_eq, neg_eq_zero]
  apply ne_of_gt
  simpa using w

lemma pos_of_isRat [LinearOrderedRing A] :
    (NormNum.IsRat e n d) → (decide (0 < n)) → (0 < (e : A))
  | ⟨inv, eq⟩, h => by
    have pos_invOf_d : (0 < ⅟ (d : A)) := pos_invOf_of_invertible_cast d
    have pos_n : (0 < (n : A)) := Int.cast_pos (n := n) |>.2 (of_decide_eq_true h)
    rw [eq]
    exact mul_pos pos_n pos_invOf_d

lemma nonneg_of_isRat [LinearOrderedRing A] :
    (NormNum.IsRat e n d) → (decide (n = 0)) → (0 ≤ (e : A))
  | ⟨inv, eq⟩, h => by rw [eq, of_decide_eq_true h]; simp

lemma nz_of_isRat [LinearOrderedRing A] :
    (NormNum.IsRat e n d) → (decide (n < 0)) → ((e : A) ≠ 0)
  | ⟨inv, eq⟩, h => by
    have pos_invOf_d : (0 < ⅟ (d : A)) := pos_invOf_of_invertible_cast d
    have neg_n : ((n : A) < 0) := Int.cast_lt_zero (n := n) |>.2 (of_decide_eq_true h)
    have neg := mul_neg_of_neg_of_pos neg_n pos_invOf_d
    rw [eq]
    exact ne_iff_lt_or_gt.2 (Or.inl neg)

variable {zα pα} in
/-- Converts a `MetaM Strictness` which can fail
into one that never fails and returns `.none` instead. -/
def catchNone (t : MetaM (Strictness zα pα e)) : MetaM (Strictness zα pα e) :=
  try t catch e =>
    trace[Tactic.positivity.failure] "{e.toMessageData}"
    pure .none

variable {zα pα} in
/-- Converts a `MetaM Strictness` which can return `.none`
into one which never returns `.none` but fails instead. -/
def throwNone [Monad m] [Alternative m]
    (t : m (Strictness zα pα e)) : m (Strictness zα pα e) := do
  match ← t with
  | .none => failure
  | r => pure r

/-- Attempts to prove a `Strictness` result when `e` evaluates to a literal number. -/
def normNumPositivity (e : Q($α)) : MetaM (Strictness zα pα e) := catchNone do
  match ← NormNum.derive e with
  | .isBool .. => failure
  | .isNat _ lit p =>
    if 0 < lit.natLit! then
      let _a ← synthInstanceQ (q(StrictOrderedSemiring $α) : Q(Type u))
      assumeInstancesCommute
      have p : Q(NormNum.IsNat $e $lit) := p
      let p' : Q(Nat.ble 1 $lit = true) := (q(Eq.refl true) : Expr)
      pure (.positive (q(@pos_of_isNat $α _ _ _ $p $p') : Expr))
    else
      let _a ← synthInstanceQ (q(OrderedSemiring $α) : Q(Type u))
      assumeInstancesCommute
      have p : Q(NormNum.IsNat $e $lit) := p
      pure (.nonnegative (q(nonneg_of_isNat $p) : Expr))
  | .isNegNat _ lit p =>
    let _a ← synthInstanceQ (q(StrictOrderedRing $α) : Q(Type u))
    assumeInstancesCommute
    have p : Q(NormNum.IsInt $e (Int.negOfNat $lit)) := p
    let p' : Q(Nat.ble 1 $lit = true) := (q(Eq.refl true) : Expr)
    pure (.nonzero (q(nz_of_isNegNat $p $p') : Expr))
  | .isRat i q n d p =>
    let _a ← synthInstanceQ (q(LinearOrderedRing $α) : Q(Type u))
    have p : Q(by clear! «$i»; exact NormNum.IsRat $e $n $d) := p
    if 0 < q then
      let w : Q(decide (0 < $n) = true) := (q(Eq.refl true) : Expr)
      pure (.positive (q(pos_of_isRat $p $w) : Expr))
    else if q = 0 then -- should not be reachable, but just in case
      let w : Q(decide ($n = 0) = true) := (q(Eq.refl true) : Expr)
      pure (.nonnegative (q(nonneg_of_isRat $p $w) : Expr))
    else
      let w : Q(decide ($n < 0) = true) := (q(Eq.refl true) : Expr)
      pure (.nonzero (q(nz_of_isRat $p $w) : Expr))

/-- Attempts to prove that `e ≥ 0` using `zero_le` in a `CanonicallyOrderedAddMonoid`. -/
def positivityCanon (e : Q($α)) : MetaM (Strictness zα pα e) := do
  let _ ← synthInstanceQ (q(CanonicallyOrderedAddMonoid $α) : Q(Type u))
  pure (.nonnegative (q(zero_le $e) : Expr))

/-- A variation on `assumption` when the hypothesis is `lo ≤ e` where `lo` is a numeral. -/
def compareHypLE (lo e : Q($α)) (p₂ : Q($lo ≤ $e)) : MetaM (Strictness zα pα e) := do
  match ← normNumPositivity zα pα lo with
  | .positive p₁ => pure (.positive q(lt_of_lt_of_le $p₁ $p₂))
  | .nonnegative p₁ => pure (.nonnegative q(le_trans $p₁ $p₂))
  | _ => pure .none

/-- A variation on `assumption` when the hypothesis is `lo < e` where `lo` is a numeral. -/
def compareHypLT (lo e : Q($α)) (p₂ : Q($lo < $e)) : MetaM (Strictness zα pα e) := do
  match ← normNumPositivity zα pα lo with
  | .positive p₁ => pure (.positive q(lt_trans $p₁ $p₂))
  | .nonnegative p₁ => pure (.positive q(lt_of_le_of_lt $p₁ $p₂))
  | _ => pure .none

/-- A variation on `assumption` when the hypothesis is `a = b` where `a` is a numeral. -/
def compareHypEq (e a b : Q($α)) (p₂ : Q($a = $b)) : MetaM (Strictness zα pα e) := do
  let .true ← isDefEq e b | return .none
  match ← normNumPositivity zα pα a with
  | .positive p₁ => pure (.positive (q(lt_of_lt_of_eq $p₁ $p₂) : Expr))
  | .nonnegative p₁ => pure (.nonnegative (q(le_of_le_of_eq $p₁ $p₂) : Expr))
  | .nonzero p₁ => pure (.nonzero (q(ne_of_ne_of_eq' $p₁ $p₂) : Expr))
  | .none => pure .none

initialize registerTraceClass `Tactic.positivity
initialize registerTraceClass `Tactic.positivity.failure

/-- A variation on `assumption` which checks if the hypothesis `ldecl` is `a [</≤/=] e`
where `a` is a numeral. -/
def compareHyp (e : Q($α)) (ldecl : LocalDecl) : MetaM (Strictness zα pα e) := do
  have e' : Q(Prop) := ldecl.type
  match e' with
  | ~q(@LE.le _ $_a $lo $hi) =>
    guard <| ← isDefEq e hi
    compareHypLE zα pα lo e (.fvar ldecl.fvarId)
  | ~q(@LT.lt _ $_a $lo $hi) =>
    guard <| ← isDefEq e hi
    compareHypLT zα pα lo e (.fvar ldecl.fvarId)
  | ~q(($lo : $α') = $hi) =>
    let .true ← isDefEq α α' | return .none
    let p : Q($lo = $hi) := .fvar ldecl.fvarId
    match ← compareHypEq zα pα e lo hi p with
    | .none => compareHypEq zα pα e hi lo (q(Eq.symm $p) : Expr)
    | result => pure result
  | ~q(($a : $α') ≠ $b) =>
    let .true ← isDefEq α α' | return .none
    if ← isDefEq q((0 : $α)) a then
      let .true ← isDefEq e b | return .none
      let p : Q(0 ≠ $e) := .fvar ldecl.fvarId
      pure (.nonzero q(Ne.symm $p))
    else
      let .true ← isDefEq q((0 : $α)) b | return .none
      let .true ← isDefEq e a | return .none
      pure (.nonzero (.fvar ldecl.fvarId))
  | _ => pure .none

variable {zα pα} in
/-- The main combinator which combines multiple `positivity` results.
It assumes `t₁` has already been run for a result, and runs `t₂` and takes the best result.
It will skip `t₂` if `t₁` is already a proof of `.positive`, and can also combine
`.nonnegative` and `.nonzero` to produce a `.positive` result. -/
def orElse (t₁ : Strictness zα pα e) (t₂ : MetaM (Strictness zα pα e)) :
    MetaM (Strictness zα pα e) := do
  match t₁ with
  | .none => catchNone t₂
  | p@(.positive _) => pure p
  | .nonnegative p₁ =>
    match ← catchNone t₂ with
    | p@(.positive _) => pure p
    | .nonzero p₂ => pure (.positive q(lt_of_le_of_ne' $p₁ $p₂))
    | _ => pure (.nonnegative p₁)
  | .nonzero p₁ =>
    match ← catchNone t₂ with
    | p@(.positive _) => pure p
    | .nonnegative p₂ => pure (.positive q(lt_of_le_of_ne' $p₂ $p₁))
    | _ => pure (.nonzero p₁)

/-- Run each registered `positivity` extension on an expression, returning a `NormNum.Result`. -/
def core (e : Q($α)) : MetaM (Strictness zα pα e) := do
  let mut result := .none
  trace[Tactic.positivity] "trying to prove positivity of {e}"
  for ext in ← (positivityExt.getState (← getEnv)).2.getMatch e do
    try
      result ← orElse result <| ext.eval zα pα e
    catch err =>
      trace[Tactic.positivity] "{e} failed: {err.toMessageData}"
  result ← orElse result <| normNumPositivity zα pα e
  result ← orElse result <| positivityCanon zα pα e
  if let .positive _ := result then
    trace[Tactic.positivity] "{e} => {result.toString}"
    return result
  for ldecl in ← getLCtx do
    if !ldecl.isImplementationDetail then
      result ← orElse result <| compareHyp zα pα e ldecl
  trace[Tactic.positivity] "{e} => {result.toString}"
  throwNone (pure result)

private inductive OrderRel : Type
| le : OrderRel -- `0 ≤ a`
| lt : OrderRel -- `0 < a`
| ne : OrderRel -- `a ≠ 0`
| ne' : OrderRel -- `0 ≠ a`

end Meta.Positivity
namespace Meta.Positivity

/-- The main entry point to the `positivity` tactic. Given a goal `goal` of the form `0 [≤/</≠] e`,
attempts to recurse on the structure of `e` to prove the goal.
It will either close `goal` or fail. -/
def positivity (goal : MVarId) : MetaM Unit := do
  let t : Q(Prop) ← withReducible goal.getType'
  let rest {u : Level} (α : Q(Type u)) z e (relDesired : OrderRel) : MetaM Unit := do
    let zα ← synthInstanceQ (q(Zero $α) : Q(Type u))
    let .true ← isDefEq z q((0 : $α)) | throwError "not a positivity goal"
    let pα ← synthInstanceQ (q(PartialOrder $α) : Q(Type u))
    let r ← catchNone <| Meta.Positivity.core zα pα e
    let throw (a b : String) : MetaM Expr := throwError
      "failed to prove {a}, but it would be possible to prove {b} if desired"
    let p ← show MetaM Expr from match relDesired, r with
    | .lt, .positive p
    | .le, .nonnegative p
    | .ne, .nonzero p => pure p
    | .le, .positive p => pure q(le_of_lt $p)
    | .ne, .positive p => pure q(ne_of_gt $p)
    | .ne', .positive p => pure q(ne_of_lt $p)
    | .ne', .nonzero p => pure q(Ne.symm $p)
    | .lt, .nonnegative _ => throw "strict positivity" "nonnegativity"
    | .lt, .nonzero _ => throw "strict positivity" "nonzeroness"
    | .le, .nonzero _ => throw "nonnegativity" "nonzeroness"
    | .ne, .nonnegative _
    | .ne', .nonnegative _ => throw "nonzeroness" "nonnegativity"
    | _, .none => throwError "failed to prove positivity/nonnegativity/nonzeroness"
    goal.assign p
  match t with
  | ~q(@LE.le $α $_a $z $e) => rest α z e .le
  | ~q(@LT.lt $α $_a $z $e) => rest α z e .lt
  | ~q($a ≠ ($b : ($α : Type _))) =>
    let _zα ← synthInstanceQ (q(Zero $α) : Q(Type u_1))
    if ← isDefEq b q((0 : $α)) then
      rest α b a .ne
    else
      let .true ← isDefEq a q((0 : $α)) | throwError "not a positivity goal"
      rest α a b .ne'
  | _ => throwError "not a positivity goal"

end Meta.Positivity

namespace Tactic.Positivity

open Lean Elab Tactic

/-- Tactic solving goals of the form `0 ≤ x`, `0 < x` and `x ≠ 0`.  The tactic works recursively
according to the syntax of the expression `x`, if the atoms composing the expression all have
numeric lower bounds which can be proved positive/nonnegative/nonzero by `norm_num`.  This tactic
either closes the goal or fails.

Examples:
```
example {a : ℤ} (ha : 3 < a) : 0 ≤ a ^ 3 + a := by positivity

example {a : ℤ} (ha : 1 < a) : 0 < |(3:ℤ) + a| := by positivity

example {b : ℤ} : 0 ≤ max (-3) (b ^ 2) := by positivity
```
-/
elab (name := positivity) "positivity" : tactic => do
  liftMetaTactic fun g => do Meta.Positivity.positivity g; pure []


import category_theory.preadditive.opposite

namespace category_theory

variables {C : Type*} [category C] [preadditive C] {X Y : C}

@[simps] def op_hom (X Y : C) : (X ⟶ Y) →+ (opposite.op Y ⟶ opposite.op X) :=
add_monoid_hom.mk' (λ f, f.op) $ λ f g, op_add _ f g

lemma op_sum {ι : Type*} (s : finset ι) (f : ι → (X ⟶ Y)) :
  (s.sum f).op = s.sum (λ i, (f i).op) :=
(op_hom X Y).map_sum _ _

lemma op_zsmul (k : ℤ) (f : X ⟶ Y) : (k • f).op = k • f.op := rfl

-- lemma op_neg (f : X ⟶ Y) : (-f).op = -(f.op) := rfl

end category_theory