/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.monoidal.types
import category_theory.monoidal.center
import tactic.apply_fun

/-!
# Enriched categories

We set up the basic theory of `V`-enriched categories,
for `V` an arbitrary monoidal category.

We do not assume here that `V` is a concrete category,
so there does not need to be a "honest" underlying category!

Use `X ⟶[V] Y` to obtain the `V` object of morphisms from `X` to `Y`.

This file contains the definitions of `V`-enriched categories and
`V`-functors.

We don't yet define the `V`-object of natural transformations
between a pair of `V`-functors (this requires limits in `V`),
but we do provide a presheaf isomorphic to the Yoneda embedding of this object.

We verify that when `V = Type v`, all these notion reduce to the usual ones.
-/

universes w v u₁ u₂ u₃

noncomputable theory

namespace category_theory

open opposite
open monoidal_category

variables (V : Type v) [category.{w} V] [monoidal_category V]

/--
A `V`-category is a category enriched in a monoidal category `V`.

Note that we do not assume that `V` is a concrete category,
so there may not be an "honest" underlying category at all!
-/
class enriched_category (C : Type u₁) :=
(hom : C → C → V)
(notation X ` ⟶[] ` Y:10 := hom X Y)
(id : Π X, 𝟙_ V ⟶ (X ⟶[] X))
(comp : Π X Y Z, (X ⟶[] Y) ⊗ (Y ⟶[] Z) ⟶ (X ⟶[] Z))
(id_comp : Π X Y, (λ_ (X ⟶[] Y)).inv ≫ (id X ⊗ 𝟙 _) ≫ comp X X Y = 𝟙 _ . obviously)
(comp_id : Π X Y, (ρ_ (X ⟶[] Y)).inv ≫ (𝟙 _ ⊗ id Y) ≫ comp X Y Y = 𝟙 _ . obviously)
(assoc :
  Π W X Y Z, (α_ _ _ _).inv ≫ (comp W X Y ⊗ 𝟙 _) ≫ comp W Y Z = (𝟙 _ ⊗ comp X Y Z) ≫ comp W X Z
  . obviously)

notation (name := enriched_category.hom) X ` ⟶[`V`] ` Y:10 := (enriched_category.hom X Y : V)

variables (V) {C : Type u₁} [enriched_category V C]

/--
The `𝟙_ V`-shaped generalized element giving the identity in a `V`-enriched category.
-/
def e_id (X : C) : 𝟙_ V ⟶ (X ⟶[V] X) := enriched_category.id X
/--
The composition `V`-morphism for a `V`-enriched category.
-/
def e_comp (X Y Z : C) : (X ⟶[V] Y) ⊗ (Y ⟶[V] Z) ⟶ (X ⟶[V] Z) := enriched_category.comp X Y Z

-- We don't just use `restate_axiom` here; that would leave `V` as an implicit argument.
@[simp, reassoc]
lemma e_id_comp (X Y : C) :
  (λ_ (X ⟶[V] Y)).inv ≫ (e_id V X ⊗ 𝟙 _) ≫ e_comp V X X Y = 𝟙 (X ⟶[V] Y) :=
enriched_category.id_comp X Y

@[simp, reassoc]
lemma e_comp_id (X Y : C) :
  (ρ_ (X ⟶[V] Y)).inv ≫ (𝟙 _ ⊗ e_id V Y) ≫ e_comp V X Y Y = 𝟙 (X ⟶[V] Y) :=
enriched_category.comp_id X Y

@[simp, reassoc]
lemma e_assoc (W X Y Z : C) :
  (α_ _ _ _).inv ≫ (e_comp V W X Y ⊗ 𝟙 _) ≫ e_comp V W Y Z =
    (𝟙 _ ⊗ e_comp V X Y Z) ≫ e_comp V W X Z :=
enriched_category.assoc W X Y Z

section
variables {V} {W : Type v} [category.{w} W] [monoidal_category W]

/--
A type synonym for `C`, which should come equipped with a `V`-enriched category structure.
In a moment we will equip this with the `W`-enriched category structure
obtained by applying the functor `F : lax_monoidal_functor V W` to each hom object.
-/
@[nolint has_nonempty_instance unused_arguments]
def transport_enrichment (F : lax_monoidal_functor V W) (C : Type u₁) := C

instance (F : lax_monoidal_functor V W) :
  enriched_category W (transport_enrichment F C) :=
{ hom := λ (X Y : C), F.obj (X ⟶[V] Y),
  id := λ (X : C), F.ε ≫ F.map (e_id V X),
  comp := λ (X Y Z : C), F.μ _ _ ≫ F.map (e_comp V X Y Z),
  id_comp := λ X Y, begin
    rw [comp_tensor_id, category.assoc,
      ←F.to_functor.map_id, F.μ_natural_assoc, F.to_functor.map_id, F.left_unitality_inv_assoc,
      ←F.to_functor.map_comp, ←F.to_functor.map_comp, e_id_comp, F.to_functor.map_id],
  end,
  comp_id := λ X Y, begin
    rw [id_tensor_comp, category.assoc,
      ←F.to_functor.map_id, F.μ_natural_assoc, F.to_functor.map_id, F.right_unitality_inv_assoc,
      ←F.to_functor.map_comp, ←F.to_functor.map_comp, e_comp_id, F.to_functor.map_id],
  end,
  assoc := λ P Q R S, begin
    rw [comp_tensor_id, category.assoc, ←F.to_functor.map_id, F.μ_natural_assoc,
      F.to_functor.map_id, ←F.associativity_inv_assoc, ←F.to_functor.map_comp,
      ←F.to_functor.map_comp, e_assoc, id_tensor_comp, category.assoc, ←F.to_functor.map_id,
      F.μ_natural_assoc, F.to_functor.map_comp],
  end, }

end

/--
Construct an honest category from a `Type v`-enriched category.
-/
def category_of_enriched_category_Type (C : Type u₁) [𝒞 : enriched_category (Type v) C] :
  category.{v} C :=
{ hom := 𝒞.hom,
  id := λ X, e_id (Type v) X punit.star,
  comp := λ X Y Z f g, e_comp (Type v) X Y Z ⟨f, g⟩,
  id_comp' := λ X Y f, congr_fun (e_id_comp (Type v) X Y) f,
  comp_id' := λ X Y f, congr_fun (e_comp_id (Type v) X Y) f,
  assoc' := λ W X Y Z f g h, (congr_fun (e_assoc (Type v) W X Y Z) ⟨f, g, h⟩ : _), }

/--
Construct a `Type v`-enriched category from an honest category.
-/
def enriched_category_Type_of_category (C : Type u₁) [𝒞 : category.{v} C] :
  enriched_category (Type v) C :=
{ hom := 𝒞.hom,
  id := λ X p, 𝟙 X,
  comp := λ X Y Z p, p.1 ≫ p.2,
  id_comp := λ X Y, by { ext, simp, },
  comp_id := λ X Y, by { ext, simp, },
  assoc := λ W X Y Z, by { ext ⟨f, g, h⟩, simp, }, }

/--
We verify that an enriched category in `Type u` is just the same thing as an honest category.
-/
def enriched_category_Type_equiv_category (C : Type u₁) :
  (enriched_category (Type v) C) ≃ category.{v} C :=
{ to_fun := λ 𝒞, by exactI category_of_enriched_category_Type C,
  inv_fun := λ 𝒞, by exactI enriched_category_Type_of_category C,
  left_inv := λ 𝒞, begin
    cases 𝒞,
    dsimp [enriched_category_Type_of_category],
    congr,
    { ext X ⟨⟩, refl, },
    { ext X Y Z ⟨f, g⟩, refl, }
  end,
  right_inv := λ 𝒞, by { rcases 𝒞 with @⟨@⟨⟨⟩⟩⟩, dsimp, congr, }, }.

section
variables {W : Type (v+1)} [category.{v} W] [monoidal_category W] [enriched_category W C]

/-- A type synonym for `C`, which should come equipped with a `V`-enriched category structure.
In a moment we will equip this with the (honest) category structure
so that `X ⟶ Y` is `(𝟙_ W) ⟶ (X ⟶[W] Y)`.

We obtain this category by
transporting the enrichment in `V` along the lax monoidal functor `coyoneda_tensor_unit`,
then using the equivalence of `Type`-enriched categories with honest categories.

This is sometimes called the "underlying" category of an enriched category,
although some care is needed as the functor `coyoneda_tensor_unit`,
which always exists, does not necessarily coincide with
"the forgetful functor" from `V` to `Type`, if such exists.
When `V` is any of `Type`, `Top`, `AddCommGroup`, or `Module R`,
`coyoneda_tensor_unit` is just the usual forgetful functor, however.
For `V = Algebra R`, the usual forgetful functor is coyoneda of `R[X]`, not of `R`.
(Perhaps we should have a typeclass for this situation: `concrete_monoidal`?)
-/
@[nolint has_nonempty_instance unused_arguments]
def forget_enrichment
  (W : Type (v+1)) [category.{v} W] [monoidal_category W] (C : Type u₁) [enriched_category W C] :=
C

variables (W)

/-- Typecheck an object of `C` as an object of `forget_enrichment W C`. -/
def forget_enrichment.of (X : C) : forget_enrichment W C := X

/-- Typecheck an object of `forget_enrichment W C` as an object of `C`. -/
def forget_enrichment.to (X : forget_enrichment W C) : C := X

@[simp] lemma forget_enrichment.to_of (X : C) :
  forget_enrichment.to W (forget_enrichment.of W X) = X := rfl
@[simp] lemma forget_enrichment.of_to (X : forget_enrichment W C) :
  forget_enrichment.of W (forget_enrichment.to W X) = X := rfl

instance category_forget_enrichment : category (forget_enrichment W C) :=
begin
  let I : enriched_category (Type v) (transport_enrichment (coyoneda_tensor_unit W) C) :=
    infer_instance,
  exact enriched_category_Type_equiv_category C I,
end

/--
We verify that the morphism types in `forget_enrichment W C` are `(𝟙_ W) ⟶ (X ⟶[W] Y)`.
-/
example (X Y : forget_enrichment W C) :
  (X ⟶ Y) = ((𝟙_ W) ⟶ (forget_enrichment.to W X ⟶[W] forget_enrichment.to W Y)) :=
rfl

/-- Typecheck a `(𝟙_ W)`-shaped `W`-morphism as a morphism in `forget_enrichment W C`. -/
def forget_enrichment.hom_of {X Y : C} (f : (𝟙_ W) ⟶ (X ⟶[W] Y)) :
  forget_enrichment.of W X ⟶ forget_enrichment.of W Y :=
f

/-- Typecheck a morphism in `forget_enrichment W C` as a `(𝟙_ W)`-shaped `W`-morphism. -/
def forget_enrichment.hom_to {X Y : forget_enrichment W C} (f : X ⟶ Y) :
  (𝟙_ W) ⟶ (forget_enrichment.to W X ⟶[W] forget_enrichment.to W Y) := f

@[simp] lemma forget_enrichment.hom_to_hom_of {X Y : C} (f : (𝟙_ W) ⟶ (X ⟶[W] Y)) :
  forget_enrichment.hom_to W (forget_enrichment.hom_of W f) = f := rfl
@[simp] lemma forget_enrichment.hom_of_hom_to {X Y : forget_enrichment W C} (f : X ⟶ Y) :
  forget_enrichment.hom_of W (forget_enrichment.hom_to W f) = f := rfl

/-- The identity in the "underlying" category of an enriched category. -/
@[simp] lemma forget_enrichment_id (X : forget_enrichment W C) :
  forget_enrichment.hom_to W (𝟙 X) = (e_id W (forget_enrichment.to W X : C)) :=
category.id_comp _

@[simp] lemma forget_enrichment_id' (X : C) :
  forget_enrichment.hom_of W (e_id W X) = (𝟙 (forget_enrichment.of W X : C)) :=
(forget_enrichment_id W (forget_enrichment.of W X)).symm

/-- Composition in the "underlying" category of an enriched category. -/
@[simp] lemma forget_enrichment_comp {X Y Z : forget_enrichment W C} (f : X ⟶ Y) (g : Y ⟶ Z) :
  forget_enrichment.hom_to W (f ≫ g) = (((λ_ (𝟙_ W)).inv ≫
    (forget_enrichment.hom_to W f ⊗ forget_enrichment.hom_to W g)) ≫ e_comp W _ _ _) :=
rfl

end

/--
A `V`-functor `F` between `V`-enriched categories
has a `V`-morphism from `X ⟶[V] Y` to `F.obj X ⟶[V] F.obj Y`,
satisfying the usual axioms.
-/
structure enriched_functor
  (C : Type u₁) [enriched_category V C] (D : Type u₂) [enriched_category V D] :=
(obj : C → D)
(map : Π X Y : C, (X ⟶[V] Y) ⟶ (obj X ⟶[V] obj Y))
(map_id' : ∀ X : C, e_id V X ≫ map X X = e_id V (obj X) . obviously)
(map_comp' : ∀ X Y Z : C,
  e_comp V X Y Z ≫ map X Z = (map X Y ⊗ map Y Z) ≫ e_comp V (obj X) (obj Y) (obj Z) . obviously)

restate_axiom enriched_functor.map_id'
restate_axiom enriched_functor.map_comp'
attribute [simp, reassoc] enriched_functor.map_id
attribute [simp, reassoc] enriched_functor.map_comp

/-- The identity enriched functor. -/
@[simps]
def enriched_functor.id (C : Type u₁) [enriched_category V C] : enriched_functor V C C :=
{ obj := λ X, X,
  map := λ X Y, 𝟙 _, }

instance : inhabited (enriched_functor V C C) := ⟨enriched_functor.id V C⟩

/-- Composition of enriched functors. -/
@[simps]
def enriched_functor.comp {C : Type u₁} {D : Type u₂} {E : Type u₃}
  [enriched_category V C] [enriched_category V D] [enriched_category V E]
  (F : enriched_functor V C D) (G : enriched_functor V D E) :
  enriched_functor V C E :=
{ obj := λ X, G.obj (F.obj X),
  map := λ X Y, F.map _ _ ≫ G.map _ _, }

section
variables {W : Type (v+1)} [category.{v} W] [monoidal_category W]

/--
An enriched functor induces an honest functor of the underlying categories,
by mapping the `(𝟙_ W)`-shaped morphisms.
-/
def enriched_functor.forget {C : Type u₁} {D : Type u₂}
  [enriched_category W C] [enriched_category W D]
  (F : enriched_functor W C D) : (forget_enrichment W C) ⥤ (forget_enrichment W D) :=
{ obj := λ X, forget_enrichment.of W (F.obj (forget_enrichment.to W X)),
  map := λ X Y f, forget_enrichment.hom_of W
    (forget_enrichment.hom_to W f ≫ F.map (forget_enrichment.to W X) (forget_enrichment.to W Y)),
  map_comp' := λ X Y Z f g, begin
    dsimp,
    apply_fun forget_enrichment.hom_to W,
    { simp only [iso.cancel_iso_inv_left, category.assoc, tensor_comp,
        forget_enrichment.hom_to_hom_of, enriched_functor.map_comp, forget_enrichment_comp],
      refl, },
    { intros f g w, apply_fun forget_enrichment.hom_of W at w, simpa using w, },
  end, }

end

section
variables {V}
variables {D : Type u₂} [enriched_category V D]

/-!
We now turn to natural transformations between `V`-functors.

The mostly commonly encountered definition of an enriched natural transformation
is a collection of morphisms
```
(𝟙_ W) ⟶ (F.obj X ⟶[V] G.obj X)
```
satisfying an appropriate analogue of the naturality square.
(c.f. https://ncatlab.org/nlab/show/enriched+natural+transformation)

This is the same thing as a natural transformation `F.forget ⟶ G.forget`.

We formalize this as `enriched_nat_trans F G`, which is a `Type`.

However, there's also something much nicer: with appropriate additional hypotheses,
there is a `V`-object `enriched_nat_trans_obj F G` which contains more information,
and from which one can recover `enriched_nat_trans F G ≃ (𝟙_ V) ⟶ enriched_nat_trans_obj F G`.

Using these as the hom-objects, we can build a `V`-enriched category
with objects the `V`-functors.

For `enriched_nat_trans_obj` to exist, it suffices to have `V` braided and complete.

Before assuming `V` is complete, we assume it is braided and
define a presheaf `enriched_nat_trans_yoneda F G`
which is isomorphic to the Yoneda embedding of `enriched_nat_trans_obj F G`
whether or not that object actually exists.

This presheaf has components `(enriched_nat_trans_yoneda F G).obj A`
what we call the `A`-graded enriched natural transformations,
which are collections of morphisms
```
A ⟶ (F.obj X ⟶[V] G.obj X)
```
satisfying a similar analogue of the naturality square,
this time incorporating a half-braiding on `A`.

(We actually define `enriched_nat_trans F G`
as the special case `A := 𝟙_ V` with the trivial half-braiding,
and when defining `enriched_nat_trans_yoneda F G` we use the half-braidings
coming from the ambient braiding on `V`.)
-/

/--
The type of `A`-graded natural transformations between `V`-functors `F` and `G`.
This is the type of morphisms in `V` from `A` to the `V`-object of natural transformations.
-/
@[ext, nolint has_nonempty_instance]
structure graded_nat_trans (A : center V) (F G : enriched_functor V C D) :=
(app : Π (X : C), A.1 ⟶ (F.obj X ⟶[V] G.obj X))
(naturality :
  ∀ (X Y : C), (A.2.β (X ⟶[V] Y)).hom ≫ (F.map X Y ⊗ app Y) ≫ e_comp V _ _ _ =
    (app X ⊗ G.map X Y) ≫ e_comp V _ _ _)

variables [braided_category V]
open braided_category

/--
A presheaf isomorphic to the Yoneda embedding of
the `V`-object of natural transformations from `F` to `G`.
-/
@[simps]
def enriched_nat_trans_yoneda (F G : enriched_functor V C D) : Vᵒᵖ ⥤ (Type (max u₁ w)) :=
{ obj := λ A, graded_nat_trans ((center.of_braided V).obj (unop A)) F G,
  map := λ A A' f σ,
  { app := λ X, f.unop ≫ σ.app X,
    naturality := λ X Y, begin
      have p := σ.naturality X Y,
      dsimp at p ⊢,
      rw [←id_tensor_comp_tensor_id (f.unop ≫ σ.app Y) _, id_tensor_comp, category.assoc,
        category.assoc, ←braiding_naturality_assoc, id_tensor_comp_tensor_id_assoc, p,
        ←tensor_comp_assoc,category.id_comp],
     end }, }

-- TODO assuming `[has_limits C]` construct the actual object of natural transformations
-- and show that the functor category is `V`-enriched.

end

section
local attribute [instance] category_of_enriched_category_Type

/--
We verify that an enriched functor between `Type v` enriched categories
is just the same thing as an honest functor.
-/
@[simps]
def enriched_functor_Type_equiv_functor
  {C : Type u₁} [𝒞 : enriched_category (Type v) C]
  {D : Type u₂} [𝒟 : enriched_category (Type v) D] :
  enriched_functor (Type v) C D ≃ (C ⥤ D) :=
{ to_fun := λ F,
  { obj := λ X, F.obj X,
    map := λ X Y f, F.map X Y f,
    map_id' := λ X, congr_fun (F.map_id X) punit.star,
    map_comp' := λ X Y Z f g, congr_fun (F.map_comp X Y Z) ⟨f, g⟩, },
  inv_fun := λ F,
  { obj := λ X, F.obj X,
    map := λ X Y f, F.map f,
    map_id' := λ X, by { ext ⟨⟩, exact F.map_id X, },
    map_comp' := λ X Y Z, by { ext ⟨f, g⟩, exact F.map_comp f g, }, },
  left_inv := λ F, by { cases F, simp, },
  right_inv := λ F, by { cases F, simp, }, }

/--
We verify that the presheaf representing natural transformations
between `Type v`-enriched functors is actually represented by
the usual type of natural transformations!
-/
def enriched_nat_trans_yoneda_Type_iso_yoneda_nat_trans
  {C : Type v} [enriched_category (Type v) C]
  {D : Type v} [enriched_category (Type v) D]
  (F G : enriched_functor (Type v) C D) :
  enriched_nat_trans_yoneda F G ≅
  yoneda.obj ((enriched_functor_Type_equiv_functor F) ⟶ (enriched_functor_Type_equiv_functor G)) :=
nat_iso.of_components (λ α,
  { hom := λ σ x,
    { app := λ X, σ.app X x,
      naturality' := λ X Y f, congr_fun (σ.naturality X Y) ⟨x, f⟩, },
    inv := λ σ,
    { app := λ X x, (σ x).app X,
      naturality := λ X Y, by { ext ⟨x, f⟩, exact ((σ x).naturality f), }, }})
  (by tidy)

end

end category_theory


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

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

namespace Mathlib

/-!
# 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.

-/

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.
-/
-- braiding natural iso:

class braided_category (C : Type u) [category C] [monoidal_category C]
where
  braiding : (X Y : C) → X ⊗ Y ≅ Y ⊗ X
  braiding_naturality' : autoParam
  (∀ {X X' Y Y' : C} (f : X ⟶ Y) (g : X' ⟶ Y'), (f ⊗ g) ≫ iso.hom (braiding Y Y') = iso.hom (braiding X X') ≫ (g ⊗ f))
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  hexagon_forward' : autoParam
  (∀ (X Y Z : C),
    iso.hom α_ ≫ iso.hom (braiding X (Y ⊗ Z)) ≫ iso.hom α_ =
      (iso.hom (braiding X Y) ⊗ 𝟙) ≫ iso.hom α_ ≫ (𝟙 ⊗ iso.hom (braiding X Z)))
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  hexagon_reverse' : autoParam
  (∀ (X Y Z : C),
    iso.inv α_ ≫ iso.hom (braiding (X ⊗ Y) Z) ≫ iso.inv α_ =
      (𝟙 ⊗ iso.hom (braiding Y Z)) ≫ iso.inv α_ ≫ (iso.hom (braiding X Z) ⊗ 𝟙))
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

-- hexagon identities:

@[simp] theorem braided_category.braiding_naturality {C : Type u} [category C] [monoidal_category C] [c : braided_category C] {X : C} {X' : C} {Y : C} {Y' : C} (f : X ⟶ Y) (g : X' ⟶ Y') : (f ⊗ g) ≫ iso.hom (braided_category.braiding Y Y') = iso.hom (braided_category.braiding X X') ≫ (g ⊗ f) := sorry

@[simp] theorem braided_category.braiding_naturality_assoc {C : Type u} [category C] [monoidal_category C] [c : braided_category C] {X : C} {X' : C} {Y : C} {Y' : C} (f : X ⟶ Y) (g : X' ⟶ Y') : ∀ {X'_1 : C} (f' : Y' ⊗ Y ⟶ X'_1),
  (f ⊗ g) ≫ iso.hom (braided_category.braiding Y Y') ≫ f' = iso.hom (braided_category.braiding X X') ≫ (g ⊗ f) ≫ f' := sorry

theorem braided_category.hexagon_forward {C : Type u} [category C] [monoidal_category C] [c : braided_category C] (X : C) (Y : C) (Z : C) : iso.hom α_ ≫ iso.hom (braided_category.braiding X (Y ⊗ Z)) ≫ iso.hom α_ =
  (iso.hom (braided_category.braiding X Y) ⊗ 𝟙) ≫ iso.hom α_ ≫ (𝟙 ⊗ iso.hom (braided_category.braiding X Z)) := sorry

theorem braided_category.hexagon_reverse {C : Type u} [category C] [monoidal_category C] [c : braided_category C] (X : C) (Y : C) (Z : C) : iso.inv α_ ≫ iso.hom (braided_category.braiding (X ⊗ Y) Z) ≫ iso.inv α_ =
  (𝟙 ⊗ iso.hom (braided_category.braiding Y Z)) ≫ iso.inv α_ ≫ (iso.hom (braided_category.braiding X Z) ⊗ 𝟙) := sorry

notation:1024 "β_" => Mathlib.category_theory.braided_category.braiding

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

theorem braiding_left_unitor_aux₁ (C : Type u₁) [category C] [monoidal_category C] [braided_category C] (X : C) : iso.hom α_ ≫ (𝟙 ⊗ iso.inv β_) ≫ iso.inv α_ ≫ (iso.hom λ_ ⊗ 𝟙) = (iso.hom λ_ ⊗ 𝟙) ≫ iso.inv β_ := sorry

theorem braiding_left_unitor_aux₂ (C : Type u₁) [category C] [monoidal_category C] [braided_category C] (X : C) : (iso.hom β_ ⊗ 𝟙) ≫ (iso.hom λ_ ⊗ 𝟙) = iso.hom ρ_ ⊗ 𝟙 := sorry

@[simp] theorem braiding_left_unitor (C : Type u₁) [category C] [monoidal_category C] [braided_category C] (X : C) : iso.hom β_ ≫ iso.hom λ_ = iso.hom ρ_ := sorry

theorem braiding_right_unitor_aux₁ (C : Type u₁) [category C] [monoidal_category C] [braided_category C] (X : C) : iso.inv α_ ≫ (iso.inv β_ ⊗ 𝟙) ≫ iso.hom α_ ≫ (𝟙 ⊗ iso.hom ρ_) = (𝟙 ⊗ iso.hom ρ_) ≫ iso.inv β_ := sorry

theorem braiding_right_unitor_aux₂ (C : Type u₁) [category C] [monoidal_category C] [braided_category C] (X : C) : (𝟙 ⊗ iso.hom β_) ≫ (𝟙 ⊗ iso.hom ρ_) = 𝟙 ⊗ iso.hom λ_ := sorry

@[simp] theorem braiding_right_unitor (C : Type u₁) [category C] [monoidal_category C] [braided_category C] (X : C) : iso.hom β_ ≫ iso.hom ρ_ = iso.hom λ_ := sorry

/--
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 C] [monoidal_category C]
extends braided_category C
where
  symmetry' : autoParam (C → C → iso.hom β_ ≫ iso.hom β_ = 𝟙)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

-- braiding symmetric:

@[simp] theorem symmetric_category.symmetry {C : Type u} [category C] [monoidal_category C] [c : symmetric_category C] (X : C) (Y : C) : iso.hom β_ ≫ iso.hom β_ = 𝟙 := sorry

@[simp] theorem symmetric_category.symmetry_assoc {C : Type u} [category C] [monoidal_category C] [c : symmetric_category C] (X : C) (Y : C) {X' : C} (f' : X ⊗ Y ⟶ X') : iso.hom β_ ≫ iso.hom β_ ≫ f' = f' := sorry

/--
A lax braided functor between braided monoidal categories is a lax monoidal functor
which preserves the braiding.
-/
structure lax_braided_functor (C : Type u₁) [category C] [monoidal_category C] [braided_category C] (D : Type u₂) [category D] [monoidal_category D] [braided_category D]
extends lax_monoidal_functor C D
where
  braided' : autoParam
  (∀ (X Y : C),
    lax_monoidal_functor.μ _to_lax_monoidal_functor X Y ≫
        functor.map (lax_monoidal_functor.to_functor _to_lax_monoidal_functor) (iso.hom β_) =
      iso.hom β_ ≫ lax_monoidal_functor.μ _to_lax_monoidal_functor Y X)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

theorem lax_braided_functor.braided {C : Type u₁} [category C] [monoidal_category C] [braided_category C] {D : Type u₂} [category D] [monoidal_category D] [braided_category D] (c : lax_braided_functor C D) (X : C) (Y : C) : lax_monoidal_functor.μ (lax_braided_functor.to_lax_monoidal_functor c) X Y ≫
    functor.map (lax_monoidal_functor.to_functor (lax_braided_functor.to_lax_monoidal_functor c)) (iso.hom β_) =
  iso.hom β_ ≫ lax_monoidal_functor.μ (lax_braided_functor.to_lax_monoidal_functor c) Y X := sorry

namespace lax_braided_functor

/-- The identity lax braided monoidal functor. -/
def id (C : Type u₁) [category C] [monoidal_category C] [braided_category C] : lax_braided_functor C C :=
  mk (monoidal_functor.to_lax_monoidal_functor (monoidal_functor.id C))

protected instance inhabited (C : Type u₁) [category C] [monoidal_category C] [braided_category C] : Inhabited (lax_braided_functor C C) :=
  { default := id C }

/-- The composition of lax braided monoidal functors. -/
def comp {C : Type u₁} [category C] [monoidal_category C] [braided_category C] {D : Type u₂} [category D] [monoidal_category D] [braided_category D] {E : Type u₃} [category E] [monoidal_category E] [braided_category E] (F : lax_braided_functor C D) (G : lax_braided_functor D E) : lax_braided_functor C E :=
  mk
    (lax_monoidal_functor.mk (lax_monoidal_functor.to_functor (to_lax_monoidal_functor F ⊗⋙ to_lax_monoidal_functor G))
      (lax_monoidal_functor.ε (to_lax_monoidal_functor F ⊗⋙ to_lax_monoidal_functor G))
      (lax_monoidal_functor.μ (to_lax_monoidal_functor F ⊗⋙ to_lax_monoidal_functor G)))

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

@[simp] theorem comp_to_nat_trans {C : Type u₁} [category C] [monoidal_category C] [braided_category C] {D : Type u₂} [category D] [monoidal_category D] [braided_category D] {F : lax_braided_functor C D} {G : lax_braided_functor C D} {H : lax_braided_functor C D} {α : F ⟶ G} {β : G ⟶ H} : monoidal_nat_trans.to_nat_trans (α ≫ β) = monoidal_nat_trans.to_nat_trans α ≫ monoidal_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.
-/
@[simp] theorem mk_iso_hom {C : Type u₁} [category C] [monoidal_category C] [braided_category C] {D : Type u₂} [category D] [monoidal_category D] [braided_category D] {F : lax_braided_functor C D} {G : lax_braided_functor C D} (i : to_lax_monoidal_functor F ≅ to_lax_monoidal_functor G) : iso.hom (mk_iso i) = iso.hom i :=
  Eq.refl (iso.hom (mk_iso i))

end lax_braided_functor

/--
A braided functor between braided monoidal categories is a monoidal functor
which preserves the braiding.
-/
-- Note this is stated different than for `lax_braided_functor`.

structure braided_functor (C : Type u₁) [category C] [monoidal_category C] [braided_category C] (D : Type u₂) [category D] [monoidal_category D] [braided_category D]
extends monoidal_functor C D
where
  braided' : autoParam
  (∀ (X Y : C),
    functor.map (lax_monoidal_functor.to_functor (monoidal_functor.to_lax_monoidal_functor _to_monoidal_functor))
        (iso.hom β_) =
      inv (lax_monoidal_functor.μ (monoidal_functor.to_lax_monoidal_functor _to_monoidal_functor) X Y) ≫
        iso.hom β_ ≫ lax_monoidal_functor.μ (monoidal_functor.to_lax_monoidal_functor _to_monoidal_functor) Y X)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

-- We move the `μ X Y` to the right hand side,

-- so that this makes a good `@[simp]` lemma.

@[simp] theorem braided_functor.braided {C : Type u₁} [category C] [monoidal_category C] [braided_category C] {D : Type u₂} [category D] [monoidal_category D] [braided_category D] (c : braided_functor C D) (X : C) (Y : C) : functor.map
    (lax_monoidal_functor.to_functor (monoidal_functor.to_lax_monoidal_functor (braided_functor.to_monoidal_functor c)))
    (iso.hom β_) =
  inv (lax_monoidal_functor.μ (monoidal_functor.to_lax_monoidal_functor (braided_functor.to_monoidal_functor c)) X Y) ≫
    iso.hom β_ ≫
      lax_monoidal_functor.μ (monoidal_functor.to_lax_monoidal_functor (braided_functor.to_monoidal_functor c)) Y X := sorry

namespace braided_functor

/-- Turn a braided functor into a lax braided functor. -/
def to_lax_braided_functor (C : Type u₁) [category C] [monoidal_category C] [braided_category C] (D : Type u₂) [category D] [monoidal_category D] [braided_category D] (F : braided_functor C D) : lax_braided_functor C D :=
  lax_braided_functor.mk (monoidal_functor.to_lax_monoidal_functor (to_monoidal_functor F))

/-- The identity braided monoidal functor. -/
@[simp] theorem id_to_monoidal_functor (C : Type u₁) [category C] [monoidal_category C] [braided_category C] : to_monoidal_functor (id C) = monoidal_functor.id C :=
  Eq.refl (to_monoidal_functor (id C))

protected instance inhabited (C : Type u₁) [category C] [monoidal_category C] [braided_category C] : Inhabited (braided_functor C C) :=
  { default := id C }

/-- The composition of braided monoidal functors. -/
@[simp] theorem comp_to_monoidal_functor {C : Type u₁} [category C] [monoidal_category C] [braided_category C] {D : Type u₂} [category D] [monoidal_category D] [braided_category D] {E : Type u₃} [category E] [monoidal_category E] [braided_category E] (F : braided_functor C D) (G : braided_functor D E) : to_monoidal_functor (comp F G) = to_monoidal_functor F ⊗⋙ to_monoidal_functor G :=
  Eq.refl (to_monoidal_functor (comp F G))

protected instance category_braided_functor {C : Type u₁} [category C] [monoidal_category C] [braided_category C] {D : Type u₂} [category D] [monoidal_category D] [braided_category D] : category (braided_functor C D) :=
  induced_category.category to_monoidal_functor

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

/--
Interpret a natural isomorphism of the underlyling monoidal functors as an
isomorphism of the braided monoidal functors.
-/
def mk_iso {C : Type u₁} [category C] [monoidal_category C] [braided_category C] {D : Type u₂} [category D] [monoidal_category D] [braided_category D] {F : braided_functor C D} {G : braided_functor C D} (i : to_monoidal_functor F ≅ to_monoidal_functor G) : F ≅ G :=
  iso.mk (iso.hom i) (iso.inv i)

end braided_functor

protected instance comm_monoid_discrete (M : Type u) [comm_monoid M] : comm_monoid (discrete M) :=
  id _inst_10

protected instance discrete.braided_category (M : Type u) [comm_monoid M] : braided_category (discrete M) :=
  braided_category.mk fun (X Y : discrete M) => eq_to_iso sorry

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


import Lib.Tactic

theorem ite_pos [h : Decidable p] (hp : p) {x y : α} :
  ite p x y = x := by
cases h <;> auto

theorem ite_neg [h : Decidable p] (hp : ¬ p) {x y : α} :
  ite p x y = y := by
cases h <;> auto

@[simp]
theorem decide_eq_true_iff {h : Decidable p} :
  decide p = true ↔ p :=
⟨of_decide_eq_true, decide_eq_true⟩

@[simp]
theorem decide_eq_false_iff {h : Decidable p} :
  decide p = false ↔ ¬ p :=
⟨of_decide_eq_false, decide_eq_false⟩

theorem Eq.comm {x y : α} :
  x = y ↔ y = x := by
constructor
<;> intros h
<;> subst h
<;> rfl

theorem not_iff_not {p q : Prop} :
  (p ↔ q) → (¬ p ↔ ¬ q) :=
by intros h; rw [h]; refl


import logic.equiv.defs
import tactic.simp_result

open tactic

-- Check that we can walk.
example : true :=
by { simp_result { trivial } }

-- Comparison without `dsimp_result`:
example : true :=
begin
  exact (id trivial),
  (do `(id trivial) ← result, skip),
  success_if_fail { (do `(trivial) ← result, skip) },
end

-- Check that `dsimp_result` removes unnecessary `id`s.
example : true :=
begin
  dsimp_result { exact (id trivial) },
  success_if_fail { (do `(id trivial) ← result, skip) },
  (do `(trivial) ← result, skip),
end

-- Comparison without `dsimp_result`:
example (a : ℕ) (b : list ℕ) (h : b.length < a) : ℕ :=
begin
  revert a,
  intros a h,
  exact 0,
  (do `((λ (h : list.length _ < _), 0) _) ← result, skip),
  success_if_fail { (do `(0) ← result, skip) },
end

-- Check that `dsimp_result` does beta-reductions after `revert`.
example (a : ℕ) (b : list ℕ) (h : b.length < a) : ℕ :=
begin
  dsimp_result
  { revert a,
    intros a h,
    exact 0, },
  success_if_fail { (do `((λ (h : list.length _ < _), 0) _) ← result, skip), },
  (do `(0) ← result, skip),
end

-- This test tactic internally sets `pp.all ff`, and `pp.proofs tt`.
-- This isn't very robust, as the user setting any other `pp` options
-- will cause tests to break, but I don't think it needs to be.
meta def guard_result_pp (s : string) : tactic unit :=
do
  o ← get_options,
  set_options ((o.set_bool `pp.all ff).set_bool `pp.proofs tt),
  r ← (to_string <$> (result >>= pp)),
  guard (r = s) <|> fail format!"result was {r} but expected {s}"

-- Comparison without `simp_result`:
example {α β : Type} (e : α ≃ β) (a : α) : β :=
begin
  exact e (e.symm (e a)),
  guard_result_pp "⇑e (⇑(equiv.symm e) (⇑e a))",
end

-- Check that `simp_result` applies non-definitional simplifications to the result.
example {α β : Type} (e : α ≃ β) (a : α) : β :=
begin
  simp_result { exact e (e.symm (e a)) },
  guard_result_pp "⇑e a",
end

-- Check that `simp_result only [...]` behaves as expected.
example {α β : Type} (e : α ≃ β) (a : α) : β :=
begin
  simp_result only [equiv.apply_symm_apply] { exact e (e.symm (e a)) },
  guard_result_pp "⇑e a",
end

-- Check that `simp_result only []` does not simplify.
-- (Note the `simp_result` succeeds even if no simplification occurs.)
example {α β : Type} (e : α ≃ β) (a : α) : β :=
begin
  simp_result only [] { exact e (e.symm (e a)) },
  guard_result_pp "⇑e (⇑(equiv.symm e) (⇑e a))",
end

-- Comparison without `simp_result`
example {α : Type} (a b : α) (h : a = b) : ℕ :=
begin
  subst h,
  exact 0,
  guard_result_pp "eq.rec 0 h",
end

-- Check that we can remove `eq.rec` transports through constant families
-- introduced by irrelevant use of `subst`.
example {α : Type} (a b : α) (h : a = b) : ℕ :=
begin
  simp_result only [eq_rec_constant]
  { subst h,
    exact 0, },
  guard_result_pp "0",
end

-- Check that `simp_result` performs simplifications on all results.
example : ℕ × ℕ :=
begin
  split,
  simp_result
  { exact id 0,
    exact id 1, },
  guard_result_pp "(0, 1)",
end

-- Check that `simp_result` can cope with incomplete goals.
example {α β : Type} (e : α ≃ β) (a : α) : β :=
begin
  simp_result { apply e.to_fun, apply e.inv_fun, apply e.to_fun, },
  guard_result_pp "⇑e ?m_1",
  exact a,
end

-- Check that we can:
-- * cope with metavariables in the result
-- * perform beta redex after `revert`
-- * simplify `eq.rec` after `subst`
example {α β : Type} (e : α ≃ β) (S : has_mul α) : has_mul β :=
begin
  fconstructor,
  simp_result
  { have mul := S.mul,
    have e' := equiv.arrow_congr e (equiv.arrow_congr e e),
    have h : mul = e'.symm (e' mul) := by simp,
    revert h,
    generalize : e' mul = mul',
    intro h,
    subst h, },
  exact mul',
  guard_result_pp "{mul := ⇑(equiv.arrow_congr e (equiv.arrow_congr e e)) has_mul.mul}",
end


import algebra.homology.homological_complex
import category_theory.abelian.exact
import for_mathlib.homological_complex_shift
import for_mathlib.split_exact
import category_theory.triangulated.rotate
import algebra.homology.homotopy_category
import algebra.homology.additive
import for_mathlib.homological_complex_abelian
import for_mathlib.homotopy_category
import for_mathlib.triangle

noncomputable theory

universes v u

open_locale classical

open category_theory category_theory.limits

namespace homological_complex

variables {V : Type u} [category.{v} V] [abelian V]
variables (A B C : cochain_complex V ℤ) (f : A ⟶ B) (g : B ⟶ C)

@[simp, reassoc]
lemma homotopy.comp_X_eq_to_iso {X Y : cochain_complex V ℤ} {f g : X ⟶ Y} (h : homotopy f g)
  (i : ℤ) {j k : ℤ} (e : j = k) : h.hom i j ≫ (Y.X_eq_to_iso e).hom = h.hom i k :=
by { subst e, simp }

@[simp, reassoc]
lemma homotopy.X_eq_to_iso_comp {X Y : cochain_complex V ℤ} {f g : X ⟶ Y} (h : homotopy f g)
  {i j : ℤ} (e : i = j) (k : ℤ) : (X.X_eq_to_iso e).hom ≫ h.hom j k = h.hom i k :=
by { subst e, simp }

@[simp]
lemma X_eq_to_iso_shift (n i j : ℤ) (h : i = j) :
  X_eq_to_iso (A⟦n⟧) h = A.X_eq_to_iso (congr_arg _ h) := rfl

@[simp, reassoc]
lemma retraction_X_eq_to_hom (h : ∀ i, splitting (f.f i) (g.f i)) {i j : ℤ} (e : i = j) :
  (h i).retraction ≫ (A.X_eq_to_iso e).hom = (B.X_eq_to_iso e).hom ≫ (h j).retraction :=
by { subst e, simp,}

@[simp, reassoc]
lemma section_X_eq_to_hom (h : ∀ i, splitting (f.f i) (g.f i)) {i j : ℤ} (e : i = j) :
  (h i).section ≫ (B.X_eq_to_iso e).hom = (C.X_eq_to_iso e).hom ≫ (h j).section :=
by { subst e, simp }

def cone.X : ℤ → V := λ i, A.X (i + 1) ⊞ B.X i

variables {A B C}

def cone.d : Π (i j : ℤ), cone.X A B i ⟶ cone.X A B j :=
λ i j, if hij : i + 1 = j then biprod.lift
  (biprod.desc (-A.d _ _)                         0        )
  (biprod.desc (f.f _ ≫ (B.X_eq_to_iso hij).hom) (B.d _ _))
else 0

/-- The mapping cone of a morphism `f : A → B` of homological complexes. -/
def cone : cochain_complex V ℤ :=
{ X := cone.X A B,
  d := cone.d f,
  shape' := λ i j hij, dif_neg hij,
  d_comp_d' := λ i j k (hij : _ = _) (hjk : _ = _),
  begin
    substs hij hjk,
    apply biprod.hom_ext; ext; simp [cone.d],
  end }

@[simp]
lemma cone_X (i : ℤ) : (cone f).X i = (A.X (i + 1) ⊞ B.X i) := rfl

@[simp]
lemma cone_d : (cone f).d = cone.d f := rfl

def cone.in : B ⟶ cone f :=
{ f := λ i, biprod.inr,
  comm' := λ i j hij,
  begin
    dsimp [cone_d, cone.d], dsimp at hij, rw [dif_pos hij],
    ext;
    simp only [comp_zero, category.assoc, category.comp_id,
      biprod.inr_desc, biprod.inr_fst, biprod.lift_fst, biprod.inr_snd, biprod.lift_snd],
  end }

local attribute [instance] endofunctor_monoidal_category discrete.add_monoidal

def cone.out : cone f ⟶ A⟦(1 : ℤ)⟧ :=
{ f := λ i, biprod.fst,
  comm' := λ i j (hij : _ = _),
  begin
    subst hij,
    dsimp [cone_d, cone.d],
    ext; simp,
  end }

@[simps]
def cone.triangle : triangulated.triangle (cochain_complex V ℤ) :=
{ obj₁ := A,
  obj₂ := B,
  obj₃ := cone f,
  mor₁ := f,
  mor₂ := cone.in f,
  mor₃ := cone.out f }

variable (V)

@[simps]
def _root_.homotopy_category.lift_triangle :
  triangulated.triangle (cochain_complex V ℤ) ⥤
    triangulated.triangle (homotopy_category V (complex_shape.up ℤ)) :=
{ obj := λ t, triangulated.triangle.mk _
    ((homotopy_category.quotient _ _).map t.mor₁)
    ((homotopy_category.quotient _ _).map t.mor₂)
    ((homotopy_category.quotient _ _).map t.mor₃),
  map := λ t t' f,
  { hom₁ := (homotopy_category.quotient _ _).map f.hom₁,
    hom₂ := (homotopy_category.quotient _ _).map f.hom₂,
    hom₃ := (homotopy_category.quotient _ _).map f.hom₃,
    comm₁' := by { dsimp, rw [← functor.map_comp, ← functor.map_comp, f.comm₁] },
    comm₂' := by { dsimp, rw [← functor.map_comp, ← functor.map_comp, f.comm₂] },
    comm₃' := by { dsimp, rw [← functor.map_comp, ← functor.map_comp, f.comm₃] } },
  map_id' := λ X, by { ext; exact category_theory.functor.map_id _ _  },
  map_comp' := λ X Y Z f g, by { ext; exact category_theory.functor.map_comp _ _ _ } }

variable {V}

@[simps]
def cone.triangleₕ : triangulated.triangle (homotopy_category V (complex_shape.up ℤ)) :=
(homotopy_category.lift_triangle _).obj (cone.triangle f)

section cone_functorial

variables {f} {A' B' : cochain_complex V ℤ} {f' : A' ⟶ B'} {i₁ : A ⟶ A'} {i₂ : B ⟶ B'}
variables (comm : homotopy (f ≫ i₂) (i₁ ≫ f'))

include comm

def cone.map : cone f ⟶ cone f' :=
{ f := λ i, biprod.lift
  (biprod.desc (i₁.f _) 0)
  (biprod.desc (comm.hom _ _) (i₂.f _)),
  comm' := λ i j r,
  begin
    change i+1 = j at r,
    dsimp [cone_d, cone.d],
    simp_rw dif_pos r,
    apply category_theory.limits.biprod.hom_ext;
      simp only [biprod.lift_desc, add_zero, preadditive.comp_neg, category.assoc,
        comp_zero, biprod.lift_fst, biprod.lift_snd]; ext,
    { simp only [preadditive.comp_neg, biprod.inl_desc_assoc, hom.comm, preadditive.neg_comp] },
    { simp only [preadditive.comp_neg, biprod.inr_desc_assoc, zero_comp, neg_zero] },
    { simp only [X_eq_to_iso_f, preadditive.comp_add, biprod.inl_desc_assoc, category.assoc,
        preadditive.neg_comp],
      have := comm.comm (i+1),
      dsimp at this,
      rw [reassoc_of this],
      subst r,
      delta d_from from_next to_prev d_to,
      simp only [X_eq_to_iso_refl, category.comp_id, add_monoid_hom.mk'_apply],
      have aux₁ : (complex_shape.up ℤ).next (i + 1) = i + 1 + 1,
      { simp only [cochain_complex.next] },
      have aux₂ : i = (complex_shape.up ℤ).prev (i + 1),
      { simp only [cochain_complex.prev, add_tsub_cancel_right], },
      rw ← aux₁,
      simp only [←add_assoc, add_left_neg, zero_add, add_comm (i₁.f (i + 1) ≫ f'.f (i + 1)), add_left_inj],
      congr' 2, },
    { simp only [preadditive.comp_add, biprod.inr_desc_assoc, zero_comp, hom.comm] }
  end }

@[simp, reassoc]
lemma cone.in_map : cone.in f ≫ cone.map comm = i₂ ≫ cone.in f' :=
by ext; { dsimp [cone.map, cone.in], simp }

@[simp, reassoc]
lemma cone.map_out : cone.map comm ≫ cone.out f' = cone.out f ≫ i₁⟦(1 : ℤ)⟧' :=
by ext; { dsimp [cone.map, cone.out], simp }

omit comm

-- I suppose this is not true?
-- def cone.map_homotopy_of_homotopy' (comm' : homotopy (f ≫ i₂) (i₁ ≫ f')) :
--   homotopy (cone.map comm) (cone.map comm') := by admit

@[simps]
def cone.triangleₕ_map : cone.triangleₕ f ⟶ cone.triangleₕ f' :=
{ hom₁ := (homotopy_category.quotient _ _).map i₁,
  hom₂ := (homotopy_category.quotient _ _).map i₂,
  hom₃ := (homotopy_category.quotient _ _).map $ cone.map comm,
  comm₁' := by { dsimp [cone.triangleₕ], simp_rw ← functor.map_comp,
    exact homotopy_category.eq_of_homotopy _ _ comm },
  comm₂' := by { dsimp [cone.triangleₕ], simp_rw ← functor.map_comp, simp },
  comm₃' := by { dsimp [cone.triangleₕ], simp_rw ← functor.map_comp, simp } }

@[simps]
def cone.triangle_map (h : f ≫ i₂ = i₁ ≫ f') : cone.triangle f ⟶ cone.triangle f' :=
{ hom₁ := i₁,
  hom₂ := i₂,
  hom₃ := cone.map (homotopy.of_eq h),
  comm₁' := by simpa [cone.triangle],
  comm₂' := by { dsimp [cone.triangle], simp },
  comm₃' := by { dsimp [cone.triangle], simp } }

@[simp]
lemma cone.map_id (f : A ⟶ B) :
  cone.map (homotopy.of_eq $ (category.comp_id f).trans (category.id_comp f).symm) = 𝟙 _ :=
by { ext; dsimp [cone.map, cone, cone.X]; simp }

@[simp]
lemma cone.triangle_map_id (f : A ⟶ B) :
  cone.triangle_map ((category.comp_id f).trans (category.id_comp f).symm) = 𝟙 _ :=
by { ext; dsimp [cone.map, cone, cone.X]; simp }

def cone.triangle_functorial :
  arrow (cochain_complex V ℤ) ⥤ triangulated.triangle (cochain_complex V ℤ) :=
{ obj := λ f, cone.triangle f.hom,
  map := λ f g c, cone.triangle_map c.w.symm,
  map_id' := λ X, cone.triangle_map_id _,
  map_comp' := λ X Y Z f g, by { ext; dsimp [cone.map, cone, cone.X]; simp } }

-- I suppose this is also not true?
-- def cone.triangleₕ_functorial :
--   arrow (homotopy_category V (complex_shape.up ℤ)) ⥤
--     triangulated.triangle (homotopy_category V (complex_shape.up ℤ)) :=
-- { obj := λ f, cone.triangleₕ f.hom.out,
--   map := λ f g c, @cone.triangleₕ_map _ _ _ _ _ _ _ _ _ c.left.out c.right.out
--   begin
--     refine homotopy_category.homotopy_of_eq _ _ _,
--     simpa [-arrow.w] using c.w.symm
--   end,
--   map_id' := by admit,
--   map_comp' := by admit }

open_locale zero_object

lemma homological_complex.zero_X {ι : Type*} {c : complex_shape ι}
  {C : homological_complex V c} (hC : is_zero C) (i : ι) :
  is_zero (C.X i) :=
begin
  rw [is_zero_iff_id_eq_zero, ← homological_complex.eval_obj,
    ← (homological_complex.eval V c i).map_id, hC.eq_of_src (𝟙 C) 0],
  refl
end

def cone_from_zero (A : cochain_complex V ℤ) : cone (0 : 0 ⟶ A) ≅ A :=
{ hom :=
  { f := λ i, biprod.snd, comm' := begin
      introv r, ext; dsimp [cone.d] at *;
      simp only [if_pos r, zero_comp, dite_eq_ite, biprod.lift_snd,
        biprod.inl_desc, biprod.inr_desc, biprod.inl_snd_assoc, biprod.inr_snd_assoc],
    end },
  inv := cone.in _,
  inv_hom_id' := by { intros, ext, dsimp [cone.in], simp only [biprod.inr_snd] },
  hom_inv_id' := begin
    ext; dsimp [cone.in];
    simp only [biprod.inl_snd_assoc, zero_comp, comp_f, id_f, category.assoc,
      category.comp_id, biprod.inl_fst, biprod.inl_snd, biprod.inr_fst, biprod.inr_snd,
      biprod.inr_snd_assoc],
    apply is_zero.eq_of_src,
    apply homological_complex.zero_X,
    apply limits.is_zero_zero,
  end }

def cone_to_zero (A : cochain_complex V ℤ) : cone (0 : A ⟶ 0) ≅ A⟦(1 : ℤ)⟧ :=
{ hom := cone.out _,
  inv :=
    { f := λ i, biprod.inl, comm' := begin
        introv r, ext; dsimp [cone.d] at *;
        simp only [if_pos r, zero_comp, comp_zero, dite_eq_ite, category.assoc, category.comp_id,
          biprod.lift_fst, biprod.lift_snd, biprod.inl_desc, neg_smul, one_zsmul,
          biprod.inl_fst, biprod.inl_snd],
    end },
  hom_inv_id' := begin
    ext; dsimp [cone.out];
    simp only [biprod.inl_snd_assoc, zero_comp, comp_f, id_f, category.assoc,
      category.comp_id, biprod.inl_fst, biprod.inl_snd, biprod.inr_fst, biprod.inr_snd,
      biprod.inl_fst_assoc, biprod.inr_fst_assoc],
    apply is_zero.eq_of_src,
    apply homological_complex.zero_X,
    apply limits.is_zero_zero,
  end,
  inv_hom_id' := by { intros, ext, dsimp [cone.out], simp } }

def cone.desc_of_null_homotopic (h : homotopy (f ≫ g) 0) : cone f ⟶ C :=
cone.map (h.trans (homotopy.of_eq (comp_zero.symm : 0 = 0 ≫ 0))) ≫ (cone_from_zero _).hom

def cone.lift_of_null_homotopic (h : homotopy (f ≫ g) 0) : A ⟶ cone g⟦(-1 : ℤ)⟧ :=
(shift_shift_neg A (1 : ℤ)).inv ≫ (shift_functor _ (-1 : ℤ)).map ((cone_to_zero _).inv ≫
  cone.map (h.trans (homotopy.of_eq (comp_zero.symm : 0 = 0 ≫ 0))).symm)

@[simps]
def of_termwise_split_mono (H : ∀ i, split_mono (f.f i)) : B ⟶ B' :=
{ f := λ i, i₂.f i - (H i).retraction ≫ comm.hom i (i-1) ≫ B'.d (i-1) i -
    B.d i (i+1) ≫ (H (i+1)).retraction ≫ comm.hom (i+1) i,
  comm' := λ i j (r : i + 1 = j), by { subst r, simp only [d_comp_d, sub_zero, category.assoc,
    comp_zero, preadditive.comp_sub, hom.comm, preadditive.sub_comp, zero_comp, sub_right_inj,
    d_comp_d_assoc], congr; ring } }

@[simp, reassoc]
lemma of_termwise_split_mono_commutes (H : ∀ i, split_mono (f.f i)) :
  f ≫ of_termwise_split_mono comm H = i₁ ≫ f' :=
begin
  ext i,
  dsimp,
  have : f.f i ≫ i₂.f i = A.d i (i + 1) ≫ comm.hom (i + 1) i + comm.hom i (i - 1) ≫
    B'.d (i - 1) i + i₁.f i ≫ f'.f i := begin
      rw [← homological_complex.comp_f, comm.comm i],
      simp only [d_next, prev_d, add_monoid_hom.mk'_apply, comp_f, add_left_inj],
      rw [← cochain_complex.next, ← cochain_complex.prev],
    end,
  simp only [hom.comm_assoc, preadditive.comp_sub, this],
  erw [split_mono.id_assoc, split_mono.id_assoc],
  simp [add_right_comm]
end

def of_termwise_split_mono_homotopy (H : ∀ i, split_mono (f.f i)) :
  homotopy i₂ (of_termwise_split_mono comm H)  :=
{ hom := λ i j, (H i).retraction ≫ comm.hom i j,
  zero' := λ _ _ r, by rw [comm.zero _ _ r, comp_zero],
  comm := λ i, begin
    simp only [d_next, prev_d, add_monoid_hom.mk'_apply, category.assoc, of_termwise_split_mono_f],
    rw [← cochain_complex.next, ← cochain_complex.prev], abel
  end }

@[simps]
def of_termwise_split_epi (H : ∀ i, split_epi (f'.f i)) : A ⟶ A' :=
{ f := λ i, i₁.f i + comm.hom i (i-1) ≫ (H (i-1)).section_ ≫ A'.d (i-1) i +
    A.d i (i+1) ≫ comm.hom (i+1) i ≫ (H i).section_,
  comm' := λ i j (r : i + 1 = j), by { subst r, simp only [add_zero, d_comp_d, preadditive.comp_add,
    category.assoc, comp_zero, add_right_inj, hom.comm, zero_comp, preadditive.add_comp,
    d_comp_d_assoc], congr; ring } }

@[simp, reassoc]
lemma of_termwise_split_epi_commutes (H : ∀ i, split_epi (f'.f i)) :
  of_termwise_split_epi comm H ≫ f' = f ≫ i₂ :=
begin
  ext i,
  dsimp,
  have : f.f i ≫ i₂.f i = A.d i (i + 1) ≫ comm.hom (i + 1) i + comm.hom i (i - 1) ≫
    B'.d (i - 1) i + i₁.f i ≫ f'.f i := begin
      rw [← homological_complex.comp_f, comm.comm i],
      simp only [d_next, prev_d, add_monoid_hom.mk'_apply, comp_f, add_left_inj],
      rw [← cochain_complex.next, ← cochain_complex.prev],
    end,
  simp only [this, category.assoc, preadditive.add_comp, ← f'.comm],
  erw [split_epi.id, split_epi.id_assoc],
  rw [add_comm, add_comm (i₁.f i ≫ f'.f i), ← add_assoc, category.comp_id]
end

def of_termwise_split_epi_homotopy (H : ∀ i, split_epi (f'.f i)) :
  homotopy (of_termwise_split_epi comm H) i₁ :=
{ hom := λ i j, comm.hom i j ≫ (H j).section_,
  zero' := λ _ _ r, by rw [comm.zero _ _ r, zero_comp],
  comm := λ i, begin
    simp only [d_next, prev_d, add_monoid_hom.mk'_apply, category.assoc, of_termwise_split_epi_f],
    rw [← cochain_complex.next, ← cochain_complex.prev], abel
  end }

end cone_functorial

section termwise_split_mono_lift

@[simps]
def termwise_split_mono_lift (f : A ⟶ B) : A ⟶ biproduct B (cone (𝟙 A)) :=
biproduct.lift f (cone.in _)

@[simps]
def termwise_split_mono_desc (f : A ⟶ B) : biproduct B (cone (𝟙 A)) ⟶ B :=
biproduct.fst

@[simps]
def termwise_split_mono_section (f : A ⟶ B) : B ⟶ biproduct B (cone (𝟙 A)) :=
biproduct.inl

@[simp, reassoc] lemma termwise_split_mono_section_desc (f : A ⟶ B) :
  termwise_split_mono_section f ≫ termwise_split_mono_desc f = 𝟙 _ :=
by { ext, simp }

lemma termwise_split_mono_desc_section_aux (i : ℤ) :
  𝟙 (B.X i ⊞ (A.X (i + 1) ⊞ A.X i)) = biprod.snd ≫ biprod.desc (𝟙 (A.X (i + 1))) (A.d i (i + 1)) ≫
    biprod.inl ≫ biprod.inr + biprod.snd ≫ biprod.snd ≫
    (X_eq_to_iso A (sub_add_cancel i 1).symm).hom ≫ biprod.inl ≫ biprod.lift
    (biprod.desc (-A.d (i - 1 + 1) (i + 1)) 0) (biprod.desc (X_eq_to_iso A (sub_add_cancel i 1)).hom
    (A.d (i - 1) i)) ≫ biprod.inr + biprod.fst ≫ biprod.inl :=
begin
  ext1; simp only [zero_comp, preadditive.comp_add, zero_add, add_zero, biprod.inr_fst_assoc,
    biprod.inl_fst_assoc, biprod.inl_snd_assoc, biprod.inr_snd_assoc, category.comp_id],
  ext1, { simp },
  ext1, { simp only [add_zero, preadditive.add_comp, comp_zero, biprod.inr_fst, category.assoc] },
  ext1; simp,
end

def termwise_split_mono_desc_section (f : A ⟶ B) :
  homotopy (𝟙 _) (termwise_split_mono_desc f ≫ termwise_split_mono_section f) :=
{ hom := λ i j, if h : i = j + 1 then
    biprod.snd ≫ biprod.snd ≫ (A.X_eq_to_iso h).hom ≫ biprod.inl ≫ biprod.inr else 0,
  zero' := λ i j r, dif_neg (ne.symm r),
  comm := λ i, begin
    dsimp,
    obtain ⟨i, rfl⟩ : ∃ j, j + 1 = i := ⟨i-1, sub_add_cancel _ _⟩,
    have aux₁ : (complex_shape.up ℤ).rel i (i + 1) := rfl,
    have aux₂ : (complex_shape.up ℤ).rel (i + 1) (i + 1 + 1) := rfl,
    rw termwise_split_mono_desc_section_aux (i+1),
    rw [← d_next_eq_d_from_from_next, ← prev_d_eq_to_prev_d_to,
      d_next_eq _ aux₂, prev_d_eq _ aux₁, dif_pos rfl, dif_pos rfl],
    simp only [sub_add_cancel, biproduct_d, cone_d, X_eq_to_iso_refl, category.id_comp,
      biprod.map_snd_assoc, category.assoc, biprod.inr_map, add_left_inj, cone.d],
    rw [dif_pos rfl, dif_pos rfl],
    simp only [id_f, category.comp_id, biprod.lift_snd_assoc, add_right_inj],
    ext;
    simp only [biprod.inl_snd_assoc, biprod.inr_snd_assoc, biprod.inr_fst,
      biprod.lift_fst, biprod.inl_desc, biprod.lift_snd,
      category.assoc, zero_comp, comp_zero, preadditive.comp_neg,
      X_eq_to_iso_d, X_eq_to_iso_trans, X_eq_to_iso_refl],
  end }

def termwise_split_mono_lift_split_mono (f : A ⟶ B) (i : ℤ) :
  split_mono ((termwise_split_mono_lift f).f i) :=
{ retraction := biprod.snd ≫ biprod.snd, id' := by simp [cone.in] }

instance (f : A ⟶ B) (i : ℤ) : mono ((termwise_split_mono_lift f).f i) :=
(termwise_split_mono_lift_split_mono f i).mono

-- generalize to epi
@[simp]
lemma termwise_split_mono_lift_desc (f : A ⟶ B) :
  termwise_split_mono_lift f ≫ termwise_split_mono_desc f = f :=
by { ext, simp }

/-- We will prove this is iso later -/
def from_termwise_split_mono_lift_triangleₕ :
  cone.triangleₕ (termwise_split_mono_lift f) ⟶ cone.triangleₕ f :=
cone.triangleₕ_map
  (homotopy.of_eq ((termwise_split_mono_lift_desc f).trans (category.id_comp f).symm))

@[simps]
def termwise_split_mono_factor_homotopy_equiv : homotopy_equiv (biproduct B (cone (𝟙 A))) B :=
{ hom := termwise_split_mono_desc f,
  inv := termwise_split_mono_section f,
  homotopy_hom_inv_id := (termwise_split_mono_desc_section f).symm,
  homotopy_inv_hom_id := homotopy.of_eq (termwise_split_mono_section_desc f) }

end termwise_split_mono_lift

section termwise_split_epi_lift

@[simps]
def termwise_split_epi_lift (f : A ⟶ B) : A ⟶ biproduct A (cone (𝟙 (B⟦(-1 : ℤ)⟧))) :=
biproduct.inl

@[simps]
def termwise_split_epi_desc (f : A ⟶ B) : biproduct A (cone (𝟙 (B⟦(-1 : ℤ)⟧))) ⟶ B :=
biproduct.desc f (cone.out _ ≫ (shift_neg_shift _ _).hom)

@[simps]
def termwise_split_epi_retraction (f : A ⟶ B) : biproduct A (cone (𝟙 (B⟦(-1 : ℤ)⟧))) ⟶ A :=
biproduct.fst

@[simp, reassoc] lemma termwise_split_epi_lift_retraction (f : A ⟶ B) :
  termwise_split_epi_lift f ≫ termwise_split_epi_retraction f = 𝟙 _ :=
by { ext, simp }

lemma termwise_split_epi_retraction_lift_aux (i : ℤ) :
  𝟙 (A.X i ⊞ (B.X (i + 1 - 1) ⊞ B.X (i - 1))) = biprod.snd ≫ biprod.desc (𝟙 _)
  (-B.d (i + -1) (i + 1 + -1)) ≫ 𝟙 _ ≫ biprod.inl ≫ biprod.inr + biprod.snd ≫ biprod.snd ≫
  ((B⟦(-1 : ℤ)⟧).X_eq_to_iso (sub_add_cancel _ _).symm).hom ≫ biprod.inl ≫ biprod.lift
  (biprod.desc (B.d (i - 1 + 1 + -1) (i + 1 + -1)) 0) (biprod.desc
  ((B⟦(-1 : ℤ)⟧).X_eq_to_iso $ sub_add_cancel _ _).hom (-B.d (i - 1 + -1) (i + -1))) ≫
  biprod.inr + biprod.fst ≫ biprod.inl :=
begin
  ext1; simp only [category.comp_id, add_zero, category.id_comp, preadditive.comp_add,
    biprod.inl_snd_assoc, zero_add, zero_comp, biprod.inl_fst_assoc, biprod.inr_fst_assoc,
    biprod.inr_snd_assoc],
  ext1, { simp },
  simp only [biprod.inr_desc_assoc, preadditive.neg_comp_assoc, X_eq_to_iso_shift,
    biprod.inr_snd_assoc, preadditive.comp_add, category.assoc, preadditive.neg_comp],
  ext1, { simp only [add_zero, preadditive.add_comp, comp_zero,
    preadditive.neg_comp, biprod.inr_fst, neg_zero, category.assoc] },
  ext; simp; refl
end

def termwise_split_epi_retraction_lift (f : A ⟶ B) :
  homotopy (𝟙 _) (termwise_split_epi_retraction f ≫ termwise_split_epi_lift f) :=
{ hom := λ i j, if h : i = j + 1 then
    biprod.snd ≫ biprod.snd ≫ ((B⟦(-1 : ℤ)⟧).X_eq_to_iso h).hom ≫ biprod.inl ≫ biprod.inr else 0,
  zero' := λ i j r, dif_neg (ne.symm r),
  comm := λ i, begin
    dsimp,
    obtain ⟨i, rfl⟩ : ∃ j, j + 1 = i := ⟨i-1, sub_add_cancel _ _⟩,
    have aux₁ : (complex_shape.up ℤ).rel i (i + 1) := rfl,
    have aux₂ : (complex_shape.up ℤ).rel (i + 1) (i + 1 + 1) := rfl,
    rw termwise_split_epi_retraction_lift_aux (i+1),
    rw [← d_next_eq_d_from_from_next, ← prev_d_eq_to_prev_d_to,
      d_next_eq _ aux₂, prev_d_eq _ aux₁, dif_pos rfl, dif_pos rfl],
    simp only [sub_add_cancel, biproduct_d, cone_d, X_eq_to_iso_refl, category.id_comp,
      biprod.map_snd_assoc, category.assoc, biprod.inr_map, add_left_inj, cone.d],
    rw [dif_pos rfl, dif_pos rfl],
    simp only [id_f, category.comp_id, biprod.lift_snd_assoc, add_right_inj],
    ext;
    simp only [preadditive.add_comp, category.assoc, biprod.inr_fst,
      preadditive.comp_add, biprod.inl_snd_assoc, biprod.inl_snd,
      biprod.inr_snd_assoc, biprod.inl_fst, category.comp_id, biprod.inl_desc,
      zero_comp, comp_zero, add_zero,
      biprod.inr_desc, X_eq_to_iso_shift, biprod.lift_fst,
      X_eq_to_iso_d, shift_d, int.neg_one_pow_neg_one, neg_smul, one_zsmul, neg_neg,
      biprod.lift_snd, X_eq_to_iso_trans, X_eq_to_iso_refl, zero_add],
    all_goals { refl }
  end }

def termwise_split_epi_desc_split_epi (f : A ⟶ B) (i : ℤ) :
  split_epi ((termwise_split_epi_desc f).f i) :=
{ section_ := (B.X_eq_to_iso $ eq_add_neg_of_add_eq rfl).hom ≫ biprod.inl ≫ biprod.inr,
  id' := by { dsimp, simp [cone.out] } }

instance (f : A ⟶ B) (i : ℤ) : epi ((termwise_split_epi_desc f).f i) :=
(termwise_split_epi_desc_split_epi f i).epi

end termwise_split_epi_lift

section termwise_split_exact

variables (f g)

@[simps]
def connecting_hom (h : ∀ (i : ℤ), splitting (f.f i) (g.f i)) : C ⟶ A⟦(1 : ℤ)⟧ :=
{ f := λ i, (h i).section ≫ B.d i (i + 1) ≫ (h (i + 1)).retraction,
  comm' :=
  begin
    intros i j r,
    induction r,
    dsimp,
    rw ← cancel_mono (𝟙 _),
    swap, apply_instance,
    conv_lhs { rw ← (h _).ι_retraction },
    simp only [preadditive.comp_neg, one_zsmul, category.assoc, neg_smul, preadditive.neg_comp,
      ← f.comm_assoc, (h _).retraction_ι_eq_id_sub_assoc, preadditive.sub_comp_assoc,
      preadditive.sub_comp, preadditive.comp_sub, category.id_comp, d_comp_d_assoc,
      zero_comp, comp_zero, ← g.comm_assoc, (h i).section_π_assoc],
    simp,
  end }

@[simps]
def triangle_of_termwise_split (h : ∀ (i : ℤ), splitting (f.f i) (g.f i)) :
  triangulated.triangle (cochain_complex V ℤ) :=
triangulated.triangle.mk _ f g (connecting_hom f g h)

@[simps]
def triangleₕ_of_termwise_split (h : ∀ (i : ℤ), splitting (f.f i) (g.f i)) :
  triangulated.triangle (homotopy_category V (complex_shape.up ℤ)) :=
(homotopy_category.lift_triangle V).obj (triangle_of_termwise_split f g h)

@[simps]
def homotopy_connecting_hom_of_splittings (h h' : ∀ (i : ℤ), splitting (f.f i) (g.f i)) :
  homotopy (connecting_hom f g h) (connecting_hom f g h') :=
{ hom := λ i j, if e : j + 1 = i then
    ((h' i).section ≫ (h i).retraction ≫ (A.X_eq_to_iso e).inv) else 0,
  comm := λ i, begin
    rw ← cancel_epi (g.f _),
    { dsimp,
      obtain ⟨i, rfl⟩ : ∃ j, j + 1 = i := ⟨i-1, sub_add_cancel _ _⟩,
      have aux₁ : (complex_shape.up ℤ).rel i (i + 1) := rfl,
      have aux₂ : (complex_shape.up ℤ).rel (i + 1) (i + 1 + 1) := rfl,
      rw [← d_next_eq_d_from_from_next, ← prev_d_eq_to_prev_d_to,
        d_next_eq _ aux₂, prev_d_eq _ aux₁, dif_pos rfl, dif_pos rfl],
      simp only [d_next, prev_d, splitting.π_section_eq_id_sub_assoc, -retraction_X_eq_to_hom,
        preadditive.sub_comp_assoc, category.id_comp, category.assoc, hom.comm,
        preadditive.sub_comp, splitting.ι_retraction, category.comp_id, X_eq_to_iso_refl, shift_d,
        int.neg_one_pow_one, neg_smul, one_zsmul, preadditive.comp_neg, preadditive.comp_add,
        hom.comm_assoc, preadditive.comp_sub, neg_sub, splitting.ι_retraction_assoc],
      abel, apply add_comm, },
    exact (h i).epi
  end,
  zero' := λ _ _ h, dif_neg h }

@[simps]
def triangleₕ_map_splittings_hom (h h' : ∀ (i : ℤ), splitting (f.f i) (g.f i)) :
  triangleₕ_of_termwise_split f g h ⟶ triangleₕ_of_termwise_split f g h' :=
{ hom₁ := 𝟙 _,
  hom₂ := 𝟙 _,
  hom₃ := 𝟙 _,
  comm₃' :=
  begin
    simp only [category.comp_id, triangleₕ_of_termwise_split_mor₃, category.id_comp,
      category_theory.functor.map_id],
    apply homotopy_category.eq_of_homotopy,
    exact homotopy_connecting_hom_of_splittings f g h h'
  end }

@[simps]
def triangleₕ_map_splittings_iso (h h' : ∀ (i : ℤ), splitting (f.f i) (g.f i)) :
  triangleₕ_of_termwise_split f g h ≅ triangleₕ_of_termwise_split f g h' :=
{ hom := triangleₕ_map_splittings_hom f g h h',
  inv := triangleₕ_map_splittings_hom f g h' h,
  hom_inv_id' := by { ext; exact category.comp_id _ },
  inv_hom_id' := by { ext; exact category.comp_id _ } }

end termwise_split_exact
section

variables {B'' B' : cochain_complex V ℤ} {b' : B'' ⟶ B} {b : B ⟶ B'}
variables (H₂ : ∀ i, splitting (f.f i) (g.f i))
variables (h₂ : homotopy (b' ≫ g) 0) (h₃ : homotopy (f ≫ b) 0)

include H₂ h₂ h₃

/--
If `A ⟶ B ⟶ C` is split exact, and `b' ≫ g` and `f ≫ b` are null-homotopic,
then so is `b' ≫ b`.

        B''
        ∣
        b'
        ↓
A - f → B - g → C
        ∣
        b
        ↓
        B'
-/
def comp_null_homotopic_of_row_split_exact : homotopy (b' ≫ b) 0 :=
begin
  have H1 := λ i, (H₂ i).split_epi,
  have H2 := λ i, (H₂ i).split_mono,
  have aux := λ i, (H₂ i).short_exact.3,
  let h₁' := (h₂.trans (homotopy.of_eq (comp_zero : 𝟙 _ ≫ 0 = 0).symm)).symm,
  let h₂' := (h₃.trans $ homotopy.of_eq (zero_comp : 0 ≫ 𝟙 _ = 0).symm),
  refine ((of_termwise_split_epi_homotopy h₁' H1).symm.comp
    (of_termwise_split_mono_homotopy h₂' H2)).trans (homotopy.of_eq _),
  apply hom.ext,
  apply funext,
  intro i,
  exact comp_eq_zero_of_exact (f.f i) (g.f i) (aux i)
    (congr_f ((of_termwise_split_epi_commutes h₁' H1).trans comp_zero) i)
    (congr_f ((of_termwise_split_mono_commutes h₂' H2).trans zero_comp) i)
end

end

def cone.termwise_split (i : ℤ) : splitting ((cone.in f).f i) ((cone.out f).f i) :=
{ iso := biprod.braiding _ _,
  comp_iso_eq_inl := by ext; simp [cone.in],
  iso_comp_snd_eq := by ext; simp [cone.out] }

@[simp] lemma cone.termwise_split_section (i : ℤ) :
  (cone.termwise_split f i).section = biprod.inl :=
by { delta splitting.section cone.termwise_split, ext; dsimp; simp }

@[simp] lemma cone.termwise_split_retraction (i : ℤ) :
  (cone.termwise_split f i).retraction = biprod.snd :=
by { delta splitting.retraction cone.termwise_split, dsimp, simp }

def cone_homotopy_equiv_aux (c : cone f ⟶ cone f) (h₁ : homotopy (cone.in f ≫ c) (cone.in f))
  (h₂ : homotopy (c ≫ cone.out f) (cone.out f)) : homotopy (𝟙 _) (2 • c - c ≫ c) :=
begin
  have : homotopy ((𝟙 _ - c) ≫ (𝟙 _ - c)) 0,
  { apply comp_null_homotopic_of_row_split_exact (cone.in f) (cone.out f) (cone.termwise_split f),
    { refine (homotopy.of_eq _).trans h₂.symm.equiv_sub_zero, simp },
    { refine (homotopy.of_eq _).trans h₁.symm.equiv_sub_zero, simp } },
  apply homotopy.equiv_sub_zero.symm _,
  refine (homotopy.of_eq _).trans this,
  simp [two_smul], abel,
end

local attribute [simp] preadditive.comp_nsmul preadditive.nsmul_comp

/--
If the following diagram commutes up to homotopy, then `c` is a homotopy equivalence
A - f → B ⟶ C(f) ⟶ A⟦1⟧
|       |      ∣       ∣
𝟙       𝟙      c       𝟙
↓       ↓      ∣       ∣
A - f → B ⟶ C(f) ⟶ A⟦1⟧
-/
def cone_homotopy_equiv (c : cone f ⟶ cone f) (h₁ : homotopy (cone.in f ≫ c) (cone.in f))
  (h₂ : homotopy (c ≫ cone.out f) (cone.out f)) : homotopy_equiv (cone f) (cone f) :=
{ hom := c,
  inv := ((2 • 𝟙 _) - c),
  homotopy_hom_inv_id := (homotopy.of_eq (by simp)).trans (cone_homotopy_equiv_aux f c h₁ h₂).symm,
  homotopy_inv_hom_id := (homotopy.of_eq (by simp)).trans (cone_homotopy_equiv_aux f c h₁ h₂).symm }

local notation `Q` := homotopy_category.quotient V (complex_shape.up ℤ)

lemma cone_triangleₕ_map_iso_of_id (φ : cone.triangleₕ f ⟶ cone.triangleₕ f)
  (h₁ : φ.hom₁ = 𝟙 _) (h₂ : φ.hom₂ = 𝟙 _) : is_iso φ.hom₃ :=
begin
  have e₂ := φ.comm₂,
  have e₃ := φ.comm₃,
  rw [h₂, category.id_comp] at e₂,
  rw [h₁, category_theory.functor.map_id, category.comp_id] at e₃,
  erw [← Q .image_preimage φ.hom₃, ← Q .map_comp] at e₂ e₃,
  convert is_iso.of_iso (homotopy_category.iso_of_homotopy_equiv
    (cone_homotopy_equiv _ _ (homotopy_category.homotopy_of_eq _ _ e₂)
    (homotopy_category.homotopy_of_eq _ _ e₃.symm))),
  exact (Q .image_preimage _).symm
end

open category_theory.triangulated

lemma cone.triangleₕ_is_iso {A' B' : cochain_complex V ℤ} {f : A ⟶ B} {f' : A' ⟶ B'}
  (φ : cone.triangleₕ f ⟶ cone.triangleₕ f') [is_iso φ.hom₁] [is_iso φ.hom₂] : is_iso φ :=
begin
  suffices : is_iso φ.hom₃,
  { exactI triangle_morphism_is_iso _ },
  have := φ.comm₁,
  dsimp at this,
  rw [← is_iso.eq_comp_inv, category.assoc, ← is_iso.inv_comp_eq,
    ← Q .image_preimage (inv φ.hom₁), ← Q .map_comp,
    ← Q .image_preimage (inv φ.hom₂), ← Q .map_comp] at this,
  let T := cone.triangleₕ_map (homotopy_category.homotopy_of_eq _ _ this).symm,
  haveI := cone_triangleₕ_map_iso_of_id _ (φ ≫ T) (by simp) (by simp),
  haveI := cone_triangleₕ_map_iso_of_id _ (T ≫ φ) (by simp) (by simp),
  haveI : epi φ.hom₃ := @@epi_of_epi _ (T.hom₃) (φ.hom₃) (show epi (T ≫ φ).hom₃, by apply_instance),
  use T.hom₃ ≫ inv (φ ≫ T).hom₃,
  split,
  { rw ← category.assoc, exact is_iso.hom_inv_id _ },
  { rw [← cancel_epi φ.hom₃, ← category.assoc, ← category.assoc, category.comp_id,
      category.assoc],
    exact is_iso.hom_inv_id_assoc (φ ≫ T).hom₃ _ }
end

instance : is_iso (from_termwise_split_mono_lift_triangleₕ f) :=
begin
  haveI : is_iso (from_termwise_split_mono_lift_triangleₕ f).hom₁,
  { delta from_termwise_split_mono_lift_triangleₕ, dsimp, apply_instance },
  haveI : is_iso (from_termwise_split_mono_lift_triangleₕ f).hom₂ :=
    is_iso.of_iso (homotopy_category.iso_of_homotopy_equiv
      (termwise_split_mono_factor_homotopy_equiv f)),
  apply cone.triangleₕ_is_iso,
end

-- move this
@[simp]
lemma cochain_complex_d_next (i : ℤ) (f : Π i j, A.X i ⟶ B.X j) :
  d_next i f = A.d i (i + 1) ≫ f (i + 1) i :=
by { simp only [d_next, add_monoid_hom.mk'_apply], rw [← cochain_complex.next] }

@[simp]
lemma cochain_complex_prev_d (i : ℤ) (f : Π i j, A.X i ⟶ B.X j) :
  prev_d i f = f i (i - 1) ≫ B.d (i - 1) i :=
by { simp only [prev_d, add_monoid_hom.mk'_apply], rw [← cochain_complex.prev] }

@[simps]
def termwise_split_to_cone (h : ∀ i, splitting (f.f i) (g.f i)) :
  C ⟶ cone f :=
{ f := λ i, biprod.lift (-(connecting_hom f g h).f i) ((h i).section),
  comm' := begin
    rintro i j (rfl : i + 1 = j),
    have He := λ i, (h i).split_epi,
    ext,
    { dsimp [cone.d],
      rw ← cancel_epi (g.f _),
      { simp [g.comm, splitting.π_section_eq_id_sub_assoc] },
      { exact (He _).epi } },
    { dsimp [cone.d],
      rw ← cancel_epi (g.f _),
      { simp [splitting.π_section_eq_id_sub_assoc, splitting.π_section_eq_id_sub] },
      { exact (He _).epi } },
  end }

@[simps]
def comp_termwise_split_to_cone_homotopy (h : ∀ i, splitting (f.f i) (g.f i)) :
  homotopy (g ≫ termwise_split_to_cone f g h) (cone.in f) :=
{ hom := λ i j,
    if e : j + 1 = i then -(h i).retraction ≫ (A.X_eq_to_iso e).inv ≫ biprod.inl else 0,
  zero' := λ _ _ r, dif_neg r,
  comm := λ i, begin
    dsimp,
    obtain ⟨i, rfl⟩ : ∃ j, j + 1 = i := ⟨i-1, sub_add_cancel _ _⟩,
    have aux₁ : (complex_shape.up ℤ).rel i (i + 1) := rfl,
    have aux₂ : (complex_shape.up ℤ).rel (i + 1) (i + 1 + 1) := rfl,
    rw [← d_next_eq_d_from_from_next, ← prev_d_eq_to_prev_d_to,
      d_next_eq _ aux₂, prev_d_eq _ aux₁, dif_pos rfl, dif_pos rfl],
    simp only [dite_eq_ite, cochain_complex_prev_d, dif_pos, if_true, category.assoc, cone_d,
      category.id_comp, add_left_inj, sub_add_cancel, dif_ctx_congr, X_eq_to_iso_refl, cone.d,
      preadditive.comp_neg, eq_self_iff_true, cochain_complex_d_next, preadditive.neg_comp],
    ext,
    { simp [cone.in, splitting.π_section_eq_id_sub_assoc, ← sub_eq_add_neg,
      -retraction_X_eq_to_hom_assoc] },
    { simp [cone.in, splitting.retraction_ι_eq_id_sub, ← sub_eq_add_neg,
      -retraction_X_eq_to_hom_assoc] },
  end }

@[simps]
def cone_to_termwise_split (h : ∀ i, splitting (f.f i) (g.f i)) :
  cone f ⟶ C :=
{ f := λ i, biprod.snd ≫ g.f i,
  comm' := begin
    rintro i j (rfl : i + 1 = j),
    ext; simp [cone.d, (h _).comp_eq_zero],
  end }

@[simps]
def cone_to_termwise_split_comp_homotopy (h : ∀ i, splitting (f.f i) (g.f i)) :
  homotopy (cone_to_termwise_split f g h ≫ connecting_hom f g h) (-cone.out f) :=
{ hom := λ i j,
    if e : j + 1 = i then biprod.snd ≫ (h i).retraction ≫ (A.X_eq_to_iso e).inv else 0,
  zero' := λ _ _ r, dif_neg r,
  comm := begin
    intro i,
    dsimp,
    obtain ⟨i, rfl⟩ : ∃ j, j + 1 = i := ⟨i-1, sub_add_cancel _ _⟩,
    have aux₁ : (complex_shape.up ℤ).rel i (i + 1) := rfl,
    have aux₂ : (complex_shape.up ℤ).rel (i + 1) (i + 1 + 1) := rfl,
    rw [← d_next_eq_d_from_from_next, ← prev_d_eq_to_prev_d_to,
      d_next_eq _ aux₂, prev_d_eq _ aux₁, dif_pos rfl, dif_pos rfl],
    simp only [category.comp_id, dite_eq_ite, cochain_complex_prev_d, cone.out, dif_pos, if_true,
      add_left_inj, sub_add_cancel, cone.d, shift_d, dif_ctx_congr, preadditive.comp_neg,
      eq_self_iff_true, int.neg_one_pow_one, cochain_complex_d_next, one_zsmul,
      category.assoc, X_eq_to_iso_d, neg_neg, neg_smul, biprod.lift_snd_assoc,
      X_eq_to_iso_refl, cone_d, preadditive.neg_comp],
    ext; -- This is simp [splitting.π_section_eq_id_sub_assoc, sub_eq_add_neg]
      simp only [splitting.ι_retraction, preadditive.comp_add, preadditive.comp_neg,
        biprod.inl_snd_assoc, zero_comp, neg_zero, add_zero, biprod.inl_desc_assoc, biprod.inl_fst,
        add_right_neg, biprod.inr_snd_assoc, biprod.inr_desc_assoc, biprod.inr_fst,
        splitting.π_section_eq_id_sub_assoc, sub_eq_add_neg, hom.comm, hom.comm_assoc,
        preadditive.add_comp_assoc, category.id_comp, preadditive.neg_comp, category.assoc,
        preadditive.add_comp, category.comp_id, add_left_inj, eq_self_iff_true],
  end }

def iso_cone_of_termwise_split_inv_hom_homotopy (h : ∀ i, splitting (f.f i) (g.f i)) :
  homotopy (cone_to_termwise_split f g h ≫ termwise_split_to_cone f g h) (𝟙 _) :=
{ hom := λ i j, if e : j + 1 = i then
    -biprod.snd ≫ (h i).retraction ≫ (A.X_eq_to_iso e).inv ≫ biprod.inl else 0,
  zero' := λ _ _ r, dif_neg r,
  comm := begin
    intro i,
    dsimp,
    obtain ⟨i, rfl⟩ : ∃ j, j + 1 = i := ⟨i-1, sub_add_cancel _ _⟩,
    have aux₁ : (complex_shape.up ℤ).rel i (i + 1) := rfl,
    have aux₂ : (complex_shape.up ℤ).rel (i + 1) (i + 1 + 1) := rfl,
    rw [← d_next_eq_d_from_from_next, ← prev_d_eq_to_prev_d_to,
      d_next_eq _ aux₂, prev_d_eq _ aux₁, dif_pos rfl, dif_pos rfl],
    simp only [category.comp_id, dite_eq_ite, cochain_complex_prev_d, dif_pos, if_true,
      category.id_comp, add_left_inj, sub_add_cancel, cone.d, dif_ctx_congr,
      eq_self_iff_true, cochain_complex_d_next, category.assoc, biprod.lift_snd_assoc,
      X_eq_to_iso_refl, cone_d],
    ext; -- This is simp [splitting.π_section_eq_id_sub_assoc, splitting.π_section_eq_id_sub]
      simp only [add_left_neg, add_zero, category.assoc, category.comp_id, exact.w, exact.w_assoc,
        biprod.inl_desc, biprod.inl_desc_assoc, biprod.inl_fst, biprod.inr_desc_assoc,
        biprod.inr_fst, biprod.inr_snd, biprod.inr_snd_assoc, biprod.lift_fst, biprod.lift_snd,
        biprod.lift_snd_assoc, comp_zero, zero_comp, preadditive.add_comp, preadditive.comp_add,
        preadditive.comp_neg, preadditive.neg_comp, preadditive.neg_comp, category.comp_id,
        splitting.ι_retraction_assoc, eq_self_iff_true, X_eq_to_iso_d, X_eq_to_iso_f_assoc,
        X_eq_to_iso_refl, X_eq_to_iso_trans, neg_neg, neg_zero, zero_add, neg_sub, hom.comm_assoc,
        splitting.π_section_eq_id_sub_assoc, splitting.π_section_eq_id_sub, category.id_comp,
        preadditive.sub_comp_assoc, hom.comm, preadditive.sub_comp, splitting.ι_retraction,
        exact_inl_snd];
      abel
  end }

@[simps]
def iso_cone_of_termwise_split (h : ∀ i, splitting (f.f i) (g.f i)) :
  triangleₕ_of_termwise_split f g h ≅
    (category_theory.triangulated.neg₃_functor _).obj (cone.triangleₕ f) :=
begin
  fapply mk_triangle_iso,
  exact iso.refl _,
  exact iso.refl _,
  refine ⟨Q .map (termwise_split_to_cone f g h), Q .map (cone_to_termwise_split f g h), _, _⟩,
  { dsimp, erw [← Q .map_comp, ← Q .map_id], congr, ext; dsimp, simp },
  { dsimp, erw [← Q .map_comp, ← Q .map_id], apply homotopy_category.eq_of_homotopy,
    apply iso_cone_of_termwise_split_inv_hom_homotopy },
  { exact (category.comp_id _).trans (category.id_comp _).symm },
  { dsimp, rw [← Q .map_comp, category.id_comp],
    apply homotopy_category.eq_of_homotopy, apply comp_termwise_split_to_cone_homotopy },
  { dsimp, rw [category_theory.functor.map_id, category.comp_id,
    ← Q .map_neg, ← Q .map_comp], congr, ext, simp [cone.out] }
end

instance : mono (termwise_split_mono_lift f) := mono_of_eval _

def termwise_split_of_termwise_split_mono (H : ∀ i, split_mono (f.f i)) (i : ℤ) :
  have mono f := @mono_of_eval _ _ _ _ _ _ _ f (λ i, (H i).mono), by exactI
  splitting (f.f i) ((homological_complex.normal_mono f).g.f i) :=
begin
  apply left_split.splitting,
  dsimp only [normal_mono, cokernel_complex_π],
  constructor,
  exact ⟨(H i).1, (H i).2⟩,
  exact abelian.exact_cokernel _,
end

/-- Every neg₃ of a cone triangle is isomorphic to some triangle associated to some
  termwise split sequence -/
def iso_termwise_split_of_cone :
      (category_theory.triangulated.neg₃_functor _).obj (cone.triangleₕ f) ≅
    triangleₕ_of_termwise_split (termwise_split_mono_lift f)
      (homological_complex.normal_mono (termwise_split_mono_lift f)).g
    (termwise_split_of_termwise_split_mono _ $ termwise_split_mono_lift_split_mono _) :=
functor.map_iso _ (as_iso $ from_termwise_split_mono_lift_triangleₕ f).symm ≪≫
  (iso_cone_of_termwise_split _ _ _).symm

-- Lemma 13.9.15. skipped

--move
@[simp, reassoc]
lemma biprod.map_desc {C : Type*} [category C] [has_zero_morphisms C]
  {X Y X' Y' Z : C} [has_binary_biproduct X Y] [has_binary_biproduct X' Y']
  (f : X ⟶ X') (g : Y ⟶ Y') (f' : X' ⟶ Z) (g' : Y' ⟶ Z) :
    biprod.map f g ≫ biprod.desc f' g' = biprod.desc (f ≫ f') (g ≫ g') :=
by { ext; simp }

@[simp, reassoc]
lemma biprod.lift_map {C : Type*} [category C] [has_zero_morphisms C]
  {W X Y X' Y' : C} [has_binary_biproduct X Y] [has_binary_biproduct X' Y']
  (f : X ⟶ X') (g : Y ⟶ Y') (f' : W ⟶ X) (g' : W ⟶ Y) :
    biprod.lift f' g' ≫ biprod.map f g = biprod.lift (f' ≫ f) (g' ≫ g) :=
by { ext; simp }

@[simps]
def biprod.map_iso {C : Type*} [category C] [has_zero_morphisms C]
  {X Y X' Y' : C} [has_binary_biproduct X Y] [has_binary_biproduct X' Y']
  (f : X ≅ X') (g : Y ≅ Y') : X ⊞ Y ≅ X' ⊞ Y' :=
⟨biprod.map f.hom g.hom, biprod.map f.inv g.inv, by ext; simp, by ext; simp⟩

@[simps]
def iso_connecting_hom_shift_cone (h : ∀ i, splitting (f.f i) (g.f i)) :
  B ≅ cone ((connecting_hom f g h)⟦(-1 : ℤ)⟧') :=
hom.iso_of_components (λ f, (h _).iso ≪≫ biprod.braiding _ _ ≪≫
  biprod.map_iso (C.X_eq_to_iso (by simp)) (A.X_eq_to_iso (by simp)))
begin
  have He := λ i, (h i).split_epi,
  rintro i j (rfl : i + 1 = j),
  dsimp [cone.d],
  rw ← cancel_epi (h i).iso.inv,
  simp only [category.comp_id, biprod.lift_map, neg_smul_neg, if_true, iso.inv_hom_id_assoc,
    add_left_inj, eq_self_iff_true, one_zsmul, category.assoc, neg_neg, neg_smul],
  ext; simp only [add_zero, category.assoc, exact.w_assoc, biprod.inl_fst_assoc,
    biprod.inr_fst_assoc, biprod.inr_snd_assoc, biprod.lift_desc, biprod.lift_fst,
    biprod.lift_snd, comp_zero, zero_comp, preadditive.comp_add, X_d_eq_to_iso, X_eq_to_iso_d,
    splitting.comp_iso_eq_inl_assoc, splitting.inl_comp_iso_eq_assoc,
    splitting.iso_comp_snd_eq_assoc, eq_self_iff_true, hom.comm_assoc, zero_add,
    splitting.iso_hom_fst_assoc, splitting.inr_iso_inv_assoc, exact_inl_snd],
  { rw ← cancel_epi (g.f _),
    simp only [category.id_comp, preadditive.sub_comp_assoc, (h _).comp_eq_zero_assoc,
      sub_zero, category.assoc, comp_zero, hom.comm, preadditive.sub_comp, limits.zero_comp,
      splitting.π_section_eq_id_sub_assoc, hom.comm_assoc],
    rw [← X_eq_to_iso_f, X_d_eq_to_iso_assoc],
    exact (He _).epi },
  { rw ← cancel_epi (g.f _),
    simp only [category.comp_id, X_d_eq_to_iso, category.id_comp, preadditive.sub_comp_assoc,
      splitting.π_section_eq_id_sub_assoc, category.assoc, hom.comm, preadditive.sub_comp,
      splitting.ι_retraction],
    rw [← X_eq_to_iso_f_assoc, splitting.π_section_eq_id_sub_assoc],
    simp only [X_d_eq_to_iso_assoc, category.comp_id, hom.comm_assoc, retraction_X_eq_to_hom,
      category.id_comp, preadditive.sub_comp_assoc, X_eq_to_iso_d_assoc, splitting.ι_retraction,
      preadditive.comp_sub, hom.comm, preadditive.sub_comp, sub_right_inj, category.assoc],
    rw [← retraction_X_eq_to_hom_assoc, X_eq_to_iso_d],
    exact (He _).epi }
end

lemma inv_rotate_iso_cone_triangle_comm₁ (h : ∀ i, splitting (f.f i) (g.f i)) :
  (triangle_of_termwise_split f g h).nonneg_inv_rotate.mor₁ ≫ (shift_shift_neg _ _).inv =
    𝟙 _ ≫ (cone.triangle ((connecting_hom f g h)⟦(-1 : ℤ)⟧')).mor₁ :=
by { ext, dsimp, simp, dsimp, simp }

lemma inv_rotate_iso_cone_triangle_comm₂ (h : ∀ i, splitting (f.f i) (g.f i)) :
  (triangle_of_termwise_split f g h).nonneg_inv_rotate.mor₂ ≫
    (iso_connecting_hom_shift_cone f g h).hom =
    (shift_shift_neg _ _).inv ≫ (cone.triangle ((connecting_hom f g h)⟦(-1 : ℤ)⟧')).mor₂ :=
by { ext; dsimp [cone.in]; simp }

lemma inv_rotate_iso_cone_triangle_comm₃ (h : ∀ i, splitting (f.f i) (g.f i)) :
  (triangle_of_termwise_split f g h).nonneg_inv_rotate.mor₃ ≫
    (𝟙 _)⟦(1 : ℤ)⟧' = (iso_connecting_hom_shift_cone f g h).hom ≫
      (cone.triangle ((connecting_hom f g h)⟦(-1 : ℤ)⟧')).mor₃ :=
by { ext, dsimp [cone.out], simpa }

def inv_rotate_iso_cone_triangle (h : ∀ i, splitting (f.f i) (g.f i)) :
  (triangle_of_termwise_split f g h).nonneg_inv_rotate ≅
    cone.triangle ((connecting_hom f g h)⟦(-1 : ℤ)⟧') :=
begin
  fapply mk_triangle_iso,
  exacts [iso.refl _, (shift_shift_neg _ _).symm, iso_connecting_hom_shift_cone f g h,
    inv_rotate_iso_cone_triangle_comm₁ _ _ _, inv_rotate_iso_cone_triangle_comm₂ _ _ _,
    inv_rotate_iso_cone_triangle_comm₃ f g h],
end

def triangle_of_termwise_split_cone_iso :
  triangle_of_termwise_split (cone.in f) (cone.out f) (cone.termwise_split f) ≅
    (cone.triangle f).nonneg_rotate :=
mk_triangle_iso (iso.refl _) (iso.refl _) (iso.refl _)
  (by { dsimp, simp }) (by { dsimp, simp }) (by { ext, dsimp [cone.d], simp })

end homological_complex


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.pnat.basic
import Mathlib.data.list.range
import Mathlib.data.array.lemmas
import Mathlib.algebra.group.default
import Mathlib.data.sigma.basic
import Mathlib.PostPort

universes u v w l u_1

namespace Mathlib

/-!
# Hash maps

Defines a hash map data structure, representing a finite key-value map
with a value type that may depend on the key type.  The structure
requires a `nat`-valued hash function to associate keys to buckets.

## Main definitions

* `hash_map`: constructed with `mk_hash_map`.

## Implementation details

A hash map with key type `α` and (dependent) value type `β : α → Type*`
consists of an array of *buckets*, which are lists containing
key/value pairs for that bucket.  The hash function is taken modulo `n`
to assign keys to their respective bucket.  Because of this, some care
should be put into the hash function to ensure it evenly distributes
keys.

The bucket array is an `array`.  These have special VM support for
in-place modification if there is only ever one reference to them.  If
one takes special care to never keep references to old versions of a
hash map alive after updating it, then the hash map will be modified
in-place.  In this documentation, when we say a hash map is modified
in-place, we are assuming the API is being used in this manner.

When inserting (`hash_map.insert`), if the number of stored pairs (the
*size*) is going to exceed the number of buckets, then a new hash map
is first created with double the number of buckets and everything in
the old hash map is reinserted along with the new key/value pair.
Otherwise, the bucket array is modified in-place.  The amortized
running time of inserting $$n$$ elements into a hash map is $$O(n)$$.

When removing (`hash_map.erase`), the hash map is modified in-place.
The implementation does not reduce the number of buckets in the hash
map if the size gets too low.

## Tags

hash map

-/

/-- `bucket_array α β` is the underlying data type for `hash_map α β`,
  an array of linked lists of key-value pairs. -/
def bucket_array (α : Type u) (β : α → Type v) (n : ℕ+) :=
  array (↑n) (List (sigma fun (a : α) => β a))

/-- Make a hash_map index from a `nat` hash value and a (positive) buffer size -/
def hash_map.mk_idx (n : ℕ+) (i : ℕ) : fin ↑n := { val := i % ↑n, property := sorry }

namespace bucket_array

protected instance inhabited {α : Type u} {β : α → Type v} {n : ℕ+} :
    Inhabited (bucket_array α β n) :=
  { default := mk_array ↑n [] }

/-- Read the bucket corresponding to an element -/
def read {α : Type u} {β : α → Type v} (hash_fn : α → ℕ) {n : ℕ+} (data : bucket_array α β n)
    (a : α) : List (sigma fun (a : α) => β a) :=
  let bidx : fin ↑n := hash_map.mk_idx n (hash_fn a);
  array.read data bidx

/-- Write the bucket corresponding to an element -/
def write {α : Type u} {β : α → Type v} (hash_fn : α → ℕ) {n : ℕ+} (data : bucket_array α β n)
    (a : α) (l : List (sigma fun (a : α) => β a)) : bucket_array α β n :=
  let bidx : fin ↑n := hash_map.mk_idx n (hash_fn a);
  array.write data bidx l

/-- Modify (read, apply `f`, and write) the bucket corresponding to an element -/
def modify {α : Type u} {β : α → Type v} (hash_fn : α → ℕ) {n : ℕ+} (data : bucket_array α β n)
    (a : α) (f : List (sigma fun (a : α) => β a) → List (sigma fun (a : α) => β a)) :
    bucket_array α β n :=
  let bidx : fin ↑n := hash_map.mk_idx n (hash_fn a);
  array.write data bidx (f (array.read data bidx))

/-- The list of all key-value pairs in the bucket list -/
def as_list {α : Type u} {β : α → Type v} {n : ℕ+} (data : bucket_array α β n) :
    List (sigma fun (a : α) => β a) :=
  list.join (array.to_list data)

theorem mem_as_list {α : Type u} {β : α → Type v} {n : ℕ+} (data : bucket_array α β n)
    {a : sigma fun (a : α) => β a} : a ∈ as_list data ↔ ∃ (i : fin ↑n), a ∈ array.read data i :=
  sorry

/-- Fold a function `f` over the key-value pairs in the bucket list -/
def foldl {α : Type u} {β : α → Type v} {n : ℕ+} (data : bucket_array α β n) {δ : Type w} (d : δ)
    (f : δ → (a : α) → β a → δ) : δ :=
  array.foldl data d
    fun (b : List (sigma fun (a : α) => β a)) (d : δ) =>
      list.foldl (fun (r : δ) (a : sigma fun (a : α) => β a) => f r (sigma.fst a) (sigma.snd a)) d b

theorem foldl_eq {α : Type u} {β : α → Type v} {n : ℕ+} (data : bucket_array α β n) {δ : Type w}
    (d : δ) (f : δ → (a : α) → β a → δ) :
    foldl data d f =
        list.foldl (fun (r : δ) (a : sigma fun (a : α) => β a) => f r (sigma.fst a) (sigma.snd a)) d
          (as_list data) :=
  sorry

end bucket_array

namespace hash_map

/-- Insert the pair `⟨a, b⟩` into the correct location in the bucket array
  (without checking for duplication) -/
def reinsert_aux {α : Type u} {β : α → Type v} (hash_fn : α → ℕ) {n : ℕ+}
    (data : bucket_array α β n) (a : α) (b : β a) : bucket_array α β n :=
  bucket_array.modify hash_fn data a fun (l : List (sigma fun (a : α) => β a)) => sigma.mk a b :: l

theorem mk_as_list {α : Type u} {β : α → Type v} (n : ℕ+) :
    bucket_array.as_list (mk_array ↑n []) = [] :=
  sorry

/-- Search a bucket for a key `a` and return the value -/
def find_aux {α : Type u} {β : α → Type v} [DecidableEq α] (a : α) :
    List (sigma fun (a : α) => β a) → Option (β a) :=
  sorry

theorem find_aux_iff {α : Type u} {β : α → Type v} [DecidableEq α] {a : α} {b : β a}
    {l : List (sigma fun (a : α) => β a)} :
    list.nodup (list.map sigma.fst l) → (find_aux a l = some b ↔ sigma.mk a b ∈ l) :=
  sorry

/-- Returns `tt` if the bucket `l` contains the key `a` -/
def contains_aux {α : Type u} {β : α → Type v} [DecidableEq α] (a : α)
    (l : List (sigma fun (a : α) => β a)) : Bool :=
  option.is_some (find_aux a l)

theorem contains_aux_iff {α : Type u} {β : α → Type v} [DecidableEq α] {a : α}
    {l : List (sigma fun (a : α) => β a)} (nd : list.nodup (list.map sigma.fst l)) :
    ↥(contains_aux a l) ↔ a ∈ list.map sigma.fst l :=
  sorry

/-- Modify a bucket to replace a value in the list. Leaves the list
 unchanged if the key is not found. -/
def replace_aux {α : Type u} {β : α → Type v} [DecidableEq α] (a : α) (b : β a) :
    List (sigma fun (a : α) => β a) → List (sigma fun (a : α) => β a) :=
  sorry

/-- Modify a bucket to remove a key, if it exists. -/
def erase_aux {α : Type u} {β : α → Type v} [DecidableEq α] (a : α) :
    List (sigma fun (a : α) => β a) → List (sigma fun (a : α) => β a) :=
  sorry

/-- The predicate `valid bkts sz` means that `bkts` satisfies the `hash_map`
  invariants: There are exactly `sz` elements in it, every pair is in the
  bucket determined by its key and the hash function, and no key appears
  multiple times in the list. -/
structure valid {α : Type u} {β : α → Type v} (hash_fn : α → ℕ) [DecidableEq α] {n : ℕ+}
    (bkts : bucket_array α β n) (sz : ℕ)
    where
  len : list.length (bucket_array.as_list bkts) = sz
  idx :
    ∀ {i : fin ↑n} {a : sigma fun (a : α) => β a},
      a ∈ array.read bkts i → mk_idx n (hash_fn (sigma.fst a)) = i
  nodup : ∀ (i : fin ↑n), list.nodup (list.map sigma.fst (array.read bkts i))

theorem valid.idx_enum {α : Type u} {β : α → Type v} (hash_fn : α → ℕ) [DecidableEq α] {n : ℕ+}
    {bkts : bucket_array α β n} {sz : ℕ} (v : valid hash_fn bkts sz) {i : ℕ}
    {l : List (sigma fun (a : α) => β a)} (he : (i, l) ∈ list.enum (array.to_list bkts)) {a : α}
    {b : β a} (hl : sigma.mk a b ∈ l) :
    ∃ (h : i < ↑n), mk_idx n (hash_fn a) = { val := i, property := h } :=
  sorry

theorem valid.idx_enum_1 {α : Type u} {β : α → Type v} (hash_fn : α → ℕ) [DecidableEq α] {n : ℕ+}
    {bkts : bucket_array α β n} {sz : ℕ} (v : valid hash_fn bkts sz) {i : ℕ}
    {l : List (sigma fun (a : α) => β a)} (he : (i, l) ∈ list.enum (array.to_list bkts)) {a : α}
    {b : β a} (hl : sigma.mk a b ∈ l) : subtype.val (mk_idx n (hash_fn a)) = i :=
  sorry

theorem valid.as_list_nodup {α : Type u} {β : α → Type v} (hash_fn : α → ℕ) [DecidableEq α] {n : ℕ+}
    {bkts : bucket_array α β n} {sz : ℕ} (v : valid hash_fn bkts sz) :
    list.nodup (list.map sigma.fst (bucket_array.as_list bkts)) :=
  sorry

theorem mk_valid {α : Type u} {β : α → Type v} (hash_fn : α → ℕ) [DecidableEq α] (n : ℕ+) :
    valid hash_fn (mk_array ↑n []) 0 :=
  sorry

theorem valid.find_aux_iff {α : Type u} {β : α → Type v} (hash_fn : α → ℕ) [DecidableEq α] {n : ℕ+}
    {bkts : bucket_array α β n} {sz : ℕ} (v : valid hash_fn bkts sz) {a : α} {b : β a} :
    find_aux a (bucket_array.read hash_fn bkts a) = some b ↔
        sigma.mk a b ∈ bucket_array.as_list bkts :=
  sorry

theorem valid.contains_aux_iff {α : Type u} {β : α → Type v} (hash_fn : α → ℕ) [DecidableEq α]
    {n : ℕ+} {bkts : bucket_array α β n} {sz : ℕ} (v : valid hash_fn bkts sz) (a : α) :
    ↥(contains_aux a (bucket_array.read hash_fn bkts a)) ↔
        a ∈ list.map sigma.fst (bucket_array.as_list bkts) :=
  sorry

theorem append_of_modify {α : Type u} {β : α → Type v} [DecidableEq α] {n : ℕ+}
    {bkts : bucket_array α β n} {bidx : fin ↑n}
    {f : List (sigma fun (a : α) => β a) → List (sigma fun (a : α) => β a)}
    (u : List (sigma fun (a : α) => β a)) (v1 : List (sigma fun (a : α) => β a))
    (v2 : List (sigma fun (a : α) => β a)) (w : List (sigma fun (a : α) => β a))
    (hl : array.read bkts bidx = u ++ v1 ++ w) (hfl : f (array.read bkts bidx) = u ++ v2 ++ w) :
    ∃ (u' : List (sigma fun (a : α) => β a)),
        ∃ (w' : List (sigma fun (a : α) => β a)),
          bucket_array.as_list bkts = u' ++ v1 ++ w' ∧
            bucket_array.as_list bkts' = u' ++ v2 ++ w' :=
  sorry

theorem valid.modify {α : Type u} {β : α → Type v} (hash_fn : α → ℕ) [DecidableEq α] {n : ℕ+}
    {bkts : bucket_array α β n} {bidx : fin ↑n}
    {f : List (sigma fun (a : α) => β a) → List (sigma fun (a : α) => β a)}
    (u : List (sigma fun (a : α) => β a)) (v1 : List (sigma fun (a : α) => β a))
    (v2 : List (sigma fun (a : α) => β a)) (w : List (sigma fun (a : α) => β a))
    (hl : array.read bkts bidx = u ++ v1 ++ w) (hfl : f (array.read bkts bidx) = u ++ v2 ++ w)
    (hvnd : list.nodup (list.map sigma.fst v2))
    (hal : ∀ (a : sigma fun (a : α) => β a), a ∈ v2 → mk_idx n (hash_fn (sigma.fst a)) = bidx)
    (djuv : list.disjoint (list.map sigma.fst u) (list.map sigma.fst v2))
    (djwv : list.disjoint (list.map sigma.fst w) (list.map sigma.fst v2)) {sz : ℕ}
    (v : valid hash_fn bkts sz) :
    list.length v1 ≤ sz + list.length v2 ∧
        valid hash_fn bkts' (sz + list.length v2 - list.length v1) :=
  sorry

theorem valid.replace_aux {α : Type u} {β : α → Type v} [DecidableEq α] (a : α) (b : β a)
    (l : List (sigma fun (a : α) => β a)) :
    a ∈ list.map sigma.fst l →
        ∃ (u : List (sigma fun (a : α) => β a)),
          ∃ (w : List (sigma fun (a : α) => β a)),
            ∃ (b' : β a),
              l = u ++ [sigma.mk a b'] ++ w ∧ replace_aux a b l = u ++ [sigma.mk a b] ++ w :=
  sorry

theorem valid.replace {α : Type u} {β : α → Type v} (hash_fn : α → ℕ) [DecidableEq α] {n : ℕ+}
    {bkts : bucket_array α β n} {sz : ℕ} (a : α) (b : β a)
    (Hc : ↥(contains_aux a (bucket_array.read hash_fn bkts a))) (v : valid hash_fn bkts sz) :
    valid hash_fn (bucket_array.modify hash_fn bkts a (replace_aux a b)) sz :=
  sorry

theorem valid.insert {α : Type u} {β : α → Type v} (hash_fn : α → ℕ) [DecidableEq α] {n : ℕ+}
    {bkts : bucket_array α β n} {sz : ℕ} (a : α) (b : β a)
    (Hnc : ¬↥(contains_aux a (bucket_array.read hash_fn bkts a))) (v : valid hash_fn bkts sz) :
    valid hash_fn (reinsert_aux hash_fn bkts a b) (sz + 1) :=
  sorry

theorem valid.erase_aux {α : Type u} {β : α → Type v} [DecidableEq α] (a : α)
    (l : List (sigma fun (a : α) => β a)) :
    a ∈ list.map sigma.fst l →
        ∃ (u : List (sigma fun (a : α) => β a)),
          ∃ (w : List (sigma fun (a : α) => β a)),
            ∃ (b : β a), l = u ++ [sigma.mk a b] ++ w ∧ erase_aux a l = u ++ [] ++ w :=
  sorry

theorem valid.erase {α : Type u} {β : α → Type v} (hash_fn : α → ℕ) [DecidableEq α] {n : ℕ+}
    {bkts : bucket_array α β n} {sz : ℕ} (a : α)
    (Hc : ↥(contains_aux a (bucket_array.read hash_fn bkts a))) (v : valid hash_fn bkts sz) :
    valid hash_fn (bucket_array.modify hash_fn bkts a (erase_aux a)) (sz - 1) :=
  sorry

end hash_map

/-- A hash map data structure, representing a finite key-value map
  with key type `α` and value type `β` (which may depend on `α`). -/
structure hash_map (α : Type u) [DecidableEq α] (β : α → Type v) where
  hash_fn : α → ℕ
  size : ℕ
  nbuckets : ℕ+
  buckets : bucket_array α β nbuckets
  is_valid : hash_map.valid hash_fn buckets size

/-- Construct an empty hash map with buffer size `nbuckets` (default 8). -/
def mk_hash_map {α : Type u} [DecidableEq α] {β : α → Type v} (hash_fn : α → ℕ)
    (nbuckets : optParam ℕ (bit0 (bit0 (bit0 1)))) : hash_map α β :=
  let n : optParam ℕ (bit0 (bit0 (bit0 1))) := ite (nbuckets = 0) (bit0 (bit0 (bit0 1))) nbuckets;
  let nz : n > 0 := sorry;
  hash_map.mk hash_fn 0 { val := n, property := nz } (mk_array n []) sorry

namespace hash_map

/-- Return the value corresponding to a key, or `none` if not found -/
def find {α : Type u} {β : α → Type v} [DecidableEq α] (m : hash_map α β) (a : α) : Option (β a) :=
  find_aux a (bucket_array.read (hash_fn m) (buckets m) a)

/-- Return `tt` if the key exists in the map -/
def contains {α : Type u} {β : α → Type v} [DecidableEq α] (m : hash_map α β) (a : α) : Bool :=
  option.is_some (find m a)

protected instance has_mem {α : Type u} {β : α → Type v} [DecidableEq α] :
    has_mem α (hash_map α β) :=
  has_mem.mk fun (a : α) (m : hash_map α β) => ↥(contains m a)

/-- Fold a function over the key-value pairs in the map -/
def fold {α : Type u} {β : α → Type v} [DecidableEq α] {δ : Type w} (m : hash_map α β) (d : δ)
    (f : δ → (a : α) → β a → δ) : δ :=
  bucket_array.foldl (buckets m) d f

/-- The list of key-value pairs in the map -/
def entries {α : Type u} {β : α → Type v} [DecidableEq α] (m : hash_map α β) :
    List (sigma fun (a : α) => β a) :=
  bucket_array.as_list (buckets m)

/-- The list of keys in the map -/
def keys {α : Type u} {β : α → Type v} [DecidableEq α] (m : hash_map α β) : List α :=
  list.map sigma.fst (entries m)

theorem find_iff {α : Type u} {β : α → Type v} [DecidableEq α] (m : hash_map α β) (a : α)
    (b : β a) : find m a = some b ↔ sigma.mk a b ∈ entries m :=
  valid.find_aux_iff (hash_fn m) (is_valid m)

theorem contains_iff {α : Type u} {β : α → Type v} [DecidableEq α] (m : hash_map α β) (a : α) :
    ↥(contains m a) ↔ a ∈ keys m :=
  valid.contains_aux_iff (hash_fn m) (is_valid m) a

theorem entries_empty {α : Type u} {β : α → Type v} [DecidableEq α] (hash_fn : α → ℕ)
    (n : optParam ℕ (bit0 (bit0 (bit0 1)))) : entries (mk_hash_map hash_fn n) = [] :=
  mk_as_list (nbuckets (mk_hash_map hash_fn n))

theorem keys_empty {α : Type u} {β : α → Type v} [DecidableEq α] (hash_fn : α → ℕ)
    (n : optParam ℕ (bit0 (bit0 (bit0 1)))) : keys (mk_hash_map hash_fn n) = [] :=
  sorry

theorem find_empty {α : Type u} {β : α → Type v} [DecidableEq α] (hash_fn : α → ℕ)
    (n : optParam ℕ (bit0 (bit0 (bit0 1)))) (a : α) : find (mk_hash_map hash_fn n) a = none :=
  sorry

theorem not_contains_empty {α : Type u} {β : α → Type v} [DecidableEq α] (hash_fn : α → ℕ)
    (n : optParam ℕ (bit0 (bit0 (bit0 1)))) (a : α) : ¬↥(contains (mk_hash_map hash_fn n) a) :=
  sorry

theorem insert_lemma {α : Type u} {β : α → Type v} [DecidableEq α] (hash_fn : α → ℕ) {n : ℕ+}
    {n' : ℕ+} {bkts : bucket_array α β n} {sz : ℕ} (v : valid hash_fn bkts sz) :
    valid hash_fn (bucket_array.foldl bkts (mk_array ↑n' []) (reinsert_aux hash_fn)) sz :=
  sorry

/-- Insert a key-value pair into the map. (Modifies `m` in-place when applicable) -/
def insert {α : Type u} {β : α → Type v} [DecidableEq α] (m : hash_map α β) (a : α) (b : β a) :
    hash_map α β :=
  sorry

theorem mem_insert {α : Type u} {β : α → Type v} [DecidableEq α] (m : hash_map α β) (a : α)
    (b : β a) (a' : α) (b' : β a') :
    sigma.mk a' b' ∈ entries (insert m a b) ↔ ite (a = a') (b == b') (sigma.mk a' b' ∈ entries m) :=
  sorry

theorem find_insert_eq {α : Type u} {β : α → Type v} [DecidableEq α] (m : hash_map α β) (a : α)
    (b : β a) : find (insert m a b) a = some b :=
  iff.mpr (find_iff (insert m a b) a b)
    (iff.mpr (mem_insert m a b a b)
      (eq.mpr
        (id (Eq._oldrec (Eq.refl (ite (a = a) (b == b) (sigma.mk a b ∈ entries m))) (if_pos rfl)))
        (HEq.refl b)))

theorem find_insert_ne {α : Type u} {β : α → Type v} [DecidableEq α] (m : hash_map α β) (a : α)
    (a' : α) (b : β a) (h : a ≠ a') : find (insert m a b) a' = find m a' :=
  sorry

theorem find_insert {α : Type u} {β : α → Type v} [DecidableEq α] (m : hash_map α β) (a' : α)
    (a : α) (b : β a) :
    find (insert m a b) a' =
        dite (a = a') (fun (h : a = a') => some (eq.rec_on h b)) fun (h : ¬a = a') => find m a' :=
  sorry

/-- Insert a list of key-value pairs into the map. (Modifies `m` in-place when applicable) -/
def insert_all {α : Type u} {β : α → Type v} [DecidableEq α] (l : List (sigma fun (a : α) => β a))
    (m : hash_map α β) : hash_map α β :=
  list.foldl (fun (m : hash_map α β) (_x : sigma fun (a : α) => β a) => sorry) m l

/-- Construct a hash map from a list of key-value pairs. -/
def of_list {α : Type u} {β : α → Type v} [DecidableEq α] (l : List (sigma fun (a : α) => β a))
    (hash_fn : α → ℕ) : hash_map α β :=
  insert_all l (mk_hash_map hash_fn (bit0 1 * list.length l))

/-- Remove a key from the map. (Modifies `m` in-place when applicable) -/
def erase {α : Type u} {β : α → Type v} [DecidableEq α] (m : hash_map α β) (a : α) : hash_map α β :=
  sorry

theorem mem_erase {α : Type u} {β : α → Type v} [DecidableEq α] (m : hash_map α β) (a : α) (a' : α)
    (b' : β a') : sigma.mk a' b' ∈ entries (erase m a) ↔ a ≠ a' ∧ sigma.mk a' b' ∈ entries m :=
  sorry

theorem find_erase_eq {α : Type u} {β : α → Type v} [DecidableEq α] (m : hash_map α β) (a : α) :
    find (erase m a) a = none :=
  sorry

theorem find_erase_ne {α : Type u} {β : α → Type v} [DecidableEq α] (m : hash_map α β) (a : α)
    (a' : α) (h : a ≠ a') : find (erase m a) a' = find m a' :=
  sorry

theorem find_erase {α : Type u} {β : α → Type v} [DecidableEq α] (m : hash_map α β) (a' : α)
    (a : α) : find (erase m a) a' = ite (a = a') none (find m a') :=
  sorry

protected instance has_to_string {α : Type u} {β : α → Type v} [DecidableEq α] [has_to_string α]
    [(a : α) → has_to_string (β a)] : has_to_string (hash_map α β) :=
  has_to_string.mk to_string

/-- `hash_map` with key type `nat` and value type that may vary. -/
protected instance inhabited {β : ℕ → Type u_1} : Inhabited (hash_map ℕ β) :=
  { default := mk_hash_map id }

end Mathlib