/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.category.Module.basic
import group_theory.quotient_group
import category_theory.limits.concrete_category
import category_theory.limits.shapes.kernels
import category_theory.limits.shapes.concrete_category

/-!
# The category of R-modules has all colimits.

This file uses a "pre-automated" approach, just as for `Mon/colimits.lean`.

Note that finite colimits can already be obtained from the instance `abelian (Module R)`.

TODO:
In fact, in `Module R` there is a much nicer model of colimits as quotients
of finitely supported functions, and we really should implement this as well (or instead).
-/

universes u v

open category_theory
open category_theory.limits

variables {R : Type v} [ring R]

-- [ROBOT VOICE]:
-- You should pretend for now that this file was automatically generated.
-- It follows the same template as colimits in Mon.

namespace Module.colimits
/-!
We build the colimit of a diagram in `Module` by constructing the
free group on the disjoint union of all the abelian groups in the diagram,
then taking the quotient by the abelian group laws within each abelian group,
and the identifications given by the morphisms in the diagram.
-/

variables {J : Type v} [small_category J] (F : J ⥤ Module.{v} R)

/--
An inductive type representing all module expressions (without relations)
on a collection of types indexed by the objects of `J`.
-/
inductive prequotient
-- There's always `of`
| of : Π (j : J) (x : F.obj j), prequotient
-- Then one generator for each operation
| zero : prequotient
| neg : prequotient → prequotient
| add : prequotient → prequotient → prequotient
| smul : R → prequotient → prequotient

instance : inhabited (prequotient F) := ⟨prequotient.zero⟩

open prequotient

/--
The relation on `prequotient` saying when two expressions are equal
because of the module laws, or
because one element is mapped to another by a morphism in the diagram.
-/
inductive relation : prequotient F → prequotient F → Prop
-- Make it an equivalence relation:
| refl : Π (x), relation x x
| symm : Π (x y) (h : relation x y), relation y x
| trans : Π (x y z) (h : relation x y) (k : relation y z), relation x z
-- There's always a `map` relation
| map : Π (j j' : J) (f : j ⟶ j') (x : F.obj j), relation (of j' (F.map f x)) (of j x)
-- Then one relation per operation, describing the interaction with `of`
| zero : Π (j), relation (of j 0) zero
| neg : Π (j) (x : F.obj j), relation (of j (-x)) (neg (of j x))
| add : Π (j) (x y : F.obj j), relation (of j (x + y)) (add (of j x) (of j y))
| smul : Π (j) (s) (x : F.obj j), relation (of j (s • x)) (smul s (of j x))
-- Then one relation per argument of each operation
| neg_1 : Π (x x') (r : relation x x'), relation (neg x) (neg x')
| add_1 : Π (x x' y) (r : relation x x'), relation (add x y) (add x' y)
| add_2 : Π (x y y') (r : relation y y'), relation (add x y) (add x y')
| smul_1 : Π (s) (x x') (r : relation x x'), relation (smul s x) (smul s x')
-- And one relation per axiom
| zero_add      : Π (x), relation (add zero x) x
| add_zero      : Π (x), relation (add x zero) x
| add_left_neg  : Π (x), relation (add (neg x) x) zero
| add_comm      : Π (x y), relation (add x y) (add y x)
| add_assoc     : Π (x y z), relation (add (add x y) z) (add x (add y z))
| one_smul      : Π (x), relation (smul 1 x) x
| mul_smul      : Π (s t) (x), relation (smul (s * t) x) (smul s (smul t x))
| smul_add      : Π (s) (x y), relation (smul s (add x y)) (add (smul s x) (smul s y))
| smul_zero     : Π (s), relation (smul s zero) zero
| add_smul      : Π (s t) (x), relation (smul (s + t) x) (add (smul s x) (smul t x))
| zero_smul     : Π (x), relation (smul 0 x) zero

/--
The setoid corresponding to module expressions modulo module relations and identifications.
-/
def colimit_setoid : setoid (prequotient F) :=
{ r := relation F, iseqv := ⟨relation.refl, relation.symm, relation.trans⟩ }
attribute [instance] colimit_setoid

/--
The underlying type of the colimit of a diagram in `Module R`.
-/
@[derive inhabited]
def colimit_type : Type v := quotient (colimit_setoid F)

instance : add_comm_group (colimit_type F) :=
{ zero :=
  begin
    exact quot.mk _ zero
  end,
  neg :=
  begin
    fapply @quot.lift,
    { intro x,
      exact quot.mk _ (neg x) },
    { intros x x' r,
      apply quot.sound,
      exact relation.neg_1 _ _ r },
  end,
  add :=
  begin
    fapply @quot.lift _ _ ((colimit_type F) → (colimit_type F)),
    { intro x,
      fapply @quot.lift,
      { intro y,
        exact quot.mk _ (add x y) },
      { intros y y' r,
        apply quot.sound,
        exact relation.add_2 _ _ _ r } },
    { intros x x' r,
      funext y,
      induction y,
      dsimp,
      apply quot.sound,
      { exact relation.add_1 _ _ _ r },
      { refl } },
  end,
  zero_add := λ x,
  begin
    induction x,
    dsimp,
    apply quot.sound,
    apply relation.zero_add,
    refl,
  end,
  add_zero := λ x,
  begin
    induction x,
    dsimp,
    apply quot.sound,
    apply relation.add_zero,
    refl,
  end,
  add_left_neg := λ x,
  begin
    induction x,
    dsimp,
    apply quot.sound,
    apply relation.add_left_neg,
    refl,
  end,
  add_comm := λ x y,
  begin
    induction x,
    induction y,
    dsimp,
    apply quot.sound,
    apply relation.add_comm,
    refl,
    refl,
  end,
  add_assoc := λ x y z,
  begin
    induction x,
    induction y,
    induction z,
    dsimp,
    apply quot.sound,
    apply relation.add_assoc,
    refl,
    refl,
    refl,
  end, }

instance : module R (colimit_type F) :=
{ smul := λ s,
  begin
    fapply @quot.lift,
    { intro x,
      exact quot.mk _ (smul s x) },
    { intros x x' r,
      apply quot.sound,
      exact relation.smul_1 s _ _ r },
  end,
  one_smul := λ x,
  begin
    induction x,
    dsimp,
    apply quot.sound,
    apply relation.one_smul,
    refl,
  end,
  mul_smul := λ s t x,
  begin
    induction x,
    dsimp,
    apply quot.sound,
    apply relation.mul_smul,
    refl,
  end,
  smul_add := λ s x y,
  begin
    induction x,
    induction y,
    dsimp,
    apply quot.sound,
    apply relation.smul_add,
    refl,
    refl,
  end,
  smul_zero := λ s, begin apply quot.sound, apply relation.smul_zero, end,
  add_smul := λ s t x,
  begin
    induction x,
    dsimp,
    apply quot.sound,
    apply relation.add_smul,
    refl,
  end,
  zero_smul := λ x,
  begin
    induction x,
    dsimp,
    apply quot.sound,
    apply relation.zero_smul,
    refl,
  end, }

@[simp] lemma quot_zero : quot.mk setoid.r zero = (0 : colimit_type F) := rfl
@[simp] lemma quot_neg (x) :
  quot.mk setoid.r (neg x) = (-(quot.mk setoid.r x) : colimit_type F) := rfl
@[simp] lemma quot_add (x y) :
  quot.mk setoid.r (add x y) = ((quot.mk setoid.r x) + (quot.mk setoid.r y) : colimit_type F) := rfl
@[simp] lemma quot_smul (s x) :
  quot.mk setoid.r (smul s x) = (s • (quot.mk setoid.r x) : colimit_type F) := rfl

/-- The bundled module giving the colimit of a diagram. -/
def colimit : Module R := Module.of R (colimit_type F)

/-- The function from a given module in the diagram to the colimit module. -/
def cocone_fun (j : J) (x : F.obj j) : colimit_type F :=
quot.mk _ (of j x)

/-- The group homomorphism from a given module in the diagram to the colimit module. -/
def cocone_morphism (j : J) : F.obj j ⟶ colimit F :=
{ to_fun := cocone_fun F j,
  map_smul' := by { intros, apply quot.sound, apply relation.smul, },
  map_add' := by intros; apply quot.sound; apply relation.add }

@[simp] lemma cocone_naturality {j j' : J} (f : j ⟶ j') :
  F.map f ≫ (cocone_morphism F j') = cocone_morphism F j :=
begin
  ext,
  apply quot.sound,
  apply relation.map,
end

@[simp] lemma cocone_naturality_components (j j' : J) (f : j ⟶ j') (x : F.obj j):
  (cocone_morphism F j') (F.map f x) = (cocone_morphism F j) x :=
by { rw ←cocone_naturality F f, refl }

/-- The cocone over the proposed colimit module. -/
def colimit_cocone : cocone F :=
{ X := colimit F,
  ι :=
  { app := cocone_morphism F } }.

/-- The function from the free module on the diagram to the cone point of any other cocone. -/
@[simp] def desc_fun_lift (s : cocone F) : prequotient F → s.X
| (of j x)  := (s.ι.app j) x
| zero      := 0
| (neg x)   := -(desc_fun_lift x)
| (add x y) := desc_fun_lift x + desc_fun_lift y
| (smul s x) := s • (desc_fun_lift x)

/-- The function from the colimit module to the cone point of any other cocone. -/
def desc_fun (s : cocone F) : colimit_type F → s.X :=
begin
  fapply quot.lift,
  { exact desc_fun_lift F s },
  { intros x y r,
    induction r; try { dsimp },
    -- refl
    { refl },
    -- symm
    { exact r_ih.symm },
    -- trans
    { exact eq.trans r_ih_h r_ih_k },
    -- map
    { simp, },
    -- zero
    { simp, },
    -- neg
    { simp, },
    -- add
    { simp, },
    -- smul,
    { simp, },
    -- neg_1
    { rw r_ih, },
    -- add_1
    { rw r_ih, },
    -- add_2
    { rw r_ih, },
    -- smul_1
    { rw r_ih, },
    -- zero_add
    { rw zero_add, },
    -- add_zero
    { rw add_zero, },
    -- add_left_neg
    { rw add_left_neg, },
    -- add_comm
    { rw add_comm, },
    -- add_assoc
    { rw add_assoc, },
    -- one_smul
    { rw one_smul, },
    -- mul_smul
    { rw mul_smul, },
    -- smul_add
    { rw smul_add, },
    -- smul_zero
    { rw smul_zero, },
    -- add_smul
    { rw add_smul, },
    -- zero_smul
    { rw zero_smul, },  }
end

/-- The group homomorphism from the colimit module to the cone point of any other cocone. -/
def desc_morphism (s : cocone F) : colimit F ⟶ s.X :=
{ to_fun := desc_fun F s,
  map_smul' := λ s x, by { induction x; refl, },
  map_add' := λ x y, by { induction x; induction y; refl }, }

/-- Evidence that the proposed colimit is the colimit. -/
def colimit_cocone_is_colimit : is_colimit (colimit_cocone F) :=
{ desc := λ s, desc_morphism F s,
  uniq' := λ s m w,
  begin
    ext,
    induction x,
    induction x,
    { have w' := congr_fun (congr_arg (λ f : F.obj x_j ⟶ s.X, (f : F.obj x_j → s.X)) (w x_j)) x_x,
      erw w',
      refl, },
    { simp *, },
    { simp *, },
    { simp *, },
    { simp *, },
    refl
  end }.

instance has_colimits_Module : has_colimits (Module R) :=
{ has_colimits_of_shape := λ J 𝒥, by exactI
  { has_colimit := λ F, has_colimit.mk
    { cocone := colimit_cocone F,
      is_colimit := colimit_cocone_is_colimit F } } }

end Module.colimits


import .snake_lemma
import .exact_seq2

noncomputable theory

open category_theory category_theory.limits

variables {𝒜 : Type*} [category 𝒜] [abelian 𝒜]
variables (A₀ B₀ C₀ : 𝒜)
variables (A₁ B₁ C₁ : 𝒜)
variables (A₂ B₂ C₂ : 𝒜)
variables (A₃ B₃ C₃ : 𝒜)
variables (f₀ : A₀ ⟶ B₀) (g₀ : B₀ ⟶ C₀)
variables (a₀ : A₀ ⟶ A₁) (b₀ : B₀ ⟶ B₁) (c₀ : C₀ ⟶ C₁)
variables (f₁ : A₁ ⟶ B₁) (g₁ : B₁ ⟶ C₁)
variables (a₁ : A₁ ⟶ A₂) (b₁ : B₁ ⟶ B₂) (c₁ : C₁ ⟶ C₂)
variables (f₂ : A₂ ⟶ B₂) (g₂ : B₂ ⟶ C₂)
variables (a₂ : A₂ ⟶ A₃) (b₂ : B₂ ⟶ B₃) (c₂ : C₂ ⟶ C₃)
variables (f₃ : A₃ ⟶ B₃) (g₃ : B₃ ⟶ C₃)

namespace category_theory

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

structure snake : Prop :=
(row_exact₁ : exact f₁ g₁)
(row_exact₂ : exact f₂ g₂)
[row_epi : epi g₁]
[row_mono : mono f₂]
(col_exact_a : exact_seq 𝒜 [a₀, a₁, a₂])
(col_exact_b : exact_seq 𝒜 [b₀, b₁, b₂])
(col_exact_c : exact_seq 𝒜 [c₀, c₁, c₂])
[col_mono_a : mono a₀]
[col_mono_b : mono b₀]
[col_mono_c : mono c₀]
[col_epi_a : epi a₂]
[col_epi_b : epi b₂]
[col_epi_c : epi c₂]
(sq_a₀ : a₀ ≫ f₁ = f₀ ≫ b₀)
(sq_b₀ : b₀ ≫ g₁ = g₀ ≫ c₀)
(sq_a₁ : a₁ ≫ f₂ = f₁ ≫ b₁)
(sq_b₁ : b₁ ≫ g₂ = g₁ ≫ c₁)
(sq_a₂ : a₂ ≫ f₃ = f₂ ≫ b₂)
(sq_b₂ : b₂ ≫ g₃ = g₂ ≫ c₂)

namespace snake

lemma mk_of_sequence_hom (sq₁ : a₁ ≫ f₂ = f₁ ≫ b₁) (sq₂ : b₁ ≫ g₂ = g₁ ≫ c₁)
  (h₁ : exact f₁ g₁) (h₂ : exact f₂ g₂) [epi g₁] [mono f₂] : snake
  (kernel a₁) (kernel b₁) (kernel c₁)
  A₁ B₁ C₁
  A₂ B₂ C₂
  (cokernel a₁) (cokernel b₁) (cokernel c₁)
  (kernel_map sq₁) (kernel_map sq₂)
  (kernel.ι _) (kernel.ι _) (kernel.ι _)
  f₁ g₁
  a₁ b₁ c₁
  f₂ g₂
  (cokernel.π _) (cokernel.π _) (cokernel.π _)
  (cokernel_map sq₁) (cokernel_map sq₂) :=
{ row_exact₁ := h₁,
  row_exact₂ := h₂,
  col_exact_a := exact_seq.cons _ _ exact_kernel_ι _ $ (exact_iff_exact_seq _ _).mp (abelian.exact_cokernel _),
  col_exact_b := exact_seq.cons _ _ exact_kernel_ι _ $ (exact_iff_exact_seq _ _).mp (abelian.exact_cokernel _),
  col_exact_c := exact_seq.cons _ _ exact_kernel_ι _ $ (exact_iff_exact_seq _ _).mp (abelian.exact_cokernel _),
  sq_a₀ := (limits.kernel.lift_ι _ _ _).symm,
  sq_b₀ := (limits.kernel.lift_ι _ _ _).symm,
  sq_a₁ := sq₁,
  sq_b₁ := sq₂,
  sq_a₂ := cokernel.π_desc _ _ _,
  sq_b₂ := cokernel.π_desc _ _ _ }

variables
 {A₀ B₀ C₀
  A₁ B₁ C₁
  A₂ B₂ C₂
  A₃ B₃ C₃
  f₀ g₀ a₀ b₀ c₀ f₁ g₁ a₁ b₁ c₁ f₂ g₂ a₂ b₂ c₂ f₃ g₃}

variables (S : snake
  A₀ B₀ C₀
  A₁ B₁ C₁
  A₂ B₂ C₂
  A₃ B₃ C₃
  f₀ g₀ a₀ b₀ c₀ f₁ g₁ a₁ b₁ c₁ f₂ g₂ a₂ b₂ c₂ f₃ g₃)

variables

def snake_diagram : snake_diagram ⥤ 𝒜 :=
snake_diagram.mk_functor
![![A₀, B₀, C₀],
  ![A₁, B₁, C₁],
  ![A₂, B₂, C₂],
  ![A₃, B₃, C₃]]
f₀ g₀ a₀ b₀ c₀ f₁ g₁ a₁ b₁ c₁ f₂ g₂ a₂ b₂ c₂ f₃ g₃
S.sq_a₀ S.sq_b₀ S.sq_a₁ S.sq_b₁ S.sq_a₂ S.sq_b₂

lemma is_snake_input : is_snake_input S.snake_diagram :=
{ row_exact₁ := by { dsimp only [snake_diagram], simpa using S.row_exact₁, },
  row_exact₂ := by { dsimp only [snake_diagram], simpa using S.row_exact₂ },
  col_exact₁ := begin
    intros j,
    dsimp only [snake_diagram],
    fin_cases j with [0, 1, 2]; simp; rw exact_iff_exact_seq,
    exacts [S.col_exact_a.extract 0 2, S.col_exact_b.extract 0 2, S.col_exact_c.extract 0 2],
  end,
  col_exact₂ := begin
    intros j,
    dsimp only [snake_diagram],
    fin_cases j with [0, 1, 2]; simp; rw exact_iff_exact_seq,
    exacts [S.col_exact_a.extract 1 2, S.col_exact_b.extract 1 2, S.col_exact_c.extract 1 2],
  end,
  col_mono := begin
    intros j,
    dsimp only [snake_diagram],
    fin_cases j with [0, 1, 2]; simp,
    exacts [S.col_mono_a, S.col_mono_b, S.col_mono_c],
  end,
  col_epi := begin
    intros j,
    dsimp only [snake_diagram],
    fin_cases j with [0, 1, 2]; simp,
    exacts [S.col_epi_a, S.col_epi_b, S.col_epi_c],
  end,
  row_mono := by { dsimp only [snake_diagram], simp, exact S.row_mono },
  row_epi := by { dsimp only [snake_diagram], simpa using S.row_epi } }

def snake_input : snake_input 𝒜 := ⟨S.snake_diagram, S.is_snake_input⟩

def δ : C₀ ⟶ A₃ := S.is_snake_input.δ

lemma six_term_exact_seq : exact_seq 𝒜 [f₀, g₀, S.δ, f₃, g₃] :=
begin
  have := S.is_snake_input.six_term_exact_seq,
  dsimp only [snake_diagram] at this,
  simpa only [snake_diagram.mk_functor_map_f0, snake_diagram.mk_functor_map_g0,
    snake_diagram.mk_functor_map_f3, snake_diagram.mk_functor_map_g3],
end

end snake

lemma mono_of_exact_of_eq_zero (hfg : exact f₁ g₁) (h : f₁ = 0) : mono g₁ :=
by rwa [(abelian.tfae_mono A₁ g₁).out 0 2, ← h]

lemma cokernel.map_mono_of_epi_of_mono (sq : f₁ ≫ b₁ = a₁ ≫ f₂)
  [epi a₁] [mono b₁] [mono f₂] :
  mono (cokernel.map f₁ f₂ a₁ b₁ sq) :=
begin
  have S := snake.mk_of_sequence_hom A₁ B₁ (cokernel f₁) A₂ B₂ (cokernel f₂)
    f₁ (cokernel.π _) a₁ b₁ (cokernel.map f₁ f₂ a₁ b₁ sq) f₂ (cokernel.π _) sq.symm (by simp)
    (abelian.exact_cokernel _) (abelian.exact_cokernel _),
  apply (S.col_exact_c).pair.mono_of_is_zero,
  exact (S.six_term_exact_seq.drop 1).pair.is_zero_of_is_zero_is_zero
    (is_zero_kernel_of_mono _) (is_zero_cokernel_of_epi _),
end

end category_theory


/-
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