import kassel.Tangle
import category_theory.monoidal.braided
import kassel.lemma.right_pivotal_category

open category_theory category_theory.monoidal_category

namespace kassel

universes v u
variables
  {C: Type u}
  [category.{v} C]
  [monoidal_category.{v} C]
  [right_rigid_category.{v} C]
  [right_pivotal_category.{v} C]
  [braided_category.{v} C]

def flip (V W: C) := (β_ V W).hom
notation `τ_` := flip

def trace {V: C} (f: V ⟶ V) := η_⁺ _ ≫ (f ⊗ 𝟙 Vᘁ) ≫ ε_⁻ _

def trace_2 {V: C} (f: V ⊗ V ⟶ V ⊗ V)
  :=                  (ρ_ _).inv
  ≫ (𝟙 V ⊗ η_⁺ _) ≫ (α_ _ _ _).inv
  ≫ (f ⊗ 𝟙 Vᘁ)    ≫ (α_ _ _ _).hom
  ≫ (𝟙 V ⊗ ε_⁻ _) ≫ (ρ_ _).hom

variable (C)

structure enhanced_R_matrix (V: C) :=
  (c: V ⊗ V ≅ V ⊗ V)
  (μ: V ≅ V)
  (relation_1:
       (𝟙 V ⊗ c.hom) ≫ (α_ _ _ _).inv
    ≫ (c.hom ⊗ 𝟙 V) ≫ (α_ _ _ _).hom
    ≫ (𝟙 V ⊗ c.hom) ≫ (α_ _ _ _).inv
  =                    (α_ _ _ _).inv
    ≫ (c.hom ⊗ 𝟙 V) ≫ (α_ _ _ _).hom
    ≫ (𝟙 V ⊗ c.hom) ≫ (α_ _ _ _).inv
    ≫ (c.hom ⊗ 𝟙 V)
  )
  (relation_2: c.hom ≫ (μ.hom ⊗ μ.hom) = (μ.hom ⊗ μ.hom) ≫ c.hom)
  (relation_3_1: trace_2 (c.hom ≫ (𝟙 V ⊗ μ.hom)) = 𝟙 V)
  (relation_3_2: trace_2 (c.inv ≫ (𝟙 V ⊗ μ.hom)) = 𝟙 V)
  (relation_4_1: (λ_ (V ⊗ Vᘁ)).inv ≫ (η_⁻ V ≫ (𝟙 Vᘁ ⊗ μ.inv) ⊗ 𝟙 V ⊗ 𝟙 Vᘁ) ≫ (α_ Vᘁ V (V ⊗ Vᘁ)).hom ≫ (𝟙 Vᘁ ⊗ (α_ V V Vᘁ).inv) ≫ (𝟙 Vᘁ ⊗ c.inv ⊗ 𝟙 Vᘁ) ≫ (𝟙 Vᘁ ⊗ (α_ V V Vᘁ).hom) ≫ (α_ Vᘁ V (V ⊗ Vᘁ)).inv ≫ ((𝟙 Vᘁ ⊗ 𝟙 V) ⊗ (μ.hom ⊗ 𝟙 Vᘁ) ≫ ε_⁻ V) ≫ ((𝟙 Vᘁ ⊗ 𝟙 V) ⊗ η_⁺ V) ≫ (α_ Vᘁ V (V ⊗ Vᘁ)).hom ≫ (𝟙 Vᘁ ⊗ (α_ V V Vᘁ).inv) ≫ (𝟙 Vᘁ ⊗ c.hom ⊗ 𝟙 Vᘁ) ≫ (𝟙 Vᘁ ⊗ (α_ V V Vᘁ).hom) ≫ (α_ Vᘁ V (V ⊗ Vᘁ)).inv ≫ (ε_⁺ V ⊗ 𝟙 V ⊗ 𝟙 Vᘁ) ≫ (λ_ (V ⊗ Vᘁ)).hom = 𝟙 V ⊗ 𝟙 Vᘁ)
  (relation_4_2: (λ_ (V ⊗ Vᘁ)).inv ≫ (η_⁻ V ≫ (𝟙 Vᘁ ⊗ μ.inv) ⊗ 𝟙 V ⊗ 𝟙 Vᘁ) ≫ (α_ Vᘁ V (V ⊗ Vᘁ)).hom ≫ (𝟙 Vᘁ ⊗ (α_ V V Vᘁ).inv) ≫ (𝟙 Vᘁ ⊗ c.hom ⊗ 𝟙 Vᘁ) ≫ (𝟙 Vᘁ ⊗ (α_ V V Vᘁ).hom) ≫ (α_ Vᘁ V (V ⊗ Vᘁ)).inv ≫ ((𝟙 Vᘁ ⊗ 𝟙 V) ⊗ (μ.hom ⊗ 𝟙 Vᘁ) ≫ ε_⁻ V) ≫ ((𝟙 Vᘁ ⊗ 𝟙 V) ⊗ η_⁺ V) ≫ (α_ Vᘁ V (V ⊗ Vᘁ)).hom ≫ (𝟙 Vᘁ ⊗ (α_ V V Vᘁ).inv) ≫ (𝟙 Vᘁ ⊗ c.inv ⊗ 𝟙 Vᘁ) ≫ (𝟙 Vᘁ ⊗ (α_ V V Vᘁ).hom) ≫ (α_ Vᘁ V (V ⊗ Vᘁ)).inv ≫ (ε_⁺ V ⊗ 𝟙 V ⊗ 𝟙 Vᘁ) ≫ (λ_ (V ⊗ Vᘁ)).hom = 𝟙 V ⊗ 𝟙 Vᘁ)
  (relation_4_3: (ρ_ (Vᘁ ⊗ V)).inv ≫ ((𝟙 Vᘁ ⊗ 𝟙 V) ⊗ η_⁺ V) ≫ (α_ Vᘁ V (V ⊗ Vᘁ)).hom ≫ (𝟙 Vᘁ ⊗ (α_ V V Vᘁ).inv) ≫ (𝟙 Vᘁ ⊗ c.hom ⊗ 𝟙 Vᘁ) ≫ (𝟙 Vᘁ ⊗ (α_ V V Vᘁ).hom) ≫ (α_ Vᘁ V (V ⊗ Vᘁ)).inv ≫ (ε_⁺ V ⊗ 𝟙 V ⊗ 𝟙 Vᘁ) ≫ (η_⁻ V ≫ (𝟙 Vᘁ ⊗ μ.inv) ⊗ 𝟙 V ⊗ 𝟙 Vᘁ) ≫ (α_ Vᘁ V (V ⊗ Vᘁ)).hom ≫ (𝟙 Vᘁ ⊗ (α_ V V Vᘁ).inv) ≫ (𝟙 Vᘁ ⊗ c.inv ⊗ 𝟙 Vᘁ) ≫ (𝟙 Vᘁ ⊗ (α_ V V Vᘁ).hom) ≫ (α_ Vᘁ V (V ⊗ Vᘁ)).inv ≫ ((𝟙 Vᘁ ⊗ 𝟙 V) ⊗ (μ.hom ⊗ 𝟙 Vᘁ) ≫ ε_⁻ V) ≫ (ρ_ (Vᘁ ⊗ V)).hom = 𝟙 Vᘁ ⊗ 𝟙 V)
  (relation_4_4: (ρ_ (Vᘁ ⊗ V)).inv ≫ ((𝟙 Vᘁ ⊗ 𝟙 V) ⊗ η_⁺ V) ≫ (α_ Vᘁ V (V ⊗ Vᘁ)).hom ≫ (𝟙 Vᘁ ⊗ (α_ V V Vᘁ).inv) ≫ (𝟙 Vᘁ ⊗ c.inv ⊗ 𝟙 Vᘁ) ≫ (𝟙 Vᘁ ⊗ (α_ V V Vᘁ).hom) ≫ (α_ Vᘁ V (V ⊗ Vᘁ)).inv ≫ (ε_⁺ V ⊗ 𝟙 V ⊗ 𝟙 Vᘁ) ≫ (η_⁻ V ≫ (𝟙 Vᘁ ⊗ μ.inv) ⊗ 𝟙 V ⊗ 𝟙 Vᘁ) ≫ (α_ Vᘁ V (V ⊗ Vᘁ)).hom ≫ (𝟙 Vᘁ ⊗ (α_ V V Vᘁ).inv) ≫ (𝟙 Vᘁ ⊗ c.hom ⊗ 𝟙 Vᘁ) ≫ (𝟙 Vᘁ ⊗ (α_ V V Vᘁ).hom) ≫ (α_ Vᘁ V (V ⊗ Vᘁ)).inv ≫ ((𝟙 Vᘁ ⊗ 𝟙 V) ⊗ (μ.hom ⊗ 𝟙 Vᘁ) ≫ ε_⁻ V) ≫ (ρ_ (Vᘁ ⊗ V)).hom = 𝟙 Vᘁ ⊗ 𝟙 V)

variable {C}

namespace enhanced_R_matrix

variables (V: C) (R: enhanced_R_matrix C V)

@[simp] def functor_obj: Tangle → C
  | Tangle.id := 𝟙_ C
  | ↓ := V
  | ↑ := Vᘁ
  | (a ⊗ᵗ b) := functor_obj a ⊗ functor_obj b

def functor_map: Π {X Y}, (X ⟶ᵐ Y) → (functor_obj V X ⟶ functor_obj V Y)
  | _ _ (𝟙ᵐ a) := 𝟙 (functor_obj V a)
  | _ _ (f ≫ᵐ g) := functor_map f ≫ functor_map g
  | _ _ (f ⊗ᵐ g) := functor_map f ⊗ functor_map g
  | _ _ (α _ _ _) := (α_ _ _ _).hom
  | _ _ (α⁻¹ _ _ _) := (α_ _ _ _).inv
  | _ _ (ℓ _) := (λ_ _).hom
  | _ _ (ℓ⁻¹ _) := (λ_ _).inv
  | _ _ (ρ _) := (ρ_ _).hom
  | _ _ (ρ⁻¹ _) := (ρ_ _).inv
  | _ _ η⁺ := η_⁺ V
  | _ _ η⁻ := η_⁻ _ ≫ (𝟙 Vᘁ ⊗ R.μ.inv)
  | _ _ ε⁺ := ε_⁺ _
  | _ _ ε⁻ := (R.μ.hom ⊗ 𝟙 Vᘁ) ≫ ε_⁻ V
  | _ _ β := R.c.hom
  | _ _ β⁻¹ := R.c.inv

namespace aux

lemma relation_2_c_inv:
  R.c.inv ≫ (R.μ.hom ⊗ R.μ.hom) = (R.μ.hom ⊗ R.μ.hom) ≫ R.c.inv :=
by rw [iso.eq_comp_inv, category.assoc, iso.inv_comp_eq, R.relation_2]

lemma functor_map_well_defined_1_1:
  functor_map V R (ρ⁻¹ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ η⁻ ≫ᵐ α⁻¹ _ _ _ ≫ᵐ ε⁻ ⊗ᵐ 𝟙ᵐ _ ≫ᵐ ℓ _) =
  functor_map V R (𝟙ᵐ _) :=
begin
  dsimp [functor_map],
  simp_rw [id_tensor_comp, comp_tensor_id, category.assoc],

  rw ←associator_inv_naturality_assoc,
  iterate 2 { rw [←tensor_comp_assoc _ _ R.μ.hom _, id_comp_comp_id R.μ.hom, tensor_comp_assoc], },
  rw [tensor_id, tensor_id, category.id_comp],
  rw [←tensor_id_comp_id_tensor_assoc _ R.μ.hom, ←right_unitor_inv_naturality_assoc],

  rw associator_inv_naturality_assoc,
  rw [←tensor_comp_assoc, ←id_comp_comp_id, tensor_comp_assoc],
  rw [tensor_id, tensor_id, category.id_comp],
  rw [←tensor_id_comp_id_tensor_assoc R.μ.inv _, left_unitor_naturality],

  slice_lhs 3 5 { rw coevaluation_evaluation_rev, },
  simp_rw [category.assoc, iso.inv_hom_id_assoc],
  rw iso.hom_inv_id,
end

lemma functor_map_well_defined_1_2:
  functor_map V R (ℓ⁻¹ _ ≫ᵐ η⁺ ⊗ᵐ 𝟙ᵐ _ ≫ᵐ α _ _ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ ε⁺ ≫ᵐ ρ _) = functor_map V R (𝟙ᵐ _) :=
begin
  dsimp [functor_map],
  rw [evaluation_coevaluation_assoc, iso.inv_hom_id_assoc, iso.inv_hom_id],
end

lemma functor_map_well_defined_2_1:
  functor_map V R (ρ⁻¹ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ η⁺ ≫ᵐ α⁻¹ _ _ _ ≫ᵐ ε⁺ ⊗ᵐ 𝟙ᵐ _ ≫ᵐ ℓ _) = functor_map V R (𝟙ᵐ _) :=
begin
  dsimp [functor_map],
  rw [coevaluation_evaluation_assoc, iso.inv_hom_id_assoc, iso.inv_hom_id],
end

lemma functor_map_well_defined_2_2:
  functor_map V R (ℓ⁻¹ _ ≫ᵐ η⁻ ⊗ᵐ 𝟙ᵐ _ ≫ᵐ α _ _ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ ε⁻ ≫ᵐ ρ _) = functor_map V R (𝟙ᵐ _) :=
begin
  dsimp [functor_map],
  simp_rw [id_tensor_comp, comp_tensor_id, category.assoc],
  rw associator_naturality_assoc,
  slice_lhs 4 5 { rw [←tensor_comp, ←tensor_comp, category.comp_id, iso.inv_hom_id, tensor_id, tensor_id], },
  rw category.id_comp,
  rw [evaluation_coevaluation_rev_assoc, iso.inv_hom_id_assoc, iso.inv_hom_id],
end

abbreviation functor_map_well_defined_3_lhs (b: ↓ ⊗ᵗ ↓ ⟶ᵐ ↓ ⊗ᵗ ↓) :=
  functor_map V R (                             ℓ⁻¹ _
    ≫ᵐ η⁻                   ⊗ᵐ 𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑ ≫ᵐ (𝟙ᵐ ↑ ⊗ᵐ ℓ⁻¹ _) ⊗ᵐ 𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑
    ≫ᵐ (𝟙ᵐ ↑ ⊗ᵐ η⁻ ⊗ᵐ 𝟙ᵐ ↓) ⊗ᵐ 𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑ ≫ᵐ (𝟙ᵐ ↑ ⊗ᵐ α _ _ _) ⊗ᵐ 𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑ ≫ᵐ α⁻¹ _ _ _ ⊗ᵐ 𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑ ≫ᵐ α _ _ _
    ≫ᵐ (𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑) ⊗ᵐ b  ⊗ᵐ 𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑ ≫ᵐ (𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑) ⊗ᵐ α _ _ _ ≫ᵐ (𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑) ⊗ᵐ 𝟙ᵐ ↓ ⊗ᵐ α⁻¹ _ _ _
    ≫ᵐ (𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑) ⊗ᵐ 𝟙ᵐ ↓ ⊗ᵐ ε⁻ ⊗ᵐ 𝟙ᵐ ↑ ≫ᵐ (𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑) ⊗ᵐ 𝟙ᵐ ↓ ⊗ᵐ ℓ _
    ≫ᵐ (𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑) ⊗ᵐ ε⁻                 ≫ᵐ ρ _
  )

abbreviation functor_map_well_defined_3_rhs (b: ↓ ⊗ᵗ ↓ ⟶ᵐ ↓ ⊗ᵗ ↓) :=
  functor_map V R (                             ρ⁻¹ _
    ≫ᵐ (𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑) ⊗ᵐ η⁺                 ≫ᵐ (𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑) ⊗ᵐ 𝟙ᵐ ↓ ⊗ᵐ ℓ⁻¹ ↑
    ≫ᵐ (𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑) ⊗ᵐ 𝟙ᵐ ↓ ⊗ᵐ η⁺ ⊗ᵐ 𝟙ᵐ ↑ ≫ᵐ (𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑) ⊗ᵐ 𝟙ᵐ ↓ ⊗ᵐ α _ _ _ ≫ᵐ (𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑) ⊗ᵐ α⁻¹ _ _ _
    ≫ᵐ (𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑) ⊗ᵐ b  ⊗ᵐ 𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑ ≫ᵐ α⁻¹ _ _ _ ≫ᵐ α _ _ _ ⊗ᵐ 𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑ ≫ᵐ (𝟙ᵐ ↑ ⊗ᵐ α⁻¹ _ _ _) ⊗ᵐ 𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑
    ≫ᵐ (𝟙ᵐ ↑ ⊗ᵐ ε⁺ ⊗ᵐ 𝟙ᵐ ↓) ⊗ᵐ 𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑ ≫ᵐ (𝟙ᵐ ↑ ⊗ᵐ ℓ _) ⊗ᵐ 𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑
    ≫ᵐ ε⁺                   ⊗ᵐ 𝟙ᵐ ↑ ⊗ᵐ 𝟙ᵐ ↑ ≫ᵐ ℓ _
  )

abbreviation functor_map_well_defined_3_mid (b: ↓ ⊗ᵗ ↓ ⟶ᵐ ↓ ⊗ᵗ ↓) :=
  (δ_ V V).inv ≫ (functor_map V R b)ᘁ ≫ (δ_ V V).hom

lemma functor_map_well_defined_3_left (b: ↓ ⊗ᵗ ↓ ⟶ᵐ ↓ ⊗ᵗ ↓) (h: functor_map V R b ≫ (R.μ.hom ⊗ R.μ.hom) = (R.μ.hom ⊗ R.μ.hom) ≫ functor_map V R b):
  functor_map_well_defined_3_lhs V R b =
  functor_map_well_defined_3_mid V R b :=
begin
  dunfold functor_map_well_defined_3_lhs,
  dunfold functor_map_well_defined_3_mid,
  dsimp [functor_map],
  simp only [tensor_id, id_tensor_comp, comp_tensor_id, category.assoc],

  iterate 6 { rw [←tensor_comp_assoc _ (𝟙 (Vᘁ ⊗ Vᘁ)) _ (𝟙 (Vᘁ ⊗ Vᘁ)), category.comp_id], repeat { rw category.assoc, }, },
  rw [←tensor_comp_assoc _ R.μ.inv _ _, left_unitor_inv_naturality, tensor_comp_assoc],
  iterate 2 { rw [←tensor_comp_assoc _ (_ ⊗ R.μ.inv) _ _, ←tensor_comp _ R.μ.inv _ _, ←id_comp_comp_id R.μ.inv, tensor_comp, tensor_comp_assoc], },
  rw [←tensor_comp_assoc _ (_ ⊗ R.μ.inv) _ _, associator_naturality, tensor_comp_assoc],
  rw associator_inv_naturality,
  rw [tensor_id, id_tensor_comp_tensor_id_assoc, ←category.id_comp ((_ ⊗ 𝟙 Vᘁ) ⊗ (_ ⊗ R.μ.inv)), ←tensor_id],
  nth_rewrite 0 ←(δ_ _ _).inv_hom_id,
  rw [comp_tensor_id_assoc (δ_ _ _).inv _ _, ←coevaluation_rev_tensor_assoc],
  rw [tensor_id, tensor_id_comp_id_tensor, comp_tensor_id_assoc, associator_naturality_assoc],

  iterate 6 { nth_rewrite 1 ←tensor_comp_assoc (𝟙 (Vᘁ ⊗ Vᘁ)) _ (𝟙 (Vᘁ ⊗ Vᘁ)) _, rw category.comp_id, repeat { rw category.assoc, }, },
  rw [←tensor_comp_assoc _ _ _ ((R.μ.hom ⊗ 𝟙 _) ⊗ 𝟙 Vᘁ), ←associator_inv_naturality, tensor_comp_assoc],
  iterate 4 { rw [←tensor_comp_assoc _ _ R.μ.hom _, id_comp_comp_id R.μ.hom, tensor_comp_assoc], },
  rw [←associator_naturality_assoc R.μ.hom _ _, tensor_id, ←tensor_id_comp_id_tensor_assoc _ (R.μ.hom ⊗ _)],
  nth_rewrite 6 ←(δ_ _ _).inv_hom_id,
  rw [id_tensor_comp_assoc (δ_ _ _).inv _, tensor_id_comp_id_tensor_assoc],
  rw [tensor_id, category.id_comp, ←evaluation_rev_tensor],
  rw id_tensor_comp_assoc,

  iterate 3 { rw [←tensor_comp_assoc (δ_ _ _).hom _ _ _, ←id_comp_comp_id, tensor_comp_assoc], },
  rw [←id_tensor_comp_tensor_id_assoc _ (δ_ _ _).hom, right_unitor_naturality],
  simp_rw ←category.assoc, rw iso.cancel_iso_hom_right, simp_rw category.assoc,

  simp_rw ←associator_naturality_assoc,
  iterate 3 { rw [←tensor_comp_assoc _ _ _ (δ_ _ _).inv, id_comp_comp_id, tensor_comp_assoc], },
  rw [←id_tensor_comp_tensor_id_assoc (δ_ _ _).inv _, ←left_unitor_inv_naturality_assoc],
  rw iso.cancel_iso_inv_left,

  slice_lhs 3 5 { simp only [←tensor_comp, category.id_comp], },
  simp_rw category.assoc, rw right_adjoint_mate_rev,
  rw [h, ←tensor_iso_hom, ←tensor_iso_inv, iso.inv_hom_id_assoc],
end

lemma functor_map_well_defined_3_right (b: ↓ ⊗ᵗ ↓ ⟶ᵐ ↓ ⊗ᵗ ↓):
  functor_map_well_defined_3_rhs V R b =
  functor_map_well_defined_3_mid V R b :=
begin
  dunfold functor_map_well_defined_3_rhs,
  dunfold functor_map_well_defined_3_mid,
  dsimp [functor_map],
  simp only [tensor_id, id_tensor_comp, comp_tensor_id, category.assoc],

  iterate 4 { rw ←tensor_comp_assoc (𝟙 (Vᘁ ⊗ Vᘁ)) _ (𝟙 (Vᘁ ⊗ Vᘁ)) _, rw category.comp_id, }, repeat { rw category.assoc, },
  rw [←category.comp_id (α_ V V (Vᘁ ⊗ Vᘁ)).inv, ←tensor_id (V ⊗ V) (Vᘁ ⊗ Vᘁ)],
  nth_rewrite 1 ←(δ_ _ _).inv_hom_id, rw id_tensor_comp (δ_ V V).inv _,
  rw [←coevaluation_hom_tensor_assoc, id_tensor_comp_assoc],

  iterate 4 { rw ←comp_tensor_id_assoc, }, repeat { rw category.assoc, },
  rw [←category.id_comp (α_ Vᘁ Vᘁ (V ⊗ V)).hom, ←tensor_id (Vᘁ ⊗ Vᘁ) (V ⊗ V)],
  nth_rewrite 4 ←(δ_ _ _).inv_hom_id, rw comp_tensor_id_assoc (δ_ V V).inv _, repeat { rw category.assoc, },
  rw [←evaluation_hom_tensor, comp_tensor_id_assoc],

  rw ←associator_inv_naturality_assoc,
  iterate 3 { rw [←tensor_comp_assoc  _ _ (δ_ _ _).inv _, id_comp_comp_id, tensor_comp_assoc], },
  rw [←tensor_id_comp_id_tensor_assoc _ (δ_ _ _).inv, ←right_unitor_inv_naturality_assoc],
  rw iso.cancel_iso_inv_left,

  slice_lhs 3 5 { simp only [←tensor_comp, category.comp_id], rw @category.id_comp _ _ (V ⊗ V) (V ⊗ V) (functor_map V R b), }, simp_rw category.assoc,
  rw associator_inv_naturality_assoc,
  rw ←tensor_id_comp_id_tensor_assoc (δ_ V V).hom _,
  rw [←tensor_comp_assoc _ (δ_ _ _).hom _ _, ←id_comp_comp_id, tensor_comp_assoc],
  rw [←tensor_id_comp_id_tensor_assoc (δ_ V V).hom _, left_unitor_naturality],
  simp_rw ←category.assoc, rw iso.cancel_iso_hom_right, simp_rw category.assoc,

  simp_rw [tensor_id, category.id_comp],
  rw [←associator_inv_naturality_assoc], rw right_adjoint_mate,
end

lemma functor_map_well_defined_3_1:
  functor_map_well_defined_3_lhs V R β =
  functor_map_well_defined_3_rhs V R β :=
  eq.trans
    (functor_map_well_defined_3_left V R β (by rw [functor_map, R.relation_2]))
    (functor_map_well_defined_3_right V R β).symm

lemma functor_map_well_defined_3_2:
  functor_map_well_defined_3_lhs V R β⁻¹ =
  functor_map_well_defined_3_rhs V R β⁻¹ :=
  eq.trans
    (functor_map_well_defined_3_left V R β⁻¹ (by rw [functor_map, relation_2_c_inv]))
    (functor_map_well_defined_3_right V R β⁻¹).symm

lemma functor_map_well_defined_4_1:
  functor_map V R (β ≫ᵐ β⁻¹) = functor_map V R (𝟙ᵐ (↓ ⊗ᵗ ↓)) :=
by simp [functor_map]

lemma functor_map_well_defined_4_2:
  functor_map V R (β⁻¹ ≫ᵐ β) = functor_map V R (𝟙ᵐ (↓ ⊗ᵗ ↓)) :=
by simp [functor_map]

lemma functor_map_well_defined_5:
  functor_map V R (α⁻¹ _ _ _ ≫ᵐ β ⊗ᵐ 𝟙ᵐ ↓ ≫ᵐ α _ _ _ ≫ᵐ 𝟙ᵐ ↓ ⊗ᵐ β ≫ᵐ α⁻¹ _ _ _ ≫ᵐ β ⊗ᵐ 𝟙ᵐ _) = functor_map V R (𝟙ᵐ ↓ ⊗ᵐ β ≫ᵐ α⁻¹ _ _ _ ≫ᵐ β ⊗ᵐ 𝟙ᵐ ↓ ≫ᵐ α _ _ _ ≫ᵐ 𝟙ᵐ ↓ ⊗ᵐ β ≫ᵐ α⁻¹ _ _ _) :=
by dsimp [functor_map]; exact R.relation_1.symm

lemma functor_map_well_defined_6_1:
  functor_map V R (ρ⁻¹ _ ≫ᵐ 𝟙ᵐ ↓ ⊗ᵐ η⁺ ≫ᵐ α⁻¹ _ _ _ ≫ᵐ β ⊗ᵐ 𝟙ᵐ ↑ ≫ᵐ α _ _ _ ≫ᵐ 𝟙ᵐ ↓ ⊗ᵐ ε⁻ ≫ᵐ ρ _) = functor_map V R (𝟙ᵐ ↓) :=
begin
  simp [functor_map],
  change (ρ_ _).inv ≫ (𝟙 V ⊗ η_⁺ V) ≫ (α_ _ _ _).inv ≫ (R.c.hom ⊗ 𝟙 Vᘁ) ≫ (α_ _ _ _).hom ≫ (𝟙 V ⊗ R.μ.hom ⊗ 𝟙 Vᘁ) ≫ (𝟙 V ⊗ ε_⁻ V) ≫ (ρ_ _).hom = 𝟙 V,
  have h: trace_2 (R.c.hom ≫ (𝟙 V ⊗ R.μ.hom)) = (ρ_ _).inv ≫ (𝟙 V ⊗ η_⁺ V) ≫ (α_ _ _ _).inv ≫ (R.c.hom ⊗ 𝟙 Vᘁ) ≫ (α_ _ _ _).hom ≫ (𝟙 V ⊗ R.μ.hom ⊗ 𝟙 Vᘁ) ≫ (𝟙 V ⊗ ε_⁻ V) ≫ (ρ_ _).hom :=
    by simp [functor_map, trace_2, coevaluation, evaluation, evaluation_rev],
  rw ←h,
  exact R.relation_3_1,
end
lemma functor_map_well_defined_6_2:
  functor_map V R (ρ⁻¹ _ ≫ᵐ 𝟙ᵐ ↓ ⊗ᵐ η⁺ ≫ᵐ α⁻¹ _ _ _ ≫ᵐ β⁻¹ ⊗ᵐ 𝟙ᵐ ↑ ≫ᵐ α _ _ _ ≫ᵐ 𝟙ᵐ ↓ ⊗ᵐ ε⁻ ≫ᵐ ρ _) = functor_map V R (𝟙ᵐ ↓) :=
begin
  simp [functor_map],
  change (ρ_ _).inv ≫ (𝟙 V ⊗ η_⁺ V) ≫ (α_ _ _ _).inv ≫ (R.c.inv ⊗ 𝟙 Vᘁ) ≫ (α_ _ _ _).hom ≫ (𝟙 V ⊗ R.μ.hom ⊗ 𝟙 Vᘁ) ≫ (𝟙 V ⊗ ε_⁻ V) ≫ (ρ_ _).hom = 𝟙 V,
  have h: trace_2 (R.c.inv ≫ (𝟙 V ⊗ R.μ.hom)) = (ρ_ _).inv ≫ (𝟙 V ⊗ η_⁺ V) ≫ (α_ _ _ _).inv ≫ (R.c.inv ⊗ 𝟙 Vᘁ) ≫ (α_ _ _ _).hom ≫ (𝟙 V ⊗ R.μ.hom ⊗ 𝟙 Vᘁ) ≫ (𝟙 V ⊗ ε_⁻ V) ≫ (ρ_ _).hom :=
    by simp [functor_map, trace_2, coevaluation, evaluation, evaluation_rev],
  rw ←h,
  exact R.relation_3_2,
end

lemma functor_map_well_defined_7_1:
  functor_map V R (ℓ⁻¹ _ ≫ᵐ η⁻ ⊗ᵐ 𝟙ᵐ _ ⊗ᵐ 𝟙ᵐ _ ≫ᵐ α _ _ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ α⁻¹ _ _ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ β⁻¹ ⊗ᵐ 𝟙ᵐ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ α _ _ _ ≫ᵐ α⁻¹ _ _ _ ≫ᵐ (𝟙ᵐ _ ⊗ᵐ 𝟙ᵐ _) ⊗ᵐ ε⁻ ≫ᵐ (𝟙ᵐ _ ⊗ᵐ 𝟙ᵐ _) ⊗ᵐ η⁺ ≫ᵐ α _ _ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ α⁻¹ _ _ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ β ⊗ᵐ 𝟙ᵐ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ α _ _ _ ≫ᵐ α⁻¹ _ _ _ ≫ᵐ ε⁺ ⊗ᵐ 𝟙ᵐ _ ⊗ᵐ 𝟙ᵐ _ ≫ᵐ ℓ _) = functor_map V R (𝟙ᵐ _ ⊗ᵐ 𝟙ᵐ _) :=
by dsimp [functor_map]; exact R.relation_4_1

lemma functor_map_well_defined_7_2:
  functor_map V R (ℓ⁻¹ _ ≫ᵐ η⁻ ⊗ᵐ 𝟙ᵐ _ ⊗ᵐ 𝟙ᵐ _ ≫ᵐ α _ _ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ α⁻¹ _ _ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ β ⊗ᵐ 𝟙ᵐ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ α _ _ _ ≫ᵐ α⁻¹ _ _ _ ≫ᵐ (𝟙ᵐ _ ⊗ᵐ 𝟙ᵐ _) ⊗ᵐ ε⁻ ≫ᵐ (𝟙ᵐ _ ⊗ᵐ 𝟙ᵐ _) ⊗ᵐ η⁺ ≫ᵐ α _ _ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ α⁻¹ _ _ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ β⁻¹ ⊗ᵐ 𝟙ᵐ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ α _ _ _ ≫ᵐ α⁻¹ _ _ _ ≫ᵐ ε⁺ ⊗ᵐ 𝟙ᵐ _ ⊗ᵐ 𝟙ᵐ _ ≫ᵐ ℓ _) = functor_map V R (𝟙ᵐ _ ⊗ᵐ 𝟙ᵐ _) :=
by dsimp [functor_map]; exact R.relation_4_2

lemma functor_map_well_defined_8_1:
  functor_map V R (ρ⁻¹ _ ≫ᵐ (𝟙ᵐ _ ⊗ᵐ 𝟙ᵐ _) ⊗ᵐ η⁺ ≫ᵐ α _ _ _ ≫ᵐ 𝟙ᵐ ↑ ⊗ᵐ α⁻¹ _ _ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ β ⊗ᵐ 𝟙ᵐ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ α _ _ _ ≫ᵐ α⁻¹ _ _ _ ≫ᵐ ε⁺ ⊗ᵐ 𝟙ᵐ _ ⊗ᵐ 𝟙ᵐ _ ≫ᵐ η⁻ ⊗ᵐ 𝟙ᵐ _ ⊗ᵐ 𝟙ᵐ _ ≫ᵐ α _ _ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ α⁻¹ _ _ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ β⁻¹ ⊗ᵐ 𝟙ᵐ _ ≫ᵐ 𝟙ᵐ ↑ ⊗ᵐ α _ _ _ ≫ᵐ α⁻¹ _ _ _ ≫ᵐ (𝟙ᵐ _ ⊗ᵐ 𝟙ᵐ _) ⊗ᵐ ε⁻ ≫ᵐ ρ _) = functor_map V R (𝟙ᵐ _ ⊗ᵐ 𝟙ᵐ _) :=
by dsimp [functor_map]; exact R.relation_4_3

lemma functor_map_well_defined_8_2:
  functor_map V R (ρ⁻¹ _ ≫ᵐ (𝟙ᵐ _ ⊗ᵐ 𝟙ᵐ _) ⊗ᵐ η⁺ ≫ᵐ α _ _ _ ≫ᵐ 𝟙ᵐ ↑ ⊗ᵐ α⁻¹ _ _ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ β⁻¹ ⊗ᵐ 𝟙ᵐ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ α _ _ _ ≫ᵐ α⁻¹ _ _ _ ≫ᵐ ε⁺ ⊗ᵐ 𝟙ᵐ _ ⊗ᵐ 𝟙ᵐ _ ≫ᵐ η⁻ ⊗ᵐ 𝟙ᵐ _ ⊗ᵐ 𝟙ᵐ _ ≫ᵐ α _ _ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ α⁻¹ _ _ _ ≫ᵐ 𝟙ᵐ _ ⊗ᵐ β ⊗ᵐ 𝟙ᵐ _ ≫ᵐ 𝟙ᵐ ↑ ⊗ᵐ α _ _ _ ≫ᵐ α⁻¹ _ _ _ ≫ᵐ (𝟙ᵐ _ ⊗ᵐ 𝟙ᵐ _) ⊗ᵐ ε⁻ ≫ᵐ ρ _) = functor_map V R (𝟙ᵐ _ ⊗ᵐ 𝟙ᵐ _) :=
by dsimp [functor_map]; exact R.relation_4_4

lemma functor_map_well_defined {X Y}: ∀ (f g: X ⟶ᵐ Y), f ≈ g → functor_map V R f = functor_map V R g := begin
  intros f g r, induction r,
  { refl, },
  { rw r_ih, },
  { rw [r_ih_ᾰ, r_ih_ᾰ_1], },
  { simp only [functor_map, r_ih_ᾰ, r_ih_ᾰ_1], },
  { simp only [functor_map, category.id_comp'], },
  { simp only [functor_map, category.comp_id'], },
  { simp only [functor_map, category.assoc'], },
  { simp only [functor_map, r_ih_ᾰ, r_ih_ᾰ_1], },
  { simp only [functor_map, monoidal_category.tensor_id'], refl, },
  { simp only [functor_map, monoidal_category.tensor_comp'], },
  { simp only [functor_map, (α_ _ _ _).hom_inv_id'], refl, },
  { simp only [functor_map, (α_ _ _ _).inv_hom_id'], refl, },
  { simp only [functor_map, monoidal_category.associator_naturality'], },
  { simp only [functor_map, (λ_ _).hom_inv_id'], refl, },
  { simp only [functor_map, (λ_ _).inv_hom_id'], },
  { simp only [functor_map, monoidal_category.left_unitor_naturality'], dsimp at *, simp at *, },
  { simp only [functor_map, (ρ_ _).hom_inv_id'], refl, },
  { simp only [functor_map, (ρ_ _).inv_hom_id'], },
  { simp only [functor_map, monoidal_category.right_unitor_naturality'], dsimp at *, simp at *, },
  { dsimp [functor_map], rw monoidal_category.pentagon', },
  { simp only [functor_map, monoidal_category.triangle'], dsimp at *, simp at *, },
  exact aux.functor_map_well_defined_1_1 V R,
  exact aux.functor_map_well_defined_1_2 V R,
  exact aux.functor_map_well_defined_2_1 V R,
  exact aux.functor_map_well_defined_2_2 V R,
  exact aux.functor_map_well_defined_3_1 V R,
  exact aux.functor_map_well_defined_3_2 V R,
  exact aux.functor_map_well_defined_4_1 V R,
  exact aux.functor_map_well_defined_4_2 V R,
  exact aux.functor_map_well_defined_5 V R,
  exact aux.functor_map_well_defined_6_1 V R,
  exact aux.functor_map_well_defined_6_2 V R,
  exact aux.functor_map_well_defined_7_1 V R,
  exact aux.functor_map_well_defined_7_2 V R,
  exact aux.functor_map_well_defined_8_1 V R,
  exact aux.functor_map_well_defined_8_2 V R,
end

end aux

@[simp] def functor (R: enhanced_R_matrix C V): Tangle ⥤ C := {
  obj := functor_obj V,
  map := λ X Y f, quotient.lift_on' f (functor_map V R) (aux.functor_map_well_defined V R)
}

end enhanced_R_matrix
end kassel


example (p q r : Prop) (hp : p) (hq : q) (hr : r) : p ∧ q ∧ r :=
begin
  split,
  all_goals { try { split } },
  all_goals { assumption }
end


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.monoidal.Mon_
import Mathlib.PostPort

universes v₁ u₁ l

namespace Mathlib

/-!
# The category of module objects over a monoid object.
-/

/-- A module object for a monoid object, all internal to some monoidal category. -/
structure Mod {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C]
    (A : Mon_ C)
    where
  X : C
  act : Mon_.X A ⊗ X ⟶ X
  one_act' :
    autoParam ((Mon_.one A ⊗ 𝟙) ≫ act = category_theory.iso.hom λ_)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  assoc' :
    autoParam ((Mon_.mul A ⊗ 𝟙) ≫ act = category_theory.iso.hom α_ ≫ (𝟙 ⊗ act) ≫ act)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

@[simp] theorem Mod.one_act {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] {A : Mon_ C} (c : Mod A) :
    (Mon_.one A ⊗ 𝟙) ≫ Mod.act c = category_theory.iso.hom λ_ :=
  sorry

@[simp] theorem Mod.assoc {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] {A : Mon_ C} (c : Mod A) :
    (Mon_.mul A ⊗ 𝟙) ≫ Mod.act c = category_theory.iso.hom α_ ≫ (𝟙 ⊗ Mod.act c) ≫ Mod.act c :=
  sorry

@[simp] theorem Mod.one_act_assoc {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] {A : Mon_ C} (c : Mod A) {X' : C} (f' : Mod.X c ⟶ X') :
    (Mon_.one A ⊗ 𝟙) ≫ Mod.act c ≫ f' = category_theory.iso.hom λ_ ≫ f' :=
  sorry

namespace Mod

theorem assoc_flip {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C]
    {A : Mon_ C} (M : Mod A) :
    (𝟙 ⊗ act M) ≫ act M = category_theory.iso.inv α_ ≫ (Mon_.mul A ⊗ 𝟙) ≫ act M :=
  sorry

/-- A morphism of module objects. -/
structure hom {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C]
    {A : Mon_ C} (M : Mod A) (N : Mod A)
    where
  hom : X M ⟶ X N
  act_hom' :
    autoParam (act M ≫ hom = (𝟙 ⊗ hom) ≫ act N)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

@[simp] theorem hom.act_hom {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] {A : Mon_ C} {M : Mod A} {N : Mod A} (c : hom M N) :
    act M ≫ hom.hom c = (𝟙 ⊗ hom.hom c) ≫ act N :=
  sorry

@[simp] theorem hom.act_hom_assoc {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] {A : Mon_ C} {M : Mod A} {N : Mod A} (c : hom M N)
    {X' : C} (f' : X N ⟶ X') : act M ≫ hom.hom c ≫ f' = (𝟙 ⊗ hom.hom c) ≫ act N ≫ f' :=
  sorry

/-- The identity morphism on a module object. -/
def id {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C] {A : Mon_ C}
    (M : Mod A) : hom M M :=
  hom.mk 𝟙

protected instance hom_inhabited {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] {A : Mon_ C} (M : Mod A) : Inhabited (hom M M) :=
  { default := id M }

/-- Composition of module object morphisms. -/
def comp {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C]
    {A : Mon_ C} {M : Mod A} {N : Mod A} {O : Mod A} (f : hom M N) (g : hom N O) : hom M O :=
  hom.mk (hom.hom f ≫ hom.hom g)

protected instance category_theory.category {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] {A : Mon_ C} : category_theory.category (Mod A) :=
  category_theory.category.mk

@[simp] theorem id_hom' {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] {A : Mon_ C} (M : Mod A) : hom.hom 𝟙 = 𝟙 :=
  rfl

@[simp] theorem comp_hom' {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] {A : Mon_ C} {M : Mod A} {N : Mod A} {K : Mod A}
    (f : M ⟶ N) (g : N ⟶ K) : hom.hom (f ≫ g) = hom.hom f ≫ hom.hom g :=
  rfl

/-- A monoid object as a module over itself. -/
@[simp] theorem regular_X {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] (A : Mon_ C) : X (regular A) = Mon_.X A :=
  Eq.refl (X (regular A))

protected instance inhabited {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] (A : Mon_ C) : Inhabited (Mod A) :=
  { default := regular A }

/-- The forgetful functor from module objects to the ambient category. -/
def forget {C : Type u₁} [category_theory.category C] [category_theory.monoidal_category C]
    (A : Mon_ C) : Mod A ⥤ C :=
  category_theory.functor.mk (fun (A_1 : Mod A) => X A_1)
    fun (A_1 B : Mod A) (f : A_1 ⟶ B) => hom.hom f

/--
A morphism of monoid objects induces a "restriction" or "comap" functor
between the categories of module objects.
-/
@[simp] theorem comap_obj_act {C : Type u₁} [category_theory.category C]
    [category_theory.monoidal_category C] {A : Mon_ C} {B : Mon_ C} (f : A ⟶ B) (M : Mod B) :
    act (category_theory.functor.obj (comap f) M) = (Mon_.hom.hom f ⊗ 𝟙) ≫ act M :=
  Eq.refl (act (category_theory.functor.obj (comap f) M))

end Mathlib


-- import category_theory.opposites
-- import category_theory.full_subcategory
-- import category_theory.limits.types
-- import topology.Top.basic
-- import category_theory.limits.obviously

-- open category_theory
-- open category_theory.limits
-- open topological_space

-- universes u v u₁ v₁ u₂ v₂

-- variable (X : Top.{v})

-- local attribute [back] topological_space.is_open_inter
-- -- local attribute [back] opens.property

-- instance has_inter_open_set : has_inter (opens X) :=
-- { inter := λ U V, ⟨ U.val ∩ V.val, by obviously ⟩ }

-- instance has_inter_open_set_op : has_inter ((opens X)ᵒᵖ) := sorry -- has_inter_open_set X

-- -- def cover_intersections_index (I : Type v) : grothendieck_category (ParallelPair_functor (@prod.fst I I) (@prod.snd I I))
-- -- def cover_intersections (c : cover X) : (cover_intersections_index c.I) ⥤ open_set X :=
-- -- { obj := λ p, match p.1 with
-- --   | _1 := c.U p.2.1 ∩ c.U p.2.2
-- --   | _2 := c.U p.2
-- --   end,
-- --   map := λ p q f, sorry
-- -- }

-- -- @[tidy] meta def sbe := `[solve_by_elim [sum.inl, sum.inr, ulift.up, plift.up, trivial] {max_rep := 5}]

-- -- instance (I : Type v) : category (I × I ⊕ I) :=
-- -- { hom := λ X Y, match (X, Y) with
-- --   | (sum.inl (i, j), sum.inr k) := ulift (plift (i = k)) ⊕ ulift (plift (j = k))
-- --   | (sum.inl (i, j), sum.inl (i', j')) := ulift (plift (i = i' ∧ j = j'))
-- --   | (sum.inr k, sum.inr k') := ulift (plift (k = k'))
-- --   | (sum.inr k, sum.inl (i, j)) := pempty
-- --   end,
-- --   id := by tidy,
-- --   comp := by tidy,
-- -- }

-- structure cover :=
-- (I : Type v)
-- (U : I → (opens X))

-- variables {X}

-- def cover.union (c : cover X) : opens X :=
-- ⟨ set.Union (λ i : c.I, (c.U i).1),
--   begin
--   apply topological_space.is_open_sUnion,
--   tidy,
--   subst H_h,
--   exact (c.U H_w).2
--   end ⟩

-- def cover.sub (c : cover X) (i : c.I) : c.U i ⟶ c.union := sorry

-- definition cover.left (c : cover X) (i j : c.I) : (c.U i ∩ c.U j) ⟶ (c.U i) := by obviously
-- definition cover.right (c : cover X) (i j : c.I) : (c.U i ∩ c.U j) ⟶ (c.U j) := by obviously

-- section
-- variables {D : Type u₂} [𝒟 : category.{u₂ v₂} D]
-- variables {c : cover X} (i j : c.I) (F : (opens X)ᵒᵖ ⥤ D)
-- include 𝒟

-- definition res_left : (F.obj (c.U i)) ⟶ (F.obj ((c.U i) ∩ (c.U j))) :=
-- F.map (c.left i j)

-- definition res_right :=
-- F.map (c.right i j)

-- definition res_union : (F.obj (c.union)) ⟶ (F.obj ((c.U i))) :=
-- F.map (c.sub i)

-- @[simp] lemma res_left_right : res_union i F ≫ res_left i j F = res_union j F ≫ res_right i j F :=
-- begin
--   dsimp [res_union, res_left, res_right],
--   rw ← functor.map_comp,
--   rw ← functor.map_comp,
--   refl,
-- end
-- end

-- section
-- variables {V : Type u} [𝒱 : category.{u v} V] [has_products.{u v} V]
-- include 𝒱

-- variables (c : cover X) (F : (opens X)ᵒᵖ ⥤ V)

-- def sections : V :=
-- limits.pi.{u v} (λ i : c.I, F.obj (c.U i))

-- def overlaps : V :=
-- limits.pi.{u v} (λ p : c.I × c.I, F.obj (c.U p.1 ∩ c.U p.2))

-- def left : (sections c F) ⟶ (overlaps c F) :=
-- pi.pre _ (λ p : c.I × c.I, p.1) ≫ pi.map (λ p, res_left p.1 p.2 F)

-- def right : (sections c F) ⟶ (overlaps c F) :=
-- pi.pre _ (λ p : c.I × c.I, p.2) ≫ pi.map (λ p, res_right p.1 p.2 F)

-- def res : F.obj (c.union) ⟶ (sections c F) :=
-- pi.lift (λ i, res_union i F)

-- @[simp] lemma res_left_right' : res c F ≫ left c F = res c F ≫ right c F :=
-- begin
--   dsimp [left, right, res],
--   rw ← category.assoc,
--   simp,
--   rw ← category.assoc,
--   simp,
-- end

-- def cover_fork : fork (left c F) (right c F) :=
-- fork.of_ι (res c F) (by tidy)

-- class is_sheaf (presheaf : (opens X)ᵒᵖ ⥤ V) :=
-- (sheaf_condition : Π (c : cover X), is_equalizer (cover_fork c presheaf))

-- variables (X V)

-- structure sheaf  :=
-- (presheaf : (opens X)ᵒᵖ ⥤ V)
-- (sheaf_condition : is_sheaf presheaf)

-- end


import game.order.level08
import game.order.level02
import game.order.dumb
import game.order.lessdumb
open real

namespace xena -- hide
/-
lemma prod_nonneg_iff_eq_sign (a b : ℝ) : 0 ≤ a * b ↔ (a < 0 ∧ b < 0) ∨ (a > 0 ∧ b > 0) :=
begin
  sorry
  sorry
end

lemma reallydumb (a b : ℝ) : |a + b| = |a| + |b| ↔ (a < 0 ∧ b < 0) ∨ (a > 0 ∧ b > 0) :=
begin
  sorry
end

-/

end xena --hide


import for_mathlib.short_complex_projections
import for_mathlib.homology_map_datum

noncomputable theory

open category_theory category_theory.category category_theory.limits
open_locale zero_object

variables {J C : Type*} [category J] [category C] [has_zero_morphisms C]

namespace short_complex

namespace functor_category_equivalence

instance evaluation_preserves_zero_morphisms
  (j : J) : ((evaluation J C).obj j).preserves_zero_morphisms := ⟨λ F G, rfl⟩

/- deterministic timeouts may occur if we add @[simps] attributes --/

def functor : short_complex (J ⥤ C) ⥤ J ⥤ short_complex C :=
functor.flip
{ obj := λ j, functor.map_short_complex ((evaluation J C).obj j),
  map := λ i j f, nat_trans.map_short_complex ((evaluation J C).map f), }

@[simps]
def inverse.obj (F : (J ⥤ short_complex C)) : short_complex (J ⥤ C) :=
mk ((𝟙 F) ◫ φ₁₂) ((𝟙 F) ◫ φ₂₃) begin
  ext,
  simp only [nat_trans.comp_app, nat_trans.hcomp_app, φ₁₂_app, nat_trans.id_app,
    π₂_map, φ₂₃_app, π₃_map, assoc, zero_app],
  erw [id_comp, comp_id],
  apply short_complex.zero,
end

@[simps]
def inverse.map {F G : (J ⥤ short_complex C)} (φ : F ⟶ G) : inverse.obj F ⟶ inverse.obj G :=
begin
  refine ⟨φ ◫ 𝟙 _, φ ◫ 𝟙 _, φ ◫ 𝟙 _, _, _⟩;
  ext; dsimp; erw [comp_id, id_comp, id_comp, comp_id],
  exacts [(φ.app x).comm₁₂, (φ.app x).comm₂₃],
end

def inverse : (J ⥤ short_complex C) ⥤ short_complex (J ⥤ C) :=
{ obj := inverse.obj,
  map := λ F G, inverse.map,
  map_id' := λ F, by { ext; apply comp_id, },
  map_comp' := λ F₁ F₂ F₃ φ ψ, by { ext; dsimp; erw [id_comp, id_comp, id_comp], }, }

def unit_iso.obj (S : short_complex (J ⥤ C)) : S ≅ (functor ⋙ inverse).obj S :=
begin
  refine iso_mk _ _ _ _ _;
  try { refine nat_iso.of_components (λ X, iso.refl _) _,
    intros i j f, dsimp, erw [comp_id, id_comp], refl, },
  all_goals { ext, dsimp [functor, inverse], erw [comp_id, id_comp], },
end

def unit_iso : 𝟭 (short_complex (J ⥤ C)) ≅
  functor_category_equivalence.functor ⋙ functor_category_equivalence.inverse :=
nat_iso.of_components unit_iso.obj
(λ S₁ S₂ ψ, begin
  ext;
  dsimp [iso_mk, nat_iso.of_components, iso_mk, functor, inverse, unit_iso.obj];
  erw [comp_id, id_comp, id_comp],
end)

def counit_iso.obj (F : J ⥤ short_complex C) : (inverse ⋙ functor).obj F ≅ F :=
nat_iso.of_components
(λ j, begin
  refine iso_mk (iso.refl _) (iso.refl _) (iso.refl _) _ _,
  all_goals { dsimp [functor, inverse], erw [id_comp, comp_id, comp_id], },
end)
(λ i j f, by { ext; dsimp; erw [comp_id, id_comp]; refl, })

def counit_iso : functor_category_equivalence.inverse ⋙
  functor_category_equivalence.functor ≅ 𝟭 (J ⥤ short_complex C) :=
nat_iso.of_components counit_iso.obj
(λ F₁ F₂ φ, by { ext; dsimp [functor, inverse, counit_iso.obj]; erw [id_comp, comp_id], })

lemma functor_unit_iso_comp (F : short_complex (J ⥤ C)) :
  functor_category_equivalence.functor.map (functor_category_equivalence.unit_iso.hom.app F) ≫
  functor_category_equivalence.counit_iso.hom.app (functor_category_equivalence.functor.obj F) =
  𝟙 _ :=
begin
  dsimp [functor_category_equivalence.functor, functor_category_equivalence.unit_iso,
    functor_category_equivalence.inverse, functor_category_equivalence.counit_iso,
    evaluation, functor.flip, functor.map_short_complex,
    functor_category_equivalence.counit_iso.obj,
    functor_category_equivalence.unit_iso.obj,
    nat_iso.of_components],
  ext;
  apply id_comp,
end

end functor_category_equivalence

@[simps]
def functor_category_equivalence : short_complex (J ⥤ C) ≌ J ⥤ short_complex C :=
{ functor := functor_category_equivalence.functor,
  inverse := functor_category_equivalence.inverse,
  unit_iso := functor_category_equivalence.unit_iso,
  counit_iso := functor_category_equivalence.counit_iso,
  functor_unit_iso_comp' := functor_category_equivalence.functor_unit_iso_comp, }

@[simps]
def functor_lift {X Y Z : J ⥤ C} (f : X ⟶ Y) (g : Y ⟶ Z) (h : f ≫ g = 0) :
  J ⥤ short_complex C :=
functor_category_equivalence.functor.obj (mk f g h)

@[simps]
def ι_middle [has_zero_object C] : C ⥤ short_complex C :=
functor_lift (0 : 0 ⟶ 𝟭 C) (0 : 𝟭 C ⟶ 0) zero_comp

def ι_middle_homology_nat_iso {A : Type*} [category A] [abelian A] :
  𝟭 A ≅ ι_middle ⋙ homology_functor :=
nat_iso.of_components
(λ X, (homology_iso_datum.of_both_zeros _ _ rfl rfl).iso)
(λ X Y f, begin
  erw (homology_map_datum.of_both_are_zeros (ι_middle.map f) rfl rfl rfl rfl).homology_map_eq,
  erw iso.hom_inv_id_assoc,
  refl,
end)

lemma ι_middle_π₁_is_zero [has_zero_object C] :
  is_zero ((ι_middle : C ⥤ _ ) ⋙ short_complex.π₁) :=
begin
  rw functor.is_zero_iff,
  intro X,
  dsimp,
  simp only [functor.zero_obj],
end

lemma ι_middle_π₃_is_zero [has_zero_object C] :
  is_zero ((ι_middle : C ⥤ _ ) ⋙ short_complex.π₃) :=
begin
  rw functor.is_zero_iff,
  intro X,
  dsimp,
  simp only [functor.zero_obj],
end

@[simps]
def nat_trans_hom_mk {S₁ S₂ : J ⥤ short_complex C} (τ₁ : S₁ ⋙ π₁ ⟶ S₂ ⋙ π₁)
  (τ₂ : S₁ ⋙ π₂ ⟶ S₂ ⋙ π₂) (τ₃ : S₁ ⋙ π₃ ⟶ S₂ ⋙ π₃)
  (comm₁₂ : (𝟙 S₁) ◫ φ₁₂ ≫ τ₂ = τ₁ ≫ (𝟙 S₂) ◫ φ₁₂)
  (comm₂₃ : (𝟙 S₁) ◫ φ₂₃ ≫ τ₃ = τ₂ ≫ (𝟙 S₂) ◫ φ₂₃) :
  S₁ ⟶ S₂ :=
functor_category_equivalence.counit_iso.inv.app S₁ ≫
  functor_category_equivalence.functor.map (hom_mk τ₁ τ₂ τ₃ comm₁₂ comm₂₃) ≫
  functor_category_equivalence.counit_iso.hom.app S₂

lemma nat_trans_hom_mk_app_τ₂_eq {S₁ S₂ : J ⥤ short_complex C} (τ₁ : S₁ ⋙ π₁ ⟶ S₂ ⋙ π₁)
  (τ₂ : S₁ ⋙ π₂ ⟶ S₂ ⋙ π₂) (τ₃ : S₁ ⋙ π₃ ⟶ S₂ ⋙ π₃)
  (comm₁₂ : (𝟙 S₁) ◫ φ₁₂ ≫ τ₂ = τ₁ ≫ (𝟙 S₂) ◫ φ₁₂)
  (comm₂₃ : (𝟙 S₁) ◫ φ₂₃ ≫ τ₃ = τ₂ ≫ (𝟙 S₂) ◫ φ₂₃) (j : J) :
  ((nat_trans_hom_mk τ₁ τ₂ τ₃ comm₁₂ comm₂₃).app j).τ₂ = τ₂.app j :=
begin
  dsimp [functor_category_equivalence.counit_iso,
    functor_category_equivalence.counit_iso.obj, iso.refl],
  erw [id_comp, comp_id],
  refl,
end

@[simp, reassoc]
def nat_trans_hom_mk_comp {S₁ S₂ S₃ : J ⥤ short_complex C} (τ₁ : S₁ ⋙ π₁ ⟶ S₂ ⋙ π₁)
  (τ₂ : S₁ ⋙ π₂ ⟶ S₂ ⋙ π₂) (τ₃ : S₁ ⋙ π₃ ⟶ S₂ ⋙ π₃)
  (comm₁₂ : (𝟙 S₁) ◫ φ₁₂ ≫ τ₂ = τ₁ ≫ (𝟙 S₂) ◫ φ₁₂)
  (comm₂₃ : (𝟙 S₁) ◫ φ₂₃ ≫ τ₃ = τ₂ ≫ (𝟙 S₂) ◫ φ₂₃)
  (τ₁' : S₂ ⋙ π₁ ⟶ S₃ ⋙ π₁)
  (τ₂' : S₂ ⋙ π₂ ⟶ S₃ ⋙ π₂) (τ₃' : S₂ ⋙ π₃ ⟶ S₃ ⋙ π₃)
  (comm₁₂' : (𝟙 S₂) ◫ φ₁₂ ≫ τ₂' = τ₁' ≫ (𝟙 S₃) ◫ φ₁₂)
  (comm₂₃' : (𝟙 S₂) ◫ φ₂₃ ≫ τ₃' = τ₂' ≫ (𝟙 S₃) ◫ φ₂₃) :
  nat_trans_hom_mk τ₁ τ₂ τ₃ comm₁₂ comm₂₃ ≫
    nat_trans_hom_mk τ₁' τ₂' τ₃' comm₁₂' comm₂₃' =
    nat_trans_hom_mk (τ₁ ≫ τ₁') (τ₂ ≫ τ₂') (τ₃ ≫ τ₃')
    (by rw [← assoc, comm₁₂, assoc, comm₁₂', assoc])
    (by rw [← assoc, comm₂₃, assoc, comm₂₃', assoc]) :=
begin
  ext,
  all_goals
  { dsimp [functor_category_equivalence.counit_iso, nat_iso.of_components,
      functor_category_equivalence.counit_iso.obj,
      functor_category_equivalence.functor],
    erw [id_comp, id_comp, id_comp, comp_id, comp_id, comp_id], },
end

@[simp]
def nat_trans_hom_mk_id (S : J ⥤ short_complex C) :
  nat_trans_hom_mk (𝟙 (S ⋙ π₁)) (𝟙 (S ⋙ π₂)) (𝟙 (S ⋙ π₃))
  (by simp only [id_comp, comp_id]) (by simp only [id_comp, comp_id]) = 𝟙 S :=
begin
  ext,
  all_goals
  { dsimp [functor_category_equivalence.counit_iso, nat_iso.of_components,
      functor_category_equivalence.counit_iso.obj,
      functor_category_equivalence.functor],
    erw [id_comp, comp_id],
    refl, },
end

@[simps]
def functor_nat_iso_mk {S₁ S₂ : J ⥤ short_complex C} (τ₁ : S₁ ⋙ π₁ ≅ S₂ ⋙ π₁)
  (τ₂ : S₁ ⋙ π₂ ≅ S₂ ⋙ π₂) (τ₃ : S₁ ⋙ π₃ ≅ S₂ ⋙ π₃)
  (comm₁₂ : (𝟙 S₁) ◫ φ₁₂ ≫ τ₂.hom = τ₁.hom ≫ (𝟙 S₂) ◫ φ₁₂)
  (comm₂₃ : (𝟙 S₁) ◫ φ₂₃ ≫ τ₃.hom = τ₂.hom ≫ (𝟙 S₂) ◫ φ₂₃) :
  S₁ ≅ S₂ :=
begin
  have comm₁₂' : 𝟙 S₂ ◫ φ₁₂ ≫ τ₂.inv = τ₁.inv ≫ 𝟙 S₁ ◫ φ₁₂,
  { simpa only [← cancel_epi τ₁.hom, ← cancel_mono τ₂.hom, assoc, τ₂.inv_hom_id, comp_id,
      τ₁.hom_inv_id_assoc] using comm₁₂.symm, },
  have comm₂₃' : 𝟙 S₂ ◫ φ₂₃ ≫ τ₃.inv = τ₂.inv ≫ 𝟙 S₁ ◫ φ₂₃,
  { simpa only [← cancel_epi τ₂.hom, ← cancel_mono τ₃.hom, assoc, τ₃.inv_hom_id, comp_id,
      τ₂.hom_inv_id_assoc] using comm₂₃.symm, },
  exact
  { hom := nat_trans_hom_mk τ₁.hom τ₂.hom τ₃.hom comm₁₂ comm₂₃,
    inv := nat_trans_hom_mk τ₁.inv τ₂.inv τ₃.inv comm₁₂' comm₂₃',
    hom_inv_id' := by simp only [nat_trans_hom_mk_comp, iso.hom_inv_id, nat_trans_hom_mk_id],
    inv_hom_id' := by simp only [nat_trans_hom_mk_comp, iso.inv_hom_id, nat_trans_hom_mk_id], },
end

end short_complex


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.fintype.basic
import Mathlib.category_theory.fin_category
import Mathlib.category_theory.limits.shapes.products
import Mathlib.category_theory.limits.shapes.equalizers
import Mathlib.category_theory.limits.shapes.pullbacks
import Mathlib.PostPort

universes v u u_1

namespace Mathlib

/-!
# Categories with finite limits.

A typeclass for categories with all finite (co)limits.
-/

namespace category_theory.limits

/--
A category has all finite limits if every functor `J ⥤ C` with a `fin_category J` instance
has a limit.

This is often called 'finitely complete'.
-/
-- We can't just made this an `abbreviation`

-- because of https://github.com/leanprover-community/lean/issues/429

def has_finite_limits (C : Type u) [category C] :=
  ∀ (J : Type v) [𝒥 : small_category J] [_inst_2 : fin_category J], has_limits_of_shape J C

protected instance has_limits_of_shape_of_has_finite_limits (C : Type u) [category C] (J : Type v) [small_category J] [fin_category J] [has_finite_limits C] : has_limits_of_shape J C :=
  _inst_4 J

/-- If `C` has all limits, it has finite limits. -/
theorem has_finite_limits_of_has_limits (C : Type u) [category C] [has_limits C] : has_finite_limits C :=
  fun (J : Type v) (𝒥₁ : small_category J) (𝒥₂ : fin_category J) => limits.has_limits_of_shape_of_has_limits

/--
A category has all finite colimits if every functor `J ⥤ C` with a `fin_category J` instance
has a colimit.

This is often called 'finitely cocomplete'.
-/
def has_finite_colimits (C : Type u) [category C] :=
  ∀ (J : Type v) [𝒥 : small_category J] [_inst_2 : fin_category J], has_colimits_of_shape J C

protected instance has_colimits_of_shape_of_has_finite_colimits (C : Type u) [category C] (J : Type v) [small_category J] [fin_category J] [has_finite_colimits C] : has_colimits_of_shape J C :=
  _inst_4 J

/-- If `C` has all colimits, it has finite colimits. -/
theorem has_finite_colimits_of_has_colimits (C : Type u) [category C] [has_colimits C] : has_finite_colimits C :=
  fun (J : Type v) (𝒥₁ : small_category J) (𝒥₂ : fin_category J) => limits.has_colimits_of_shape_of_has_colimits

protected instance fintype_walking_parallel_pair : fintype walking_parallel_pair :=
  fintype.mk (list.to_finset [walking_parallel_pair.zero, walking_parallel_pair.one]) sorry

protected instance walking_parallel_pair_hom.fintype (j : walking_parallel_pair) (j' : walking_parallel_pair) : fintype (walking_parallel_pair_hom j j') :=
  fintype.mk
    (walking_parallel_pair.rec_on j
      (walking_parallel_pair.rec_on j' (list.to_finset [walking_parallel_pair_hom.id walking_parallel_pair.zero])
        (list.to_finset [walking_parallel_pair_hom.left, walking_parallel_pair_hom.right]))
      (walking_parallel_pair.rec_on j' ∅ (list.to_finset [walking_parallel_pair_hom.id walking_parallel_pair.one])))
    sorry

protected instance walking_parallel_pair.category_theory.fin_category : fin_category walking_parallel_pair :=
  fin_category.mk

/-- Equalizers are finite limits, so if `C` has all finite limits, it also has all equalizers -/
/-- Coequalizers are finite colimits, of if `C` has all finite colimits, it also has all
    coequalizers -/
namespace wide_pullback_shape

protected instance fintype_obj {J : Type v} [fintype J] : fintype (wide_pullback_shape J) :=
  eq.mpr sorry option.fintype

protected instance fintype_hom {J : Type v} [DecidableEq J] (j : wide_pullback_shape J) (j' : wide_pullback_shape J) : fintype (j ⟶ j') :=
  fintype.mk
    (option.cases_on j' (option.cases_on j (singleton (hom.id none)) fun (j : J) => singleton (hom.term j))
      fun (j' : J) =>
        dite (some j' = j) (fun (h : some j' = j) => eq.mpr sorry (singleton (hom.id j))) fun (h : ¬some j' = j) => ∅)
    sorry

end wide_pullback_shape

namespace wide_pushout_shape

protected instance fintype_obj {J : Type v} [fintype J] : fintype (wide_pushout_shape J) :=
  eq.mpr sorry option.fintype

protected instance fintype_hom {J : Type v} [DecidableEq J] (j : wide_pushout_shape J) (j' : wide_pushout_shape J) : fintype (j ⟶ j') :=
  fintype.mk
    (option.cases_on j (option.cases_on j' (singleton (hom.id none)) fun (j' : J) => singleton (hom.init j'))
      fun (j : J) =>
        dite (some j = j') (fun (h : some j = j') => eq.mpr sorry (singleton (hom.id j'))) fun (h : ¬some j = j') => ∅)
    sorry

end wide_pushout_shape

protected instance fin_category_wide_pullback {J : Type v} [DecidableEq J] [fintype J] : fin_category (wide_pullback_shape J) :=
  fin_category.mk

protected instance fin_category_wide_pushout {J : Type v} [DecidableEq J] [fintype J] : fin_category (wide_pushout_shape J) :=
  fin_category.mk

/--
`has_finite_wide_pullbacks` represents a choice of wide pullback
for every finite collection of morphisms
-/
-- We can't just made this an `abbreviation`

-- because of https://github.com/leanprover-community/lean/issues/429

def has_finite_wide_pullbacks (C : Type u) [category C] :=
  ∀ (J : Type v) [_inst_2 : DecidableEq J] [_inst_3 : fintype J], has_limits_of_shape (wide_pullback_shape J) C

protected instance has_limits_of_shape_wide_pullback_shape (C : Type u) [category C] (J : Type v) [fintype J] [has_finite_wide_pullbacks C] : has_limits_of_shape (wide_pullback_shape J) C :=
  _inst_3 J

/--
`has_finite_wide_pushouts` represents a choice of wide pushout
for every finite collection of morphisms
-/
def has_finite_wide_pushouts (C : Type u) [category C] :=
  ∀ (J : Type v) [_inst_2 : DecidableEq J] [_inst_3 : fintype J], has_colimits_of_shape (wide_pushout_shape J) C

protected instance has_colimits_of_shape_wide_pushout_shape (C : Type u) [category C] (J : Type v) [fintype J] [has_finite_wide_pushouts C] : has_colimits_of_shape (wide_pushout_shape J) C :=
  _inst_3 J

/--
Finite wide pullbacks are finite limits, so if `C` has all finite limits,
it also has finite wide pullbacks
-/
theorem has_finite_wide_pullbacks_of_has_finite_limits (C : Type u) [category C] [has_finite_limits C] : has_finite_wide_pullbacks C :=
  fun (J : Type v) (_x : DecidableEq J) (_x_1 : fintype J) =>
    limits.has_limits_of_shape_of_has_finite_limits C (wide_pullback_shape J)

/--
Finite wide pushouts are finite colimits, so if `C` has all finite colimits,
it also has finite wide pushouts
-/
theorem has_finite_wide_pushouts_of_has_finite_limits (C : Type u) [category C] [has_finite_colimits C] : has_finite_wide_pushouts C :=
  fun (J : Type v) (_x : DecidableEq J) (_x_1 : fintype J) =>
    limits.has_colimits_of_shape_of_has_finite_colimits C (wide_pushout_shape J)

protected instance fintype_walking_pair : fintype walking_pair :=
  fintype.mk (insert walking_pair.left (singleton walking_pair.right)) sorry


import Smt

theorem refl (p : Prop) : p = p := by
  smt


set_option pp.analyze.trustSubst true
set_option pp.proofs false
example (h : α = β) : h ▸ (a : α) = (b : β) := _
example (h : α = β) : id h ▸ (a : α) = (b : β) := _
example (h : α = β) : id h ▸ (a : α) = (b : β) := by simp
set_option pp.proofs.withType false
example (h : α = β) : id h ▸ (a : α) = (b : β) := _
set_option pp.proofs true
example (h : α = β) : id h ▸ (a : α) = (b : β) := _


import Preloaded tactic

-- Task 1: Prove that n + m = n + m
theorem immediate : ∀ n m : ℕ, n + m = n + m :=
  by intros; refl

-- Task 2: Prove that n + m = m + n
theorem plus_comm : ∀ n m : ℕ, n + m = m + n :=
  by intros; apply add_comm

-- Task 3: Prove excluded middle
theorem excluded_middle : ∀ p : Prop, p ∨ ¬p := em

-- Task 4: Prove that 1 + 1 = 3
axiom one_plus_one_is_three : 1 + 1 = 3


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

/-!
# Braided and symmetric monoidal categories

The basic definitions of braided monoidal categories, and symmetric monoidal categories,
as well as braided functors.

## Implementation note

We make `braided_monoidal_category` another typeclass, but then have `symmetric_monoidal_category`
extend this. The rationale is that we are not carrying any additional data,
just requiring a property.

## Future work

* Construct the Drinfeld center of a monoidal category as a braided monoidal category.
* Say something about pseudo-natural transformations.

-/

open category_theory

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

namespace category_theory

/--
A braided monoidal category is a monoidal category equipped with a braiding isomorphism
`β_ X Y : X ⊗ Y ≅ Y ⊗ X`
which is natural in both arguments,
and also satisfies the two hexagon identities.
-/
class braided_category (C : Type u) [category.{v} C] [monoidal_category.{v} C] :=
-- braiding natural iso:
(braiding             : Π X Y : C, X ⊗ Y ≅ Y ⊗ X)
(braiding_naturality' : ∀ {X X' Y Y' : C} (f : X ⟶ Y) (g : X' ⟶ Y'),
  (f ⊗ g) ≫ (braiding Y Y').hom = (braiding X X').hom ≫ (g ⊗ f) . obviously)
-- hexagon identities:
(hexagon_forward'     : Π X Y Z : C,
    (α_ X Y Z).hom ≫ (braiding X (Y ⊗ Z)).hom ≫ (α_ Y Z X).hom
  = ((braiding X Y).hom ⊗ (𝟙 Z)) ≫ (α_ Y X Z).hom ≫ ((𝟙 Y) ⊗ (braiding X Z).hom)
  . obviously)
(hexagon_reverse'     : Π X Y Z : C,
    (α_ X Y Z).inv ≫ (braiding (X ⊗ Y) Z).hom ≫ (α_ Z X Y).inv
  = ((𝟙 X) ⊗ (braiding Y Z).hom) ≫ (α_ X Z Y).inv ≫ ((braiding X Z).hom ⊗ (𝟙 Y))
  . obviously)

restate_axiom braided_category.braiding_naturality'
attribute [simp,reassoc] braided_category.braiding_naturality
restate_axiom braided_category.hexagon_forward'
restate_axiom braided_category.hexagon_reverse'
attribute [reassoc] braided_category.hexagon_forward braided_category.hexagon_reverse

open category
open monoidal_category
open braided_category

notation `β_` := braiding

/--
Verifying the axioms for a braiding by checking that the candidate braiding is sent to a braiding
by a faithful monoidal functor.
-/
def braided_category_of_faithful {C D : Type*} [category C] [category D]
  [monoidal_category C] [monoidal_category D] (F : monoidal_functor C D) [faithful F.to_functor]
  [braided_category D] (β : Π X Y : C, X ⊗ Y ≅ Y ⊗ X)
  (w : ∀ X Y, F.μ _ _ ≫ F.map (β X Y).hom = (β_ _ _).hom ≫ F.μ _ _) : braided_category C :=
{ braiding := β,
  braiding_naturality' := begin
    intros,
    apply F.to_functor.map_injective,
    refine (cancel_epi (F.μ _ _)).1 _,
    rw [functor.map_comp, ←lax_monoidal_functor.μ_natural_assoc, w, functor.map_comp, reassoc_of w,
      braiding_naturality_assoc, lax_monoidal_functor.μ_natural],
  end,
  hexagon_forward' := begin
    intros,
    apply F.to_functor.map_injective,
    refine (cancel_epi (F.μ _ _)).1 _,
    refine (cancel_epi (F.μ _ _ ⊗ 𝟙 _)).1 _,
    rw [functor.map_comp, functor.map_comp, functor.map_comp, functor.map_comp,
      ←lax_monoidal_functor.μ_natural_assoc, functor.map_id, ←comp_tensor_id_assoc, w,
      comp_tensor_id, category.assoc, lax_monoidal_functor.associativity_assoc,
      lax_monoidal_functor.associativity_assoc, ←lax_monoidal_functor.μ_natural, functor.map_id,
      ←id_tensor_comp_assoc, w, id_tensor_comp_assoc, reassoc_of w, braiding_naturality_assoc,
      lax_monoidal_functor.associativity, hexagon_forward_assoc],
  end,
  hexagon_reverse' := begin
    intros,
    apply F.to_functor.map_injective,
    refine (cancel_epi (F.μ _ _)).1 _,
    refine (cancel_epi (𝟙 _ ⊗ F.μ _ _)).1 _,
    rw [functor.map_comp, functor.map_comp, functor.map_comp, functor.map_comp,
      ←lax_monoidal_functor.μ_natural_assoc, functor.map_id, ←id_tensor_comp_assoc, w,
      id_tensor_comp_assoc, lax_monoidal_functor.associativity_inv_assoc,
      lax_monoidal_functor.associativity_inv_assoc, ←lax_monoidal_functor.μ_natural, functor.map_id,
      ←comp_tensor_id_assoc, w, comp_tensor_id_assoc, reassoc_of w, braiding_naturality_assoc,
      lax_monoidal_functor.associativity_inv, hexagon_reverse_assoc],
  end, }

/-- Pull back a braiding along a fully faithful monoidal functor. -/
noncomputable
def braided_category_of_fully_faithful {C D : Type*} [category C] [category D]
  [monoidal_category C] [monoidal_category D] (F : monoidal_functor C D)
  [full F.to_functor] [faithful F.to_functor]
  [braided_category D] : braided_category C :=
braided_category_of_faithful F (λ X Y, F.to_functor.preimage_iso
  ((as_iso (F.μ _ _)).symm ≪≫ β_ (F.obj X) (F.obj Y) ≪≫ (as_iso (F.μ _ _))))
  (by tidy)

section
/-!
We now establish how the braiding interacts with the unitors.

I couldn't find a detailed proof in print, but this is discussed in:

* Proposition 1 of André Joyal and Ross Street,
  "Braided monoidal categories", Macquarie Math Reports 860081 (1986).
* Proposition 2.1 of André Joyal and Ross Street,
  "Braided tensor categories" , Adv. Math. 102 (1993), 20–78.
* Exercise 8.1.6 of Etingof, Gelaki, Nikshych, Ostrik,
  "Tensor categories", vol 25, Mathematical Surveys and Monographs (2015), AMS.
-/

variables (C : Type u₁) [category.{v₁} C] [monoidal_category C] [braided_category C]

lemma braiding_left_unitor_aux₁ (X : C) :
  (α_ (𝟙_ C) (𝟙_ C) X).hom ≫ (𝟙 (𝟙_ C) ⊗ (β_ X (𝟙_ C)).inv) ≫ (α_ _ X _).inv ≫ ((λ_ X).hom ⊗ 𝟙 _) =
  ((λ_ _).hom ⊗ 𝟙 X) ≫ (β_ X (𝟙_ C)).inv :=
by { rw [←left_unitor_tensor, left_unitor_naturality], simp, }

lemma braiding_left_unitor_aux₂ (X : C) :
  ((β_ X (𝟙_ C)).hom ⊗ (𝟙 (𝟙_ C))) ≫ ((λ_ X).hom ⊗ (𝟙 (𝟙_ C))) = (ρ_ X).hom ⊗ (𝟙 (𝟙_ C)) :=
calc ((β_ X (𝟙_ C)).hom ⊗ (𝟙 (𝟙_ C))) ≫ ((λ_ X).hom ⊗ (𝟙 (𝟙_ C)))
    = ((β_ X (𝟙_ C)).hom ⊗ (𝟙 (𝟙_ C))) ≫ (α_ _ _ _).hom ≫ (α_ _ _ _).inv ≫
        ((λ_ X).hom ⊗ (𝟙 (𝟙_ C)))
         : by coherence
... = ((β_ X (𝟙_ C)).hom ⊗ (𝟙 (𝟙_ C))) ≫ (α_ _ _ _).hom ≫ (𝟙 _ ⊗ (β_ X _).hom) ≫
        (𝟙 _ ⊗ (β_ X _).inv) ≫ (α_ _ _ _).inv ≫ ((λ_ X).hom ⊗ (𝟙 (𝟙_ C)))
         : by { slice_rhs 3 4 { rw [←id_tensor_comp, iso.hom_inv_id, tensor_id], }, rw [id_comp], }
... = (α_ _ _ _).hom ≫ (β_ _ _).hom ≫
        (α_ _ _ _).hom ≫ (𝟙 _ ⊗ (β_ X _).inv) ≫ (α_ _ _ _).inv ≫ ((λ_ X).hom ⊗ (𝟙 (𝟙_ C)))
         : by { slice_lhs 1 3 { rw ←hexagon_forward }, simp only [assoc], }
... = (α_ _ _ _).hom ≫ (β_ _ _).hom ≫ ((λ_ _).hom ⊗ 𝟙 X) ≫ (β_ X _).inv
         : by rw braiding_left_unitor_aux₁
... = (α_ _ _ _).hom ≫ (𝟙 _ ⊗ (λ_ _).hom) ≫ (β_ _ _).hom ≫ (β_ X _).inv
         : by { slice_lhs 2 3 { rw [←braiding_naturality] }, simp only [assoc], }
... = (α_ _ _ _).hom ≫ (𝟙 _ ⊗ (λ_ _).hom)
         : by rw [iso.hom_inv_id, comp_id]
... = (ρ_ X).hom ⊗ (𝟙 (𝟙_ C))
         : by rw triangle

@[simp]
lemma braiding_left_unitor (X : C) : (β_ X (𝟙_ C)).hom ≫ (λ_ X).hom = (ρ_ X).hom :=
by rw [←tensor_right_iff, comp_tensor_id, braiding_left_unitor_aux₂]

lemma braiding_right_unitor_aux₁ (X : C) :
  (α_ X (𝟙_ C) (𝟙_ C)).inv ≫ ((β_ (𝟙_ C) X).inv ⊗ 𝟙 (𝟙_ C)) ≫ (α_ _ X _).hom ≫ (𝟙 _ ⊗ (ρ_ X).hom) =
  (𝟙 X ⊗ (ρ_ _).hom) ≫ (β_ (𝟙_ C) X).inv :=
by { rw [←right_unitor_tensor, right_unitor_naturality], simp, }

lemma braiding_right_unitor_aux₂ (X : C) :
  ((𝟙 (𝟙_ C)) ⊗ (β_ (𝟙_ C) X).hom) ≫ ((𝟙 (𝟙_ C)) ⊗ (ρ_ X).hom) = (𝟙 (𝟙_ C)) ⊗ (λ_ X).hom :=
calc ((𝟙 (𝟙_ C)) ⊗ (β_ (𝟙_ C) X).hom) ≫ ((𝟙 (𝟙_ C)) ⊗ (ρ_ X).hom)
    = ((𝟙 (𝟙_ C)) ⊗ (β_ (𝟙_ C) X).hom) ≫ (α_ _ _ _).inv ≫ (α_ _ _ _).hom ≫
        ((𝟙 (𝟙_ C)) ⊗ (ρ_ X).hom)
         : by coherence
... = ((𝟙 (𝟙_ C)) ⊗ (β_ (𝟙_ C) X).hom) ≫ (α_ _ _ _).inv ≫ ((β_ _ X).hom ⊗ 𝟙 _) ≫
        ((β_ _ X).inv ⊗ 𝟙 _) ≫ (α_ _ _ _).hom ≫ ((𝟙 (𝟙_ C)) ⊗ (ρ_ X).hom)
         : by { slice_rhs 3 4 { rw [←comp_tensor_id, iso.hom_inv_id, tensor_id], }, rw [id_comp], }
... = (α_ _ _ _).inv ≫ (β_ _ _).hom ≫
        (α_ _ _ _).inv ≫ ((β_ _ X).inv ⊗ 𝟙 _) ≫ (α_ _ _ _).hom ≫ ((𝟙 (𝟙_ C)) ⊗ (ρ_ X).hom)
         : by { slice_lhs 1 3 { rw ←hexagon_reverse }, simp only [assoc], }
... = (α_ _ _ _).inv ≫ (β_ _ _).hom ≫ (𝟙 X ⊗ (ρ_ _).hom) ≫ (β_ _ X).inv
         : by rw braiding_right_unitor_aux₁
... = (α_ _ _ _).inv ≫ ((ρ_ _).hom ⊗ 𝟙 _) ≫ (β_ _ X).hom ≫ (β_ _ _).inv
         : by { slice_lhs 2 3 { rw [←braiding_naturality] }, simp only [assoc], }
... = (α_ _ _ _).inv ≫ ((ρ_ _).hom ⊗ 𝟙 _)
         : by rw [iso.hom_inv_id, comp_id]
... = (𝟙 (𝟙_ C)) ⊗ (λ_ X).hom
         : by rw [triangle_assoc_comp_right]

@[simp]
lemma braiding_right_unitor (X : C) : (β_ (𝟙_ C) X).hom ≫ (ρ_ X).hom = (λ_ X).hom :=
by rw [←tensor_left_iff, id_tensor_comp, braiding_right_unitor_aux₂]

@[simp]
lemma left_unitor_inv_braiding (X : C) : (λ_ X).inv ≫ (β_ (𝟙_ C) X).hom = (ρ_ X).inv :=
begin
  apply (cancel_mono (ρ_ X).hom).1,
  simp only [assoc, braiding_right_unitor, iso.inv_hom_id],
end

@[simp]
lemma right_unitor_inv_braiding (X : C) : (ρ_ X).inv ≫ (β_ X (𝟙_ C)).hom = (λ_ X).inv :=
begin
  apply (cancel_mono (λ_ X).hom).1,
  simp only [assoc, braiding_left_unitor, iso.inv_hom_id],
end

end

/--
A symmetric monoidal category is a braided monoidal category for which the braiding is symmetric.

See <https://stacks.math.columbia.edu/tag/0FFW>.
-/
class symmetric_category (C : Type u) [category.{v} C] [monoidal_category.{v} C]
   extends braided_category.{v} C :=
-- braiding symmetric:
(symmetry' : ∀ X Y : C, (β_ X Y).hom ≫ (β_ Y X).hom = 𝟙 (X ⊗ Y) . obviously)

restate_axiom symmetric_category.symmetry'
attribute [simp,reassoc] symmetric_category.symmetry

variables (C : Type u₁) [category.{v₁} C] [monoidal_category C] [braided_category C]
variables (D : Type u₂) [category.{v₂} D] [monoidal_category D] [braided_category D]
variables (E : Type u₃) [category.{v₃} E] [monoidal_category E] [braided_category E]

/--
A lax braided functor between braided monoidal categories is a lax monoidal functor
which preserves the braiding.
-/
structure lax_braided_functor extends lax_monoidal_functor C D :=
(braided' : ∀ X Y : C, μ X Y ≫ map (β_ X Y).hom = (β_ (obj X) (obj Y)).hom ≫ μ Y X . obviously)

restate_axiom lax_braided_functor.braided'

namespace lax_braided_functor

/-- The identity lax braided monoidal functor. -/
@[simps] def id : lax_braided_functor C C :=
{ .. monoidal_functor.id C }

instance : inhabited (lax_braided_functor C C) := ⟨id C⟩

variables {C D E}

/-- The composition of lax braided monoidal functors. -/
@[simps]
def comp (F : lax_braided_functor C D) (G : lax_braided_functor D E) : lax_braided_functor C E :=
{ braided' := λ X Y,
  begin
    dsimp,
    slice_lhs 2 3 { rw [←category_theory.functor.map_comp, F.braided,
      category_theory.functor.map_comp], },
    slice_lhs 1 2 { rw [G.braided], },
    simp only [category.assoc],
  end,
  ..(lax_monoidal_functor.comp F.to_lax_monoidal_functor G.to_lax_monoidal_functor) }

instance category_lax_braided_functor : category (lax_braided_functor C D) :=
induced_category.category lax_braided_functor.to_lax_monoidal_functor

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

/--
Interpret a natural isomorphism of the underlyling lax monoidal functors as an
isomorphism of the lax braided monoidal functors.
-/
@[simps]
def mk_iso {F G : lax_braided_functor C D}
  (i : F.to_lax_monoidal_functor ≅ G.to_lax_monoidal_functor) : F ≅ G :=
{ ..i }

end lax_braided_functor

/--
A braided functor between braided monoidal categories is a monoidal functor
which preserves the braiding.
-/
structure braided_functor extends monoidal_functor C D :=
-- Note this is stated differently than for `lax_braided_functor`.
-- We move the `μ X Y` to the right hand side,
-- so that this makes a good `@[simp]` lemma.
(braided' :
  ∀ X Y : C, map (β_ X Y).hom = inv (μ X Y) ≫ (β_ (obj X) (obj Y)).hom ≫ μ Y X . obviously)

restate_axiom braided_functor.braided'
attribute [simp] braided_functor.braided

/-- A braided category with a braided functor to a symmetric category is itself symmetric. -/
def symmetric_category_of_faithful {C D : Type*} [category C] [category D]
  [monoidal_category C] [monoidal_category D] [braided_category C] [symmetric_category D]
  (F : braided_functor C D) [faithful F.to_functor] : symmetric_category C :=
{ symmetry' := λ X Y, F.to_functor.map_injective (by simp), }

namespace braided_functor

/-- Turn a braided functor into a lax braided functor. -/
@[simps]
def to_lax_braided_functor (F : braided_functor C D) : lax_braided_functor C D :=
{ braided' := λ X Y, by { rw F.braided, simp, }
  .. F }

/-- The identity braided monoidal functor. -/
@[simps] def id : braided_functor C C :=
{ .. monoidal_functor.id C }

instance : inhabited (braided_functor C C) := ⟨id C⟩

variables {C D E}

/-- The composition of braided monoidal functors. -/
@[simps]
def comp (F : braided_functor C D) (G : braided_functor D E) : braided_functor C E :=
{ ..(monoidal_functor.comp F.to_monoidal_functor G.to_monoidal_functor) }

instance category_braided_functor : category (braided_functor C D) :=
induced_category.category braided_functor.to_monoidal_functor

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

/--
Interpret a natural isomorphism of the underlyling monoidal functors as an
isomorphism of the braided monoidal functors.
-/
@[simps]
def mk_iso {F G : braided_functor C D}
  (i : F.to_monoidal_functor ≅ G.to_monoidal_functor) : F ≅ G :=
{ ..i }

end braided_functor

section comm_monoid

variables (M : Type u) [comm_monoid M]

instance : braided_category (discrete M) :=
{ braiding := λ X Y, discrete.eq_to_iso (mul_comm X.as Y.as), }

variables {M} {N : Type u} [comm_monoid N]

/--
A multiplicative morphism between commutative monoids gives a braided functor between
the corresponding discrete braided monoidal categories.
-/
@[simps]
def discrete.braided_functor (F : M →* N) : braided_functor (discrete M) (discrete N) :=
{ ..discrete.monoidal_functor F }

end comm_monoid

section tensor

/-- The strength of the tensor product functor from `C × C` to `C`. -/
def tensor_μ (X Y : C × C) : (tensor C).obj X ⊗ (tensor C).obj Y ⟶ (tensor C).obj (X ⊗ Y) :=
(α_ X.1 X.2 (Y.1 ⊗ Y.2)).hom ≫ (𝟙 X.1 ⊗ (α_ X.2 Y.1 Y.2).inv) ≫
  (𝟙 X.1 ⊗ ((β_ X.2 Y.1).hom ⊗ 𝟙 Y.2)) ≫
  (𝟙 X.1 ⊗ (α_ Y.1 X.2 Y.2).hom) ≫ (α_ X.1 Y.1 (X.2 ⊗ Y.2)).inv

lemma tensor_μ_def₁ (X₁ X₂ Y₁ Y₂ : C) :
    tensor_μ C (X₁, X₂) (Y₁, Y₂) ≫ (α_ X₁ Y₁ (X₂ ⊗ Y₂)).hom ≫ (𝟙 X₁ ⊗ (α_ Y₁ X₂ Y₂).inv)
  = (α_ X₁ X₂ (Y₁ ⊗ Y₂)).hom ≫ (𝟙 X₁ ⊗ (α_ X₂ Y₁ Y₂).inv) ≫ (𝟙 X₁ ⊗ ((β_ X₂ Y₁).hom ⊗ 𝟙 Y₂)) :=
by { dsimp [tensor_μ], simp }

lemma tensor_μ_def₂ (X₁ X₂ Y₁ Y₂ : C) :
    (𝟙 X₁ ⊗ (α_ X₂ Y₁ Y₂).hom) ≫ (α_ X₁ X₂ (Y₁ ⊗ Y₂)).inv ≫ tensor_μ C (X₁, X₂) (Y₁, Y₂)
  = (𝟙 X₁ ⊗ ((β_ X₂ Y₁).hom ⊗ 𝟙 Y₂)) ≫ (𝟙 X₁ ⊗ (α_ Y₁ X₂ Y₂).hom) ≫ (α_ X₁ Y₁ (X₂ ⊗ Y₂)).inv :=
by { dsimp [tensor_μ], simp }

lemma tensor_μ_natural {X₁ X₂ Y₁ Y₂ U₁ U₂ V₁ V₂ : C}
  (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (g₁ : U₁ ⟶ V₁) (g₂ : U₂ ⟶ V₂) :
  ((f₁ ⊗ f₂) ⊗ (g₁ ⊗ g₂)) ≫ tensor_μ C (Y₁, Y₂) (V₁, V₂) =
    tensor_μ C (X₁, X₂) (U₁, U₂) ≫ ((f₁ ⊗ g₁) ⊗ (f₂ ⊗ g₂)) :=
begin
  dsimp [tensor_μ],
  slice_lhs 1 2 { rw [associator_naturality] },
  slice_lhs 2 3 { rw [←tensor_comp,
                      comp_id f₁, ←id_comp f₁,
                      associator_inv_naturality,
                      tensor_comp] },
  slice_lhs 3 4 { rw [←tensor_comp, ←tensor_comp,
                      comp_id f₁, ←id_comp f₁,
                      comp_id g₂, ←id_comp g₂,
                      braiding_naturality,
                      tensor_comp, tensor_comp] },
  slice_lhs 4 5 { rw [←tensor_comp,
                      comp_id f₁, ←id_comp f₁,
                      associator_naturality,
                      tensor_comp] },
  slice_lhs 5 6 { rw [associator_inv_naturality] },
  simp only [assoc],
end

lemma tensor_left_unitality (X₁ X₂ : C) :
    (λ_ (X₁ ⊗ X₂)).hom
  = ((λ_ (𝟙_ C)).inv ⊗ 𝟙 (X₁ ⊗ X₂)) ≫
    tensor_μ C (𝟙_ C, 𝟙_ C) (X₁, X₂) ≫
    ((λ_ X₁).hom ⊗ (λ_ X₂).hom) :=
begin
  dsimp [tensor_μ],
  have :
      ((λ_ (𝟙_ C)).inv ⊗ 𝟙 (X₁ ⊗ X₂)) ≫
      (α_ (𝟙_ C) (𝟙_ C) (X₁ ⊗ X₂)).hom ≫
      (𝟙 (𝟙_ C) ⊗ (α_ (𝟙_ C) X₁ X₂).inv)
    = 𝟙 (𝟙_ C) ⊗ ((λ_ X₁).inv ⊗ 𝟙 X₂) := by pure_coherence,
  slice_rhs 1 3 { rw this }, clear this,
  slice_rhs 1 2 { rw [←tensor_comp, ←tensor_comp,
                      comp_id, comp_id,
                      left_unitor_inv_braiding] },
  simp only [assoc],
  coherence,
end

lemma tensor_right_unitality (X₁ X₂ : C) :
    (ρ_ (X₁ ⊗ X₂)).hom
  = (𝟙 (X₁ ⊗ X₂) ⊗ (λ_ (𝟙_ C)).inv) ≫
    tensor_μ C (X₁, X₂) (𝟙_ C, 𝟙_ C) ≫
    ((ρ_ X₁).hom ⊗ (ρ_ X₂).hom) :=
begin
  dsimp [tensor_μ],
  have :
      (𝟙 (X₁ ⊗ X₂) ⊗ (λ_ (𝟙_ C)).inv) ≫
      (α_ X₁ X₂ (𝟙_ C ⊗ 𝟙_ C)).hom ≫
      (𝟙 X₁ ⊗ (α_ X₂ (𝟙_ C) (𝟙_ C)).inv)
    = (α_ X₁ X₂ (𝟙_ C)).hom ≫
      (𝟙 X₁ ⊗ ((ρ_ X₂).inv ⊗ 𝟙 (𝟙_ C))) := by pure_coherence,
  slice_rhs 1 3 { rw this }, clear this,
  slice_rhs 2 3 { rw [←tensor_comp, ←tensor_comp,
                      comp_id, comp_id,
                      right_unitor_inv_braiding] },
  simp only [assoc],
  coherence,
end

/-
Diagram B6 from Proposition 1 of [Joyal and Street, *Braided monoidal categories*][Joyal_Street].
-/
lemma tensor_associativity_aux (W X Y Z : C) :
    ((β_ W X).hom ⊗ 𝟙 (Y ⊗ Z)) ≫
    (α_ X W (Y ⊗ Z)).hom ≫
    (𝟙 X ⊗ (α_ W Y Z).inv) ≫
    (𝟙 X ⊗ (β_ (W ⊗ Y) Z).hom) ≫
    (𝟙 X ⊗ (α_ Z W Y).inv)
  = (𝟙 (W ⊗ X) ⊗ (β_ Y Z).hom) ≫
    (α_ (W ⊗ X) Z Y).inv ≫
    ((α_ W X Z).hom ⊗ 𝟙 Y) ≫
    ((β_ W (X ⊗ Z)).hom ⊗ 𝟙 Y) ≫
    ((α_ X Z W).hom ⊗ 𝟙 Y) ≫
    (α_ X (Z ⊗ W) Y).hom :=
begin
  slice_rhs 3 5 { rw [←tensor_comp, ←tensor_comp,
                      hexagon_forward,
                      tensor_comp, tensor_comp] },
  slice_rhs 5 6 { rw [associator_naturality] },
  slice_rhs 2 3 { rw [←associator_inv_naturality] },
  slice_rhs 3 5 { rw [←pentagon_hom_inv] },
  slice_rhs 1 2 { rw [tensor_id,
                      id_tensor_comp_tensor_id,
                      ←tensor_id_comp_id_tensor] },
  slice_rhs 2 3 { rw [← tensor_id, associator_naturality] },
  slice_rhs 3 5 { rw [←tensor_comp, ←tensor_comp,
                      ←hexagon_reverse,
                      tensor_comp, tensor_comp] },
end

lemma tensor_associativity (X₁ X₂ Y₁ Y₂ Z₁ Z₂ : C) :
    (tensor_μ C (X₁, X₂) (Y₁, Y₂) ⊗ 𝟙 (Z₁ ⊗ Z₂)) ≫
    tensor_μ C (X₁ ⊗ Y₁, X₂ ⊗ Y₂) (Z₁, Z₂) ≫
    ((α_ X₁ Y₁ Z₁).hom ⊗ (α_ X₂ Y₂ Z₂).hom)
  = (α_ (X₁ ⊗ X₂) (Y₁ ⊗ Y₂) (Z₁ ⊗ Z₂)).hom ≫
    (𝟙 (X₁ ⊗ X₂) ⊗ tensor_μ C (Y₁, Y₂) (Z₁, Z₂)) ≫
    tensor_μ C (X₁, X₂) (Y₁ ⊗ Z₁, Y₂ ⊗ Z₂) :=
begin
  have :
      ((α_ X₁ Y₁ Z₁).hom ⊗ (α_ X₂ Y₂ Z₂).hom)
    = (α_ (X₁ ⊗ Y₁) Z₁ ((X₂ ⊗ Y₂) ⊗ Z₂)).hom ≫
      (𝟙 (X₁ ⊗ Y₁) ⊗ (α_ Z₁ (X₂ ⊗ Y₂) Z₂).inv) ≫
      (α_ X₁ Y₁ ((Z₁ ⊗ (X₂ ⊗ Y₂)) ⊗ Z₂)).hom ≫
      (𝟙 X₁ ⊗ (α_ Y₁ (Z₁ ⊗ (X₂ ⊗ Y₂)) Z₂).inv) ≫
      (α_ X₁ (Y₁ ⊗ (Z₁ ⊗ (X₂ ⊗ Y₂))) Z₂).inv ≫
      ((𝟙 X₁ ⊗ (𝟙 Y₁ ⊗ (α_ Z₁ X₂ Y₂).inv)) ⊗ 𝟙 Z₂) ≫
      ((𝟙 X₁ ⊗ (α_ Y₁ (Z₁ ⊗ X₂) Y₂).inv) ⊗ 𝟙 Z₂) ≫
      ((𝟙 X₁ ⊗ ((α_ Y₁ Z₁ X₂).inv ⊗ 𝟙 Y₂)) ⊗ 𝟙 Z₂) ≫
      (α_ X₁ (((Y₁ ⊗ Z₁) ⊗ X₂) ⊗ Y₂) Z₂).hom ≫
      (𝟙 X₁ ⊗ (α_ ((Y₁ ⊗ Z₁) ⊗ X₂) Y₂ Z₂).hom) ≫
      (𝟙 X₁ ⊗ (α_ (Y₁ ⊗ Z₁) X₂ (Y₂ ⊗ Z₂)).hom) ≫
      (α_ X₁ (Y₁ ⊗ Z₁) (X₂ ⊗ (Y₂ ⊗ Z₂))).inv := by pure_coherence,
  rw this, clear this,
  slice_lhs 2 4 { rw [tensor_μ_def₁] },
  slice_lhs 4 5 { rw [←tensor_id, associator_naturality] },
  slice_lhs 5 6 { rw [←tensor_comp,
                      associator_inv_naturality,
                      tensor_comp] },
  slice_lhs 6 7 { rw [associator_inv_naturality] },
  have :
      (α_ (X₁ ⊗ Y₁) (X₂ ⊗ Y₂) (Z₁ ⊗ Z₂)).hom ≫
      (𝟙 (X₁ ⊗ Y₁) ⊗ (α_ (X₂ ⊗ Y₂) Z₁ Z₂).inv) ≫
      (α_ X₁ Y₁ (((X₂ ⊗ Y₂) ⊗ Z₁) ⊗ Z₂)).hom ≫
      (𝟙 X₁ ⊗ (α_ Y₁ ((X₂ ⊗ Y₂) ⊗ Z₁) Z₂).inv) ≫
      (α_ X₁ (Y₁ ⊗ ((X₂ ⊗ Y₂) ⊗ Z₁)) Z₂).inv
    = ((α_ X₁ Y₁ (X₂ ⊗ Y₂)).hom ⊗ 𝟙 (Z₁ ⊗ Z₂)) ≫
      ((𝟙 X₁ ⊗ (α_ Y₁ X₂ Y₂).inv) ⊗ 𝟙 (Z₁ ⊗ Z₂)) ≫
      (α_ (X₁ ⊗ ((Y₁ ⊗ X₂) ⊗ Y₂)) Z₁ Z₂).inv ≫
      ((α_ X₁ ((Y₁ ⊗ X₂) ⊗ Y₂) Z₁).hom ⊗ 𝟙 Z₂) ≫
      ((𝟙 X₁ ⊗ (α_ (Y₁ ⊗ X₂) Y₂ Z₁).hom) ⊗ 𝟙 Z₂) ≫
      ((𝟙 X₁ ⊗ (α_ Y₁ X₂ (Y₂ ⊗ Z₁)).hom) ⊗ 𝟙 Z₂) ≫
      ((𝟙 X₁ ⊗ (𝟙 Y₁ ⊗ (α_ X₂ Y₂ Z₁).inv)) ⊗ 𝟙 Z₂) := by pure_coherence,
  slice_lhs 2 6 { rw this }, clear this,
  slice_lhs 1 3 { rw [←tensor_comp, ←tensor_comp,
                      tensor_μ_def₁,
                      tensor_comp, tensor_comp] },
  slice_lhs 3 4 { rw [←tensor_id,
                      associator_inv_naturality] },
  slice_lhs 4 5 { rw [←tensor_comp,
                      associator_naturality,
                      tensor_comp] },
  slice_lhs 5 6 { rw [←tensor_comp, ←tensor_comp,
                      associator_naturality,
                      tensor_comp, tensor_comp] },
  slice_lhs 6 10 { rw [←tensor_comp, ←tensor_comp, ←tensor_comp, ←tensor_comp,
                       ←tensor_comp, ←tensor_comp, ←tensor_comp, ←tensor_comp,
                       tensor_id,
                       tensor_associativity_aux,
                       ←tensor_id,
                       ←id_comp (𝟙 X₁ ≫ 𝟙 X₁ ≫ 𝟙 X₁ ≫ 𝟙 X₁ ≫ 𝟙 X₁),
                       ←id_comp (𝟙 Z₂ ≫ 𝟙 Z₂ ≫ 𝟙 Z₂ ≫ 𝟙 Z₂ ≫ 𝟙 Z₂),
                       tensor_comp, tensor_comp, tensor_comp, tensor_comp, tensor_comp,
                       tensor_comp, tensor_comp, tensor_comp, tensor_comp, tensor_comp] },
  slice_lhs 11 12 { rw [←tensor_comp, ←tensor_comp,
                        iso.hom_inv_id],
                    simp },
  simp only [assoc, id_comp],
  slice_lhs 10 11 { rw [←tensor_comp, ←tensor_comp, ←tensor_comp,
                        iso.hom_inv_id],
                    simp },
  simp only [assoc, id_comp],
  slice_lhs 9 10 { rw [associator_naturality] },
  slice_lhs 10 11 { rw [←tensor_comp,
                        associator_naturality,
                        tensor_comp] },
  slice_lhs 11 13 { rw [tensor_id, ←tensor_μ_def₂] },
  have :
      ((𝟙 X₁ ⊗ (α_ (X₂ ⊗ Y₁) Z₁ Y₂).inv) ⊗ 𝟙 Z₂) ≫
      ((𝟙 X₁ ⊗ (α_ X₂ Y₁ Z₁).hom ⊗ 𝟙 Y₂) ⊗ 𝟙 Z₂) ≫
      (α_ X₁ ((X₂ ⊗ Y₁ ⊗ Z₁) ⊗ Y₂) Z₂).hom ≫
      (𝟙 X₁ ⊗ (α_ (X₂ ⊗ Y₁ ⊗ Z₁) Y₂ Z₂).hom) ≫
      (𝟙 X₁ ⊗ (α_ X₂ (Y₁ ⊗ Z₁) (Y₂ ⊗ Z₂)).hom) ≫
      (α_ X₁ X₂ ((Y₁ ⊗ Z₁) ⊗ Y₂ ⊗ Z₂)).inv
    = (α_ X₁ ((X₂ ⊗ Y₁) ⊗ (Z₁ ⊗ Y₂)) Z₂).hom ≫
      (𝟙 X₁ ⊗ (α_ (X₂ ⊗ Y₁) (Z₁ ⊗ Y₂) Z₂).hom) ≫
      (𝟙 X₁ ⊗ (α_ X₂ Y₁ ((Z₁ ⊗ Y₂) ⊗ Z₂)).hom) ≫
      (α_ X₁ X₂ (Y₁ ⊗ ((Z₁ ⊗ Y₂) ⊗ Z₂))).inv ≫
      (𝟙 (X₁ ⊗ X₂) ⊗ (𝟙 Y₁ ⊗ (α_ Z₁ Y₂ Z₂).hom)) ≫
      (𝟙 (X₁ ⊗ X₂) ⊗ (α_ Y₁ Z₁ (Y₂ ⊗ Z₂)).inv) := by pure_coherence,
  slice_lhs 7 12 { rw this }, clear this,
  slice_lhs 6 7 { rw [associator_naturality] },
  slice_lhs 7 8 { rw [←tensor_comp,
                      associator_naturality,
                      tensor_comp] },
  slice_lhs 8 9 { rw [←tensor_comp,
                      associator_naturality,
                      tensor_comp] },
  slice_lhs 9 10 { rw [associator_inv_naturality] },
  slice_lhs 10 12 { rw [←tensor_comp, ←tensor_comp,
                        ←tensor_μ_def₂,
                        tensor_comp, tensor_comp] },
  dsimp,
  coherence,
end

/-- The tensor product functor from `C × C` to `C` as a monoidal functor. -/
@[simps]
def tensor_monoidal : monoidal_functor (C × C) C :=
{ ε := (λ_ (𝟙_ C)).inv,
  μ := λ X Y, tensor_μ C X Y,
  μ_natural' := λ X Y X' Y' f g, tensor_μ_natural C f.1 f.2 g.1 g.2,
  associativity' := λ X Y Z, tensor_associativity C X.1 X.2 Y.1 Y.2 Z.1 Z.2,
  left_unitality' := λ ⟨X₁, X₂⟩, tensor_left_unitality C X₁ X₂,
  right_unitality' := λ ⟨X₁, X₂⟩, tensor_right_unitality C X₁ X₂,
  μ_is_iso := by { dsimp [tensor_μ], apply_instance },
  .. tensor C }

lemma left_unitor_monoidal (X₁ X₂ : C) :
    (λ_ X₁).hom ⊗ (λ_ X₂).hom
  = tensor_μ C (𝟙_ C, X₁) (𝟙_ C, X₂) ≫
    ((λ_ (𝟙_ C)).hom ⊗ 𝟙 (X₁ ⊗ X₂)) ≫
    (λ_ (X₁ ⊗ X₂)).hom :=
begin
  dsimp [tensor_μ],
  have :
      (λ_ X₁).hom ⊗ (λ_ X₂).hom
    = (α_ (𝟙_ C) X₁ (𝟙_ C ⊗ X₂)).hom ≫
      (𝟙 (𝟙_ C) ⊗ (α_ X₁ (𝟙_ C) X₂).inv) ≫
      (λ_ ((X₁ ⊗ (𝟙_ C)) ⊗ X₂)).hom ≫
      ((ρ_ X₁).hom ⊗ (𝟙 X₂)) := by pure_coherence,
  rw this, clear this,
  rw ←braiding_left_unitor,
  slice_lhs 3 4 { rw [←id_comp (𝟙 X₂), tensor_comp] },
  slice_lhs 3 4 { rw [←left_unitor_naturality] },
  coherence,
end

lemma right_unitor_monoidal (X₁ X₂ : C) :
    (ρ_ X₁).hom ⊗ (ρ_ X₂).hom
  = tensor_μ C (X₁, 𝟙_ C) (X₂, 𝟙_ C) ≫
    (𝟙 (X₁ ⊗ X₂) ⊗ (λ_ (𝟙_ C)).hom) ≫
    (ρ_ (X₁ ⊗ X₂)).hom :=
begin
  dsimp [tensor_μ],
  have :
      (ρ_ X₁).hom ⊗ (ρ_ X₂).hom
    = (α_ X₁ (𝟙_ C) (X₂ ⊗ (𝟙_ C))).hom ≫
      (𝟙 X₁ ⊗ (α_ (𝟙_ C) X₂ (𝟙_ C)).inv) ≫
      (𝟙 X₁ ⊗ (ρ_ (𝟙_ C ⊗ X₂)).hom) ≫
      (𝟙 X₁ ⊗ (λ_ X₂).hom) := by pure_coherence,
  rw this, clear this,
  rw ←braiding_right_unitor,
  slice_lhs 3 4 { rw [←id_comp (𝟙 X₁), tensor_comp, id_comp] },
  slice_lhs 3 4 { rw [←tensor_comp,
                      ←right_unitor_naturality,
                      tensor_comp] },
  coherence,
end

lemma associator_monoidal (X₁ X₂ X₃ Y₁ Y₂ Y₃ : C) :
    tensor_μ C (X₁ ⊗ X₂, X₃) (Y₁ ⊗ Y₂, Y₃) ≫
    (tensor_μ C (X₁, X₂) (Y₁, Y₂) ⊗ 𝟙 (X₃ ⊗ Y₃)) ≫
    (α_ (X₁ ⊗ Y₁) (X₂ ⊗ Y₂) (X₃ ⊗ Y₃)).hom
  = ((α_ X₁ X₂ X₃).hom ⊗ (α_ Y₁ Y₂ Y₃).hom) ≫
    tensor_μ C (X₁, X₂ ⊗ X₃) (Y₁, Y₂ ⊗ Y₃) ≫
    (𝟙 (X₁ ⊗ Y₁) ⊗ tensor_μ C (X₂, X₃) (Y₂, Y₃)) :=
begin
  have :
      (α_ (X₁ ⊗ Y₁) (X₂ ⊗ Y₂) (X₃ ⊗ Y₃)).hom
    = ((α_ X₁ Y₁ (X₂ ⊗ Y₂)).hom ⊗ 𝟙 (X₃ ⊗ Y₃)) ≫
      ((𝟙 X₁ ⊗ (α_ Y₁ X₂ Y₂).inv) ⊗ 𝟙 (X₃ ⊗ Y₃)) ≫
      (α_ (X₁ ⊗ ((Y₁ ⊗ X₂) ⊗ Y₂)) X₃ Y₃).inv ≫
      ((α_ X₁ ((Y₁ ⊗ X₂) ⊗ Y₂) X₃).hom ⊗ 𝟙 Y₃) ≫
      ((𝟙 X₁ ⊗ (α_ (Y₁ ⊗ X₂) Y₂ X₃).hom) ⊗ 𝟙 Y₃) ≫
      (α_ X₁ ((Y₁ ⊗ X₂) ⊗ (Y₂ ⊗ X₃)) Y₃).hom ≫
      (𝟙 X₁ ⊗ (α_ (Y₁ ⊗ X₂) (Y₂ ⊗ X₃) Y₃).hom) ≫
      (𝟙 X₁ ⊗ (α_ Y₁ X₂ ((Y₂ ⊗ X₃) ⊗ Y₃)).hom) ≫
      (α_ X₁ Y₁ (X₂ ⊗ ((Y₂ ⊗ X₃) ⊗ Y₃))).inv ≫
      (𝟙 (X₁ ⊗ Y₁) ⊗ (𝟙 X₂ ⊗ (α_ Y₂ X₃ Y₃).hom)) ≫
      (𝟙 (X₁ ⊗ Y₁) ⊗ (α_ X₂ Y₂ (X₃ ⊗ Y₃)).inv) := by pure_coherence,
  rw this, clear this,
  slice_lhs 2 4 { rw [←tensor_comp, ←tensor_comp,
                      tensor_μ_def₁,
                      tensor_comp, tensor_comp] },
  slice_lhs 4 5 { rw [←tensor_id,
                      associator_inv_naturality] },
  slice_lhs 5 6 { rw [←tensor_comp,
                      associator_naturality,
                      tensor_comp] },
  slice_lhs 6 7 { rw [←tensor_comp, ←tensor_comp,
                      associator_naturality,
                      tensor_comp, tensor_comp] },
  have :
      ((α_ X₁ X₂ (Y₁ ⊗ Y₂)).hom ⊗ 𝟙 (X₃ ⊗ Y₃)) ≫
      ((𝟙 X₁ ⊗ (α_ X₂ Y₁ Y₂).inv) ⊗ 𝟙 (X₃ ⊗ Y₃)) ≫
      (α_ (X₁ ⊗ ((X₂ ⊗ Y₁) ⊗ Y₂)) X₃ Y₃).inv ≫
      ((α_ X₁ ((X₂ ⊗ Y₁) ⊗ Y₂) X₃).hom ⊗ 𝟙 Y₃) ≫
      ((𝟙 X₁ ⊗ (α_ (X₂ ⊗ Y₁) Y₂ X₃).hom) ⊗ 𝟙 Y₃)
    = (α_ (X₁ ⊗ X₂) (Y₁ ⊗ Y₂) (X₃ ⊗ Y₃)).hom ≫
      (𝟙 (X₁ ⊗ X₂) ⊗ (α_ (Y₁ ⊗ Y₂) X₃ Y₃).inv) ≫
      (α_ X₁ X₂ (((Y₁ ⊗ Y₂) ⊗ X₃) ⊗ Y₃)).hom ≫
      (𝟙 X₁ ⊗ (α_ X₂ ((Y₁ ⊗ Y₂) ⊗ X₃) Y₃).inv) ≫
      (α_ X₁ (X₂ ⊗ ((Y₁ ⊗ Y₂) ⊗ X₃)) Y₃).inv ≫
      ((𝟙 X₁ ⊗ (𝟙 X₂ ⊗ (α_ Y₁ Y₂ X₃).hom)) ⊗ 𝟙 Y₃) ≫
      ((𝟙 X₁ ⊗ (α_ X₂ Y₁ (Y₂ ⊗ X₃)).inv) ⊗ 𝟙 Y₃) := by pure_coherence,
  slice_lhs 2 6 { rw this }, clear this,
  slice_lhs 1 3 { rw tensor_μ_def₁ },
  slice_lhs 3 4 { rw [←tensor_id,
                      associator_naturality] },
  slice_lhs 4 5 { rw [←tensor_comp,
                      associator_inv_naturality,
                      tensor_comp] },
  slice_lhs 5 6 { rw associator_inv_naturality },
  slice_lhs 6 9 { rw [←tensor_comp, ←tensor_comp, ←tensor_comp,
                      ←tensor_comp, ←tensor_comp, ←tensor_comp,
                      tensor_id,
                      associator_monoidal_aux,
                      ←id_comp (𝟙 X₁ ≫ 𝟙 X₁ ≫ 𝟙 X₁ ≫ 𝟙 X₁),
                      ←id_comp (𝟙 X₁ ≫ 𝟙 X₁ ≫ 𝟙 X₁ ≫ 𝟙 X₁ ≫ 𝟙 X₁),
                      ←id_comp (𝟙 Y₃ ≫ 𝟙 Y₃ ≫ 𝟙 Y₃ ≫ 𝟙 Y₃),
                      ←id_comp (𝟙 Y₃ ≫ 𝟙 Y₃ ≫ 𝟙 Y₃ ≫ 𝟙 Y₃ ≫ 𝟙 Y₃),
                      tensor_comp, tensor_comp, tensor_comp, tensor_comp, tensor_comp,
                      tensor_comp, tensor_comp, tensor_comp, tensor_comp, tensor_comp] },
  slice_lhs 11 12 { rw associator_naturality },
  slice_lhs 12 13 { rw [←tensor_comp,
                        associator_naturality,
                        tensor_comp] },
  slice_lhs 13 14 { rw [←tensor_comp, ←tensor_id,
                        associator_naturality,
                        tensor_comp] },
  slice_lhs 14 15 { rw associator_inv_naturality },
  slice_lhs 15 17 { rw [tensor_id, ←tensor_comp, ←tensor_comp,
                        ←tensor_μ_def₂,
                        tensor_comp, tensor_comp] },
  have :
      ((𝟙 X₁ ⊗ ((α_ Y₁ X₂ X₃).inv ⊗ 𝟙 Y₂)) ⊗ 𝟙 Y₃) ≫
      ((𝟙 X₁ ⊗ (α_ (Y₁ ⊗ X₂) X₃ Y₂).hom) ⊗ 𝟙 Y₃) ≫
      (α_ X₁ ((Y₁ ⊗ X₂) ⊗ (X₃ ⊗ Y₂)) Y₃).hom ≫
      (𝟙 X₁ ⊗ (α_ (Y₁ ⊗ X₂) (X₃ ⊗ Y₂) Y₃).hom) ≫
      (𝟙 X₁ ⊗ (α_ Y₁ X₂ ((X₃ ⊗ Y₂) ⊗ Y₃)).hom) ≫
      (α_ X₁ Y₁ (X₂ ⊗ ((X₃ ⊗ Y₂) ⊗ Y₃))).inv ≫
      (𝟙 (X₁ ⊗ Y₁) ⊗ (𝟙 X₂ ⊗ (α_ X₃ Y₂ Y₃).hom)) ≫
      (𝟙 (X₁ ⊗ Y₁) ⊗ (α_ X₂ X₃ (Y₂ ⊗ Y₃)).inv)
    = (α_ X₁ ((Y₁ ⊗ (X₂ ⊗ X₃)) ⊗ Y₂) Y₃).hom ≫
      (𝟙 X₁ ⊗ (α_ (Y₁ ⊗ (X₂ ⊗ X₃)) Y₂ Y₃).hom) ≫
      (𝟙 X₁ ⊗ (α_ Y₁ (X₂ ⊗ X₃) (Y₂ ⊗ Y₃)).hom) ≫
      (α_ X₁ Y₁ ((X₂ ⊗ X₃) ⊗ (Y₂ ⊗ Y₃))).inv := by pure_coherence,
  slice_lhs 9 16 { rw this }, clear this,
  slice_lhs 8 9 { rw associator_naturality },
  slice_lhs 9 10 { rw [←tensor_comp,
                       associator_naturality,
                       tensor_comp] },
  slice_lhs 10 12 { rw [tensor_id,
                        ←tensor_μ_def₂] },
  dsimp,
  coherence,
end

end tensor

end category_theory


import algebra.category.Group.adjunctions
import category_theory.sites.adjunction
import category_theory.sites.left_exact
import algebra.category.Group.abelian
import algebra.category.Group.filtered_colimits

import for_mathlib.SheafOfTypes_sheafification
import for_mathlib.whisker_adjunction
import for_mathlib.abelian_sheaves.exact
import for_mathlib.abelian_sheaves.main
import for_mathlib.AddCommGroup

import condensed.basic

universe u

open category_theory category_theory.limits

noncomputable theory

@[simps obj map]
def CondensedSet_to_presheaf : CondensedSet ⥤ Profiniteᵒᵖ ⥤ Type* :=
Sheaf_to_presheaf _ _

@[simps obj_val map]
def presheaf_to_CondensedSet : (Profiniteᵒᵖ ⥤ Type*) ⥤ CondensedSet :=
presheaf_to_Sheaf _ _

def CondensedSet_presheaf_adjunction : presheaf_to_CondensedSet ⊣ CondensedSet_to_presheaf :=
sheafification_adjunction proetale_topology (Type (u+1))

@[simp]
lemma CondensedSet_presheaf_adjunction_hom_equiv_apply (X : Profiniteᵒᵖ ⥤ Type*)
  (Y : CondensedSet) (e : presheaf_to_CondensedSet.obj X ⟶ Y) :
  CondensedSet_presheaf_adjunction.hom_equiv _ _ e =
  proetale_topology.to_sheafify X ≫ e.val := rfl

@[simp]
lemma CondensedSet_presheaf_adjunction_hom_equiv_symm_apply (X : Profiniteᵒᵖ ⥤ Type*)
  (Y : CondensedSet) (e : X ⟶ CondensedSet_to_presheaf.obj Y) :
  ((CondensedSet_presheaf_adjunction.hom_equiv _ _).symm e).val =
  proetale_topology.sheafify_lift e Y.cond := rfl

@[simp]
lemma CondensedSet_presheaf_adjunction_unit_app (X : Profiniteᵒᵖ ⥤ Type*) :
  CondensedSet_presheaf_adjunction.unit.app X =
  proetale_topology.to_sheafify X := rfl

@[simp]
lemma CondensedSet_presheaf_adjunction_counit_app (Y : CondensedSet) :
  (CondensedSet_presheaf_adjunction.counit.app Y).val =
  proetale_topology.sheafify_lift (𝟙 _) Y.cond := rfl

@[simps obj_val map]
def Condensed_Ab_to_CondensedSet : Condensed Ab ⥤ CondensedSet :=
Sheaf_compose _ (forget _)

@[simps obj_val map]
def CondensedSet_to_Condensed_Ab : CondensedSet ⥤ Condensed Ab :=
Sheaf.compose_and_sheafify _ AddCommGroup.free

@[simps obj_val map]
def CondensedSet_to_Condensed_Ab' : CondensedSet ⥤ Condensed Ab :=
Sheaf.compose_and_sheafify _ AddCommGroup.free'

@[simps hom_app_val inv_app_val]
def CondensedSet_to_Condensed_Ab_iso :
  CondensedSet_to_Condensed_Ab ≅ CondensedSet_to_Condensed_Ab' :=
iso_whisker_left _ $ iso_whisker_right (functor.map_iso _ $ AddCommGroup.free_iso_free') _

@[simps unit_app counit_app]
def Condensed_Ab_CondensedSet_adjunction :
  CondensedSet_to_Condensed_Ab ⊣ Condensed_Ab_to_CondensedSet :=
Sheaf.adjunction _ AddCommGroup.adj

@[simps unit_app counit_app]
def Condensed_Ab_CondensedSet_adjunction' :
  CondensedSet_to_Condensed_Ab' ⊣ Condensed_Ab_to_CondensedSet :=
Sheaf.adjunction _ AddCommGroup.adj'

@[simp]
lemma Condensed_Ab_CondensedSet_adjunction_hom_equiv_apply (X : CondensedSet)
  (Y : Condensed Ab) (e : CondensedSet_to_Condensed_Ab.obj X ⟶ Y) :
  (Condensed_Ab_CondensedSet_adjunction.hom_equiv _ _ e).val =
  (AddCommGroup.adj.whisker_right _).hom_equiv _ _ (proetale_topology.to_sheafify _ ≫ e.val) := rfl

@[simp]
lemma Condensed_Ab_CondensedSet_adjunction_hom_equiv_symm_apply (X : CondensedSet)
  (Y : Condensed Ab) (e : X ⟶ Condensed_Ab_to_CondensedSet.obj Y) :
  ((Condensed_Ab_CondensedSet_adjunction.hom_equiv _ _).symm e).val =
  proetale_topology.sheafify_lift
    (((AddCommGroup.adj.whisker_right _).hom_equiv _ _).symm e.val) Y.2 := rfl

@[simp]
lemma Condensed_Ab_CondensedSet_adjunction'_hom_equiv_apply (X : CondensedSet)
  (Y : Condensed Ab) (e : CondensedSet_to_Condensed_Ab'.obj X ⟶ Y) :
  (Condensed_Ab_CondensedSet_adjunction'.hom_equiv _ _ e).val =
  (AddCommGroup.adj'.whisker_right _).hom_equiv _ _ (proetale_topology.to_sheafify _ ≫ e.val) := rfl

@[simp]
lemma Condensed_Ab_CondensedSet_adjunction'_hom_equiv_symm_apply (X : CondensedSet)
  (Y : Condensed Ab) (e : X ⟶ Condensed_Ab_to_CondensedSet.obj Y) :
  ((Condensed_Ab_CondensedSet_adjunction'.hom_equiv _ _).symm e).val =
  proetale_topology.sheafify_lift
    (((AddCommGroup.adj'.whisker_right _).hom_equiv _ _).symm e.val) Y.2 := rfl

def presheaf_to_Condensed_Ab :
  (Profinite.{u}ᵒᵖ ⥤ Ab.{u+1}) ⥤ Condensed.{u} Ab.{u+1} :=
presheaf_to_Sheaf _ _

def Condensed_Ab_to_presheaf :
  Condensed.{u} Ab.{u+1} ⥤ Profinite.{u}ᵒᵖ ⥤ Ab.{u+1} :=
Sheaf_to_presheaf _ _

def Condensed_Ab_presheaf_adjunction :
  presheaf_to_Condensed_Ab.{u} ⊣ Condensed_Ab_to_presheaf.{u} :=
sheafification_adjunction _ _

instance presheaf_to_Condensed_Ab_preserves_colimits :
  preserves_colimits presheaf_to_Condensed_Ab.{u} :=
Condensed_Ab_presheaf_adjunction.left_adjoint_preserves_colimits

set_option pp.universes true

instance : functor.additive presheaf_to_Condensed_Ab.{u} :=
by apply category_theory.Sheaf.presheaf_to_Sheaf_additive.{u+2 u u+1}

instance : functor.additive Condensed_Ab_to_presheaf := ⟨⟩

instance : preserves_colimits presheaf_to_Condensed_Ab :=
Condensed_Ab_presheaf_adjunction.left_adjoint_preserves_colimits

instance : preserves_finite_limits presheaf_to_Condensed_Ab :=
category_theory.presheaf_to_Sheaf.limits.preserves_finite_limits.{u+2 u u+1}


import PnP2023.Lec_01_25.Answer

namespace Waffle

theorem Answer.eq_of_le_le (a b  : Answer) :
  a ≤ b → b ≤ a → a = b := by  sorry


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

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

namespace Mathlib

/-!
# Monoidal natural transformations

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

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

namespace category_theory

/--
A monoidal natural transformation is a natural transformation between (lax) monoidal functors
additionally satisfying:
`F.μ X Y ≫ app (X ⊗ Y) = (app X ⊗ app Y) ≫ G.μ X Y`
-/
structure monoidal_nat_trans {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂}
    [category D] [monoidal_category D] (F : lax_monoidal_functor C D) (G : lax_monoidal_functor C D)
    extends nat_trans (lax_monoidal_functor.to_functor F) (lax_monoidal_functor.to_functor G) where
  unit' :
    autoParam (lax_monoidal_functor.ε F ≫ nat_trans.app _to_nat_trans 𝟙_ = lax_monoidal_functor.ε G)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  tensor' :
    autoParam
      (∀ (X Y : C),
        lax_monoidal_functor.μ F X Y ≫ nat_trans.app _to_nat_trans (X ⊗ Y) =
          (nat_trans.app _to_nat_trans X ⊗ nat_trans.app _to_nat_trans Y) ≫
            lax_monoidal_functor.μ G X Y)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

@[simp] theorem monoidal_nat_trans.tensor {C : Type u₁} [category C] [monoidal_category C]
    {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D}
    {G : lax_monoidal_functor C D} (c : monoidal_nat_trans F G) (X : C) (Y : C) :
    lax_monoidal_functor.μ F X Y ≫ nat_trans.app (monoidal_nat_trans.to_nat_trans c) (X ⊗ Y) =
        (nat_trans.app (monoidal_nat_trans.to_nat_trans c) X ⊗
            nat_trans.app (monoidal_nat_trans.to_nat_trans c) Y) ≫
          lax_monoidal_functor.μ G X Y :=
  sorry

@[simp] theorem monoidal_nat_trans.tensor_assoc {C : Type u₁} [category C] [monoidal_category C]
    {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D}
    {G : lax_monoidal_functor C D} (c : monoidal_nat_trans F G) (X : C) (Y : C) {X' : D}
    (f' : functor.obj (lax_monoidal_functor.to_functor G) (X ⊗ Y) ⟶ X') :
    lax_monoidal_functor.μ F X Y ≫ nat_trans.app (monoidal_nat_trans.to_nat_trans c) (X ⊗ Y) ≫ f' =
        (nat_trans.app (monoidal_nat_trans.to_nat_trans c) X ⊗
            nat_trans.app (monoidal_nat_trans.to_nat_trans c) Y) ≫
          lax_monoidal_functor.μ G X Y ≫ f' :=
  sorry

@[simp] theorem monoidal_nat_trans.unit {C : Type u₁} [category C] [monoidal_category C]
    {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D}
    {G : lax_monoidal_functor C D} (c : monoidal_nat_trans F G) :
    lax_monoidal_functor.ε F ≫ nat_trans.app (monoidal_nat_trans.to_nat_trans c) 𝟙_ =
        lax_monoidal_functor.ε G :=
  sorry

@[simp] theorem monoidal_nat_trans.unit_assoc {C : Type u₁} [category C] [monoidal_category C]
    {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D}
    {G : lax_monoidal_functor C D} (c : monoidal_nat_trans F G) {X' : D}
    (f' : functor.obj (lax_monoidal_functor.to_functor G) 𝟙_ ⟶ X') :
    lax_monoidal_functor.ε F ≫ nat_trans.app (monoidal_nat_trans.to_nat_trans c) 𝟙_ ≫ f' =
        lax_monoidal_functor.ε G ≫ f' :=
  sorry

namespace monoidal_nat_trans

/--
The identity monoidal natural transformation.
-/
def id {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D]
    [monoidal_category D] (F : lax_monoidal_functor C D) : monoidal_nat_trans F F :=
  mk (nat_trans.mk (nat_trans.app 𝟙))

protected instance inhabited {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂}
    [category D] [monoidal_category D] (F : lax_monoidal_functor C D) :
    Inhabited (monoidal_nat_trans F F) :=
  { default := id F }

/--
Vertical composition of monoidal natural transformations.
-/
def vcomp {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D]
    [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D}
    {H : lax_monoidal_functor C D} (α : monoidal_nat_trans F G) (β : monoidal_nat_trans G H) :
    monoidal_nat_trans F H :=
  mk (nat_trans.mk (nat_trans.app (nat_trans.vcomp (to_nat_trans α) (to_nat_trans β))))

protected instance category_lax_monoidal_functor {C : Type u₁} [category C] [monoidal_category C]
    {D : Type u₂} [category D] [monoidal_category D] : category (lax_monoidal_functor C D) :=
  category.mk

@[simp] theorem comp_to_nat_trans' {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂}
    [category D] [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D}
    {H : lax_monoidal_functor C D} {α : F ⟶ G} {β : G ⟶ H} :
    to_nat_trans (α ≫ β) = to_nat_trans α ≫ to_nat_trans β :=
  rfl

protected instance category_monoidal_functor {C : Type u₁} [category C] [monoidal_category C]
    {D : Type u₂} [category D] [monoidal_category D] : category (monoidal_functor C D) :=
  induced_category.category monoidal_functor.to_lax_monoidal_functor

@[simp] theorem comp_to_nat_trans'' {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂}
    [category D] [monoidal_category D] {F : monoidal_functor C D} {G : monoidal_functor C D}
    {H : monoidal_functor C D} {α : F ⟶ G} {β : G ⟶ H} :
    to_nat_trans (α ≫ β) = to_nat_trans α ≫ to_nat_trans β :=
  rfl

/--
Horizontal composition of monoidal natural transformations.
-/
@[simp] theorem hcomp_to_nat_trans {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂}
    [category D] [monoidal_category D] {E : Type u₃} [category E] [monoidal_category E]
    {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D} {H : lax_monoidal_functor D E}
    {K : lax_monoidal_functor D E} (α : monoidal_nat_trans F G) (β : monoidal_nat_trans H K) :
    to_nat_trans (hcomp α β) = to_nat_trans α ◫ to_nat_trans β :=
  Eq.refl (to_nat_trans (hcomp α β))

end monoidal_nat_trans

namespace monoidal_nat_iso

protected instance is_iso_of_is_iso_app {C : Type u₁} [category C] [monoidal_category C]
    {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D}
    {G : lax_monoidal_functor C D} (α : F ⟶ G)
    [(X : C) → is_iso (nat_trans.app (monoidal_nat_trans.to_nat_trans α) X)] : is_iso α :=
  is_iso.mk
    (monoidal_nat_trans.mk
      (nat_trans.mk fun (X : C) => inv (nat_trans.app (monoidal_nat_trans.to_nat_trans α) X)))

/--
Construct a monoidal natural isomorphism from object level isomorphisms,
and the monoidal naturality in the forward direction.
-/
def of_components {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D]
    [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D}
    (app :
      (X : C) →
        functor.obj (lax_monoidal_functor.to_functor F) X ≅
          functor.obj (lax_monoidal_functor.to_functor G) X)
    (naturality :
      ∀ {X Y : C} (f : X ⟶ Y),
        functor.map (lax_monoidal_functor.to_functor F) f ≫ iso.hom (app Y) =
          iso.hom (app X) ≫ functor.map (lax_monoidal_functor.to_functor G) f)
    (unit : lax_monoidal_functor.ε F ≫ iso.hom (app 𝟙_) = lax_monoidal_functor.ε G)
    (tensor :
      ∀ (X Y : C),
        lax_monoidal_functor.μ F X Y ≫ iso.hom (app (X ⊗ Y)) =
          (iso.hom (app X) ⊗ iso.hom (app Y)) ≫ lax_monoidal_functor.μ G X Y) :
    F ≅ G :=
  as_iso (monoidal_nat_trans.mk (nat_trans.mk fun (X : C) => iso.hom (app X)))

@[simp] theorem of_components.hom_app {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂}
    [category D] [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D}
    (app :
      (X : C) →
        functor.obj (lax_monoidal_functor.to_functor F) X ≅
          functor.obj (lax_monoidal_functor.to_functor G) X)
    (naturality :
      ∀ {X Y : C} (f : X ⟶ Y),
        functor.map (lax_monoidal_functor.to_functor F) f ≫ iso.hom (app Y) =
          iso.hom (app X) ≫ functor.map (lax_monoidal_functor.to_functor G) f)
    (unit : lax_monoidal_functor.ε F ≫ iso.hom (app 𝟙_) = lax_monoidal_functor.ε G)
    (tensor :
      ∀ (X Y : C),
        lax_monoidal_functor.μ F X Y ≫ iso.hom (app (X ⊗ Y)) =
          (iso.hom (app X) ⊗ iso.hom (app Y)) ≫ lax_monoidal_functor.μ G X Y)
    (X : C) :
    nat_trans.app
          (monoidal_nat_trans.to_nat_trans (iso.hom (of_components app naturality unit tensor))) X =
        iso.hom (app X) :=
  rfl

@[simp] theorem of_components.inv_app {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂}
    [category D] [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D}
    (app :
      (X : C) →
        functor.obj (lax_monoidal_functor.to_functor F) X ≅
          functor.obj (lax_monoidal_functor.to_functor G) X)
    (naturality :
      ∀ {X Y : C} (f : X ⟶ Y),
        functor.map (lax_monoidal_functor.to_functor F) f ≫ iso.hom (app Y) =
          iso.hom (app X) ≫ functor.map (lax_monoidal_functor.to_functor G) f)
    (unit : lax_monoidal_functor.ε F ≫ iso.hom (app 𝟙_) = lax_monoidal_functor.ε G)
    (tensor :
      ∀ (X Y : C),
        lax_monoidal_functor.μ F X Y ≫ iso.hom (app (X ⊗ Y)) =
          (iso.hom (app X) ⊗ iso.hom (app Y)) ≫ lax_monoidal_functor.μ G X Y)
    (X : C) :
    nat_trans.app
          (monoidal_nat_trans.to_nat_trans (iso.inv (of_components app naturality unit tensor))) X =
        iso.inv (app X) :=
  rfl

end Mathlib