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

import for_mathlib.idempotents.karoubi
import category_theory.additive.basic

/-!

# Biproducts in the idempotent completion of a preadditive category

In this file, we define an instance expressing that if `C` is an additive category,
then `karoubi C` is also an additive category.

We also obtain that for all `P : karoubi C` where `C` is a preadditive category `C`, there
is a canonical isomorphism `P ⊞ P.complement ≅ (to_karoubi C).obj P.X` in the category
`karoubi C` where `P.complement` is the formal direct factor of `P.X` corresponding to
the idempotent endomorphism `𝟙 P.X - P.p`.

-/

noncomputable theory

open category_theory.category
open category_theory.limits
open category_theory.preadditive

universes v

/-namespace category_theory

namespace idempotents

namespace karoubi

variables {C : Type*} [category.{v} C] [preadditive C]

namespace biproducts

/-- The `bicone` used in order to obtain the existence of
the biproduct of a functor `J ⥤ karoubi C` when the category `C` is additive. -/
@[simps]
def bicone [has_finite_biproducts C] {J : Type} [fintype J]
  (F : J → karoubi C) : bicone F :=
{ X :=
  { X := biproduct (λ j, (F j).X),
    p := biproduct.map (λ j, (F j).p),
    idem := begin
      ext j,
      simp only [biproduct.ι_map_assoc, biproduct.ι_map],
      slice_lhs 1 2 { rw (F j).idem, },
    end, },
  π := λ j,
    { f := biproduct.map (λ j, (F j).p) ≫ bicone.π _ j,
      comm := by simp only [assoc, biproduct.bicone_π, biproduct.map_π,
        biproduct.map_π_assoc, (F j).idem], },
  ι := λ j,
    { f := (by exact bicone.ι _ j) ≫ biproduct.map (λ j, (F j).p),
      comm := by rw [biproduct.ι_map, ← assoc, ← assoc, (F j).idem,
        assoc, biproduct.ι_map, ← assoc, (F j).idem], },
  ι_π := λ j j', begin
    split_ifs,
    { subst h,
      simp only [biproduct.bicone_ι, biproduct.ι_map, biproduct.bicone_π,
        biproduct.ι_π_self_assoc, comp, category.assoc, eq_to_hom_refl, id_eq,
        biproduct.map_π, (F j).idem], },
    { simpa only [hom_ext, biproduct.ι_π_ne_assoc _ h, assoc,
        biproduct.map_π, biproduct.map_π_assoc, zero_comp, comp], },
  end, }

end biproducts

lemma karoubi_has_finite_biproducts [has_finite_biproducts C] :
  has_finite_biproducts (karoubi C) :=
{ has_biproducts_of_shape := λ J hJ,
  { has_biproduct := λ F, begin
      classical,
      letI := hJ,
      apply has_biproduct_of_total (biproducts.bicone F),
      ext1, ext1,
      simp only [id_eq, comp_id, biproducts.bicone_X_p, biproduct.ι_map],
      rw [sum_hom, comp_sum, finset.sum_eq_single j], rotate,
      { intros j' h1 h2,
        simp only [biproduct.ι_map, biproducts.bicone_ι_f, biproducts.bicone_π_f,
          assoc, comp, biproduct.map_π],
        slice_lhs 1 2 { rw biproduct.ι_π, },
        split_ifs,
        { exfalso, exact h2 h.symm, },
        { simp only [zero_comp], } },
      { intro h,
        exfalso,
        simpa only [finset.mem_univ, not_true] using h, },
      { simp only [biproducts.bicone_π_f, comp,
          biproduct.ι_map, assoc, biproducts.bicone_ι_f, biproduct.map_π],
        slice_lhs 1 2 { rw biproduct.ι_π, },
        split_ifs, swap, { exfalso, exact h rfl, },
        simp only [eq_to_hom_refl, id_comp, (F j).idem], },
    end, } }

instance {D : Type*} [category D] [additive_category D] : additive_category (karoubi D) :=
{ to_preadditive := infer_instance,
  to_has_finite_biproducts := karoubi_has_finite_biproducts }

/-- `P.complement` is the formal direct factor of `P.X` given by the idempotent
endomorphism `𝟙 P.X - P.p` -/
@[simps]
def complement (P : karoubi C) : karoubi C :=
{ X := P.X,
  p := 𝟙 _ - P.p,
  idem := idem_of_id_sub_idem P.p P.idem, }

instance (P : karoubi C) : has_binary_biproduct P P.complement :=
has_binary_biproduct_of_total
{ X := P.X,
  fst := P.decomp_id_p,
  snd := P.complement.decomp_id_p,
  inl := P.decomp_id_i,
  inr := P.complement.decomp_id_i,
  inl_fst' := P.decomp_id.symm,
  inl_snd' := begin
    simp only [decomp_id_i_f, decomp_id_p_f, complement_p, comp_sub, comp,
      hom_ext, quiver.hom.add_comm_group_zero_f, P.idem],
    erw [comp_id, sub_self],
  end,
  inr_fst' := begin
    simp only [decomp_id_i_f, complement_p, decomp_id_p_f, sub_comp, comp,
      hom_ext, quiver.hom.add_comm_group_zero_f, P.idem],
    erw [id_comp, sub_self],
  end,
  inr_snd' := P.complement.decomp_id.symm, }
(by simp only [hom_ext, ← decomp_p, quiver.hom.add_comm_group_add_f,
  to_karoubi_map_f, id_eq, coe_p, complement_p, add_sub_cancel'_right])

/-- A formal direct factor `P : karoubi C` of an object `P.X : C` in a
preadditive category is actually a direct factor of the image `(to_karoubi C).obj P.X`
of `P.X` in the category `karoubi C` -/
def decomposition (P : karoubi C) : P ⊞ P.complement ≅ (to_karoubi _).obj P.X :=
{ hom := biprod.desc P.decomp_id_i P.complement.decomp_id_i,
  inv := biprod.lift P.decomp_id_p P.complement.decomp_id_p,
  hom_inv_id' := begin
    ext1,
    { simp only [← assoc, biprod.inl_desc, comp_id, biprod.lift_eq, comp_add,
        ← decomp_id, id_comp, add_right_eq_self],
      convert zero_comp,
      ext,
      simp only [decomp_id_i_f, decomp_id_p_f, complement_p, comp_sub, comp,
        quiver.hom.add_comm_group_zero_f, P.idem],
      erw [comp_id, sub_self], },
    { simp only [← assoc, biprod.inr_desc, biprod.lift_eq, comp_add,
        ← decomp_id, comp_id, id_comp, add_left_eq_self],
      convert zero_comp,
      ext,
      simp only [decomp_id_i_f, decomp_id_p_f, complement_p, sub_comp, comp,
        quiver.hom.add_comm_group_zero_f, P.idem],
      erw [id_comp, sub_self], }
  end,
  inv_hom_id' := begin
    rw biprod.lift_desc,
    simp only [← decomp_p],
    ext,
    dsimp only [complement, to_karoubi],
    simp only [quiver.hom.add_comm_group_add_f, add_sub_cancel'_right, id_eq],
  end, }

end karoubi

end idempotents

end category_theory-/


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.monoidal.braided
import Mathlib.algebra.category.Module.basic
import Mathlib.linear_algebra.tensor_product
import Mathlib.PostPort

universes u u_1 u_2 u_3 u_4 u_5 u_6

namespace Mathlib

/-!
# The symmetric monoidal category structure on R-modules

Mostly this uses existing machinery in `linear_algebra.tensor_product`.
We just need to provide a few small missing pieces to build the
`monoidal_category` instance and then the `symmetric_category` instance.

If you're happy using the bundled `Module R`, it may be possible to mostly
use this as an interface and not need to interact much with the implementation details.
-/

namespace Module

namespace monoidal_category

-- The definitions inside this namespace are essentially private.

-- After we build the `monoidal_category (Module R)` instance,

-- you should use that API.

/-- (implementation) tensor product of R-modules -/
/-- (implementation) tensor product of morphisms R-modules -/
def tensor_obj {R : Type u} [comm_ring R] (M : Module R) (N : Module R) : Module R :=
  of R (tensor_product R ↥M ↥N)

def tensor_hom {R : Type u} [comm_ring R] {M : Module R} {N : Module R} {M' : Module R}
    {N' : Module R} (f : M ⟶ N) (g : M' ⟶ N') : tensor_obj M M' ⟶ tensor_obj N N' :=
  tensor_product.map f g

theorem tensor_id {R : Type u} [comm_ring R] (M : Module R) (N : Module R) : tensor_hom 𝟙 𝟙 = 𝟙 :=
  tensor_product.ext
    fun (x : ↥M) (y : ↥N) => Eq.refl (coe_fn (tensor_hom 𝟙 𝟙) (tensor_product.tmul R x y))

theorem tensor_comp {R : Type u} [comm_ring R] {X₁ : Module R} {Y₁ : Module R} {Z₁ : Module R}
    {X₂ : Module R} {Y₂ : Module R} {Z₂ : Module R} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (g₁ : Y₁ ⟶ Z₁)
    (g₂ : Y₂ ⟶ Z₂) : tensor_hom (f₁ ≫ g₁) (f₂ ≫ g₂) = tensor_hom f₁ f₂ ≫ tensor_hom g₁ g₂ :=
  tensor_product.ext
    fun (x : ↥X₁) (y : ↥X₂) =>
      Eq.refl (coe_fn (tensor_hom (f₁ ≫ g₁) (f₂ ≫ g₂)) (tensor_product.tmul R x y))

/-- (implementation) the associator for R-modules -/
def associator {R : Type u} [comm_ring R] (M : Module R) (N : Module R) (K : Module R) :
    tensor_obj (tensor_obj M N) K ≅ tensor_obj M (tensor_obj N K) :=
  linear_equiv.to_Module_iso (tensor_product.assoc R ↥M ↥N ↥K)

/-! The `associator_naturality` and `pentagon` lemmas below are very slow to elaborate.

We give them some help by expressing the lemmas first non-categorically, then using
`convert _aux using 1` to have the elaborator work as little as possible. -/

theorem associator_naturality {R : Type u} [comm_ring R] {X₁ : Module R} {X₂ : Module R}
    {X₃ : Module R} {Y₁ : Module R} {Y₂ : Module R} {Y₃ : Module R} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂)
    (f₃ : X₃ ⟶ Y₃) :
    tensor_hom (tensor_hom f₁ f₂) f₃ ≫ category_theory.iso.hom (associator Y₁ Y₂ Y₃) =
        category_theory.iso.hom (associator X₁ X₂ X₃) ≫ tensor_hom f₁ (tensor_hom f₂ f₃) :=
  sorry

theorem pentagon {R : Type u} [comm_ring R] (W : Module R) (X : Module R) (Y : Module R)
    (Z : Module R) :
    tensor_hom (category_theory.iso.hom (associator W X Y)) 𝟙 ≫
          category_theory.iso.hom (associator W (tensor_obj X Y) Z) ≫
            tensor_hom 𝟙 (category_theory.iso.hom (associator X Y Z)) =
        category_theory.iso.hom (associator (tensor_obj W X) Y Z) ≫
          category_theory.iso.hom (associator W X (tensor_obj Y Z)) :=
  sorry

/-- (implementation) the left unitor for R-modules -/
def left_unitor {R : Type u} [comm_ring R] (M : Module R) : of R (tensor_product R R ↥M) ≅ M :=
  linear_equiv.to_Module_iso (tensor_product.lid R ↥M) ≪≫ of_self_iso M

theorem left_unitor_naturality {R : Type u} [comm_ring R] {M : Module R} {N : Module R}
    (f : M ⟶ N) :
    tensor_hom 𝟙 f ≫ category_theory.iso.hom (left_unitor N) =
        category_theory.iso.hom (left_unitor M) ≫ f :=
  sorry

/-- (implementation) the right unitor for R-modules -/
def right_unitor {R : Type u} [comm_ring R] (M : Module R) : of R (tensor_product R (↥M) R) ≅ M :=
  linear_equiv.to_Module_iso (tensor_product.rid R ↥M) ≪≫ of_self_iso M

theorem right_unitor_naturality {R : Type u} [comm_ring R] {M : Module R} {N : Module R}
    (f : M ⟶ N) :
    tensor_hom f 𝟙 ≫ category_theory.iso.hom (right_unitor N) =
        category_theory.iso.hom (right_unitor M) ≫ f :=
  sorry

theorem triangle {R : Type u} [comm_ring R] (M : Module R) (N : Module R) :
    category_theory.iso.hom (associator M (of R R) N) ≫
          tensor_hom 𝟙 (category_theory.iso.hom (left_unitor N)) =
        tensor_hom (category_theory.iso.hom (right_unitor M)) 𝟙 :=
  sorry

end monoidal_category

protected instance Module.monoidal_category {R : Type u} [comm_ring R] :
    category_theory.monoidal_category (Module R) :=
  category_theory.monoidal_category.mk monoidal_category.tensor_obj monoidal_category.tensor_hom
    (of R R) monoidal_category.associator monoidal_category.left_unitor
    monoidal_category.right_unitor

/-- Remind ourselves that the monoidal unit, being just `R`, is still a commutative ring. -/
protected instance category_theory.monoidal_category.tensor_unit.comm_ring {R : Type u}
    [comm_ring R] : comm_ring ↥𝟙_ :=
  _inst_1

namespace monoidal_category

@[simp] theorem hom_apply {R : Type u} [comm_ring R] {K : Module R} {L : Module R} {M : Module R}
    {N : Module R} (f : K ⟶ L) (g : M ⟶ N) (k : ↥K) (m : ↥M) :
    coe_fn (f ⊗ g) (tensor_product.tmul R k m) = tensor_product.tmul R (coe_fn f k) (coe_fn g m) :=
  rfl

@[simp] theorem left_unitor_hom_apply {R : Type u} [comm_ring R] {M : Module R} (r : R) (m : ↥M) :
    coe_fn (category_theory.iso.hom λ_) (tensor_product.tmul R r m) = r • m :=
  tensor_product.lid_tmul m r

@[simp] theorem right_unitor_hom_apply {R : Type u} [comm_ring R] {M : Module R} (m : ↥M) (r : R) :
    coe_fn (category_theory.iso.hom ρ_) (tensor_product.tmul R m r) = r • m :=
  tensor_product.rid_tmul m r

@[simp] theorem associator_hom_apply {R : Type u} [comm_ring R] {M : Module R} {N : Module R}
    {K : Module R} (m : ↥M) (n : ↥N) (k : ↥K) :
    coe_fn (category_theory.iso.hom α_) (tensor_product.tmul R (tensor_product.tmul R m n) k) =
        tensor_product.tmul R m (tensor_product.tmul R n k) :=
  rfl

end monoidal_category

/-- (implementation) the braiding for R-modules -/
def braiding {R : Type u} [comm_ring R] (M : Module R) (N : Module R) :
    monoidal_category.tensor_obj M N ≅ monoidal_category.tensor_obj N M :=
  linear_equiv.to_Module_iso (tensor_product.comm R ↥M ↥N)

@[simp] theorem braiding_naturality {R : Type u} [comm_ring R] {X₁ : Module R} {X₂ : Module R}
    {Y₁ : Module R} {Y₂ : Module R} (f : X₁ ⟶ Y₁) (g : X₂ ⟶ Y₂) :
    (f ⊗ g) ≫ category_theory.iso.hom (braiding Y₁ Y₂) =
        category_theory.iso.hom (braiding X₁ X₂) ≫ (g ⊗ f) :=
  tensor_product.ext
    fun (x : ↥X₁) (y : ↥X₂) =>
      Eq.refl
        (coe_fn ((f ⊗ g) ≫ category_theory.iso.hom (braiding Y₁ Y₂)) (tensor_product.tmul R x y))

@[simp] theorem hexagon_forward {R : Type u} [comm_ring R] (X : Module R) (Y : Module R)
    (Z : Module R) :
    category_theory.iso.hom α_ ≫
          category_theory.iso.hom (braiding X (Y ⊗ Z)) ≫ category_theory.iso.hom α_ =
        (category_theory.iso.hom (braiding X Y) ⊗ 𝟙) ≫
          category_theory.iso.hom α_ ≫ (𝟙 ⊗ category_theory.iso.hom (braiding X Z)) :=
  sorry

@[simp] theorem hexagon_reverse {R : Type u} [comm_ring R] (X : Module R) (Y : Module R)
    (Z : Module R) :
    category_theory.iso.inv α_ ≫
          category_theory.iso.hom (braiding (X ⊗ Y) Z) ≫ category_theory.iso.inv α_ =
        (𝟙 ⊗ category_theory.iso.hom (braiding Y Z)) ≫
          category_theory.iso.inv α_ ≫ (category_theory.iso.hom (braiding X Z) ⊗ 𝟙) :=
  sorry

/-- The symmetric monoidal structure on `Module R`. -/
protected instance Module.symmetric_category {R : Type u} [comm_ring R] :
    category_theory.symmetric_category (Module R) :=
  category_theory.symmetric_category.mk

namespace monoidal_category

@[simp] theorem braiding_hom_apply {R : Type u} [comm_ring R] {M : Module R} {N : Module R} (m : ↥M)
    (n : ↥N) :
    coe_fn (category_theory.iso.hom β_) (tensor_product.tmul R m n) = tensor_product.tmul R n m :=
  rfl

@[simp] theorem braiding_inv_apply {R : Type u} [comm_ring R] {M : Module R} {N : Module R} (m : ↥M)
    (n : ↥N) :
    coe_fn (category_theory.iso.inv β_) (tensor_product.tmul R n m) = tensor_product.tmul R m n :=
  rfl

end Mathlib