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

! This file was ported from Lean 3 source module data.multiset.locally_finite
! leanprover-community/mathlib commit 59694bd07f0a39c5beccba34bd9f413a160782bf
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finset.LocallyFinite

/-!
# Intervals as multisets

This file provides basic results about all the `Multiset.Ixx`, which are defined in
`Order.LocallyFinite`.

Note that intervals of multisets themselves (`Multiset.LocallyFiniteOrder`) are defined elsewhere.
-/

variable {α : Type _}

namespace Multiset

section Preorder

variable [Preorder α] [LocallyFiniteOrder α] {a b c : α}

theorem nodup_Icc : (Icc a b).Nodup :=
  Finset.nodup _
#align multiset.nodup_Icc Multiset.nodup_Icc

theorem nodup_Ico : (Ico a b).Nodup :=
  Finset.nodup _
#align multiset.nodup_Ico Multiset.nodup_Ico

theorem nodup_Ioc : (Ioc a b).Nodup :=
  Finset.nodup _
#align multiset.nodup_Ioc Multiset.nodup_Ioc

theorem nodup_Ioo : (Ioo a b).Nodup :=
  Finset.nodup _
#align multiset.nodup_Ioo Multiset.nodup_Ioo

@[simp]
theorem Icc_eq_zero_iff : Icc a b = 0 ↔ ¬a ≤ b := by
  rw [Icc, Finset.val_eq_zero, Finset.Icc_eq_empty_iff]
#align multiset.Icc_eq_zero_iff Multiset.Icc_eq_zero_iff

@[simp]
theorem Ico_eq_zero_iff : Ico a b = 0 ↔ ¬a < b := by
  rw [Ico, Finset.val_eq_zero, Finset.Ico_eq_empty_iff]
#align multiset.Ico_eq_zero_iff Multiset.Ico_eq_zero_iff

@[simp]
theorem Ioc_eq_zero_iff : Ioc a b = 0 ↔ ¬a < b := by
  rw [Ioc, Finset.val_eq_zero, Finset.Ioc_eq_empty_iff]
#align multiset.Ioc_eq_zero_iff Multiset.Ioc_eq_zero_iff

@[simp]
theorem Ioo_eq_zero_iff [DenselyOrdered α] : Ioo a b = 0 ↔ ¬a < b := by
  rw [Ioo, Finset.val_eq_zero, Finset.Ioo_eq_empty_iff]
#align multiset.Ioo_eq_zero_iff Multiset.Ioo_eq_zero_iff

alias Icc_eq_zero_iff ↔ _ Icc_eq_zero
#align multiset.Icc_eq_zero Multiset.Icc_eq_zero

alias Ico_eq_zero_iff ↔ _ Ico_eq_zero
#align multiset.Ico_eq_zero Multiset.Ico_eq_zero

alias Ioc_eq_zero_iff ↔ _ Ioc_eq_zero
#align multiset.Ioc_eq_zero Multiset.Ioc_eq_zero

@[simp]
theorem Ioo_eq_zero (h : ¬a < b) : Ioo a b = 0 :=
  eq_zero_iff_forall_not_mem.2 fun _x hx => h ((mem_Ioo.1 hx).1.trans (mem_Ioo.1 hx).2)
#align multiset.Ioo_eq_zero Multiset.Ioo_eq_zero

@[simp]
theorem Icc_eq_zero_of_lt (h : b < a) : Icc a b = 0 :=
  Icc_eq_zero h.not_le
#align multiset.Icc_eq_zero_of_lt Multiset.Icc_eq_zero_of_lt

@[simp]
theorem Ico_eq_zero_of_le (h : b ≤ a) : Ico a b = 0 :=
  Ico_eq_zero h.not_lt
#align multiset.Ico_eq_zero_of_le Multiset.Ico_eq_zero_of_le

@[simp]
theorem Ioc_eq_zero_of_le (h : b ≤ a) : Ioc a b = 0 :=
  Ioc_eq_zero h.not_lt
#align multiset.Ioc_eq_zero_of_le Multiset.Ioc_eq_zero_of_le

@[simp]
theorem Ioo_eq_zero_of_le (h : b ≤ a) : Ioo a b = 0 :=
  Ioo_eq_zero h.not_lt
#align multiset.Ioo_eq_zero_of_le Multiset.Ioo_eq_zero_of_le

variable (a)

-- Porting note: simp can prove this -- @[simp]
theorem Ico_self : Ico a a = 0 := by rw [Ico, Finset.Ico_self, Finset.empty_val]
#align multiset.Ico_self Multiset.Ico_self

-- Porting note: simp can prove this -- @[simp]
theorem Ioc_self : Ioc a a = 0 := by rw [Ioc, Finset.Ioc_self, Finset.empty_val]
#align multiset.Ioc_self Multiset.Ioc_self

-- Porting note: simp can prove this -- @[simp]
theorem Ioo_self : Ioo a a = 0 := by rw [Ioo, Finset.Ioo_self, Finset.empty_val]
#align multiset.Ioo_self Multiset.Ioo_self

variable {a}

theorem left_mem_Icc : a ∈ Icc a b ↔ a ≤ b :=
  Finset.left_mem_Icc
#align multiset.left_mem_Icc Multiset.left_mem_Icc

theorem left_mem_Ico : a ∈ Ico a b ↔ a < b :=
  Finset.left_mem_Ico
#align multiset.left_mem_Ico Multiset.left_mem_Ico

theorem right_mem_Icc : b ∈ Icc a b ↔ a ≤ b :=
  Finset.right_mem_Icc
#align multiset.right_mem_Icc Multiset.right_mem_Icc

theorem right_mem_Ioc : b ∈ Ioc a b ↔ a < b :=
  Finset.right_mem_Ioc
#align multiset.right_mem_Ioc Multiset.right_mem_Ioc

-- Porting note: simp can prove this -- @[simp]
theorem left_not_mem_Ioc : a ∉ Ioc a b :=
  Finset.left_not_mem_Ioc
#align multiset.left_not_mem_Ioc Multiset.left_not_mem_Ioc

-- Porting note: simp can prove this -- @[simp]
theorem left_not_mem_Ioo : a ∉ Ioo a b :=
  Finset.left_not_mem_Ioo
#align multiset.left_not_mem_Ioo Multiset.left_not_mem_Ioo

-- Porting note: simp can prove this -- @[simp]
theorem right_not_mem_Ico : b ∉ Ico a b :=
  Finset.right_not_mem_Ico
#align multiset.right_not_mem_Ico Multiset.right_not_mem_Ico

-- Porting note: simp can prove this -- @[simp]
theorem right_not_mem_Ioo : b ∉ Ioo a b :=
  Finset.right_not_mem_Ioo
#align multiset.right_not_mem_Ioo Multiset.right_not_mem_Ioo

theorem Ico_filter_lt_of_le_left [DecidablePred (· < c)] (hca : c ≤ a) :
    ((Ico a b).filter fun x => x < c) = ∅ := by
  rw [Ico, ← Finset.filter_val, Finset.Ico_filter_lt_of_le_left hca]
  rfl
#align multiset.Ico_filter_lt_of_le_left Multiset.Ico_filter_lt_of_le_left

theorem Ico_filter_lt_of_right_le [DecidablePred (· < c)] (hbc : b ≤ c) :
    ((Ico a b).filter fun x => x < c) = Ico a b := by
  rw [Ico, ← Finset.filter_val, Finset.Ico_filter_lt_of_right_le hbc]
#align multiset.Ico_filter_lt_of_right_le Multiset.Ico_filter_lt_of_right_le

theorem Ico_filter_lt_of_le_right [DecidablePred (· < c)] (hcb : c ≤ b) :
    ((Ico a b).filter fun x => x < c) = Ico a c := by
  rw [Ico, ← Finset.filter_val, Finset.Ico_filter_lt_of_le_right hcb]
  rfl
#align multiset.Ico_filter_lt_of_le_right Multiset.Ico_filter_lt_of_le_right

theorem Ico_filter_le_of_le_left [DecidablePred ((· ≤ ·) c)] (hca : c ≤ a) :
    ((Ico a b).filter fun x => c ≤ x) = Ico a b := by
  rw [Ico, ← Finset.filter_val, Finset.Ico_filter_le_of_le_left hca]
#align multiset.Ico_filter_le_of_le_left Multiset.Ico_filter_le_of_le_left

theorem Ico_filter_le_of_right_le [DecidablePred ((· ≤ ·) b)] :
    ((Ico a b).filter fun x => b ≤ x) = ∅ := by
  rw [Ico, ← Finset.filter_val, Finset.Ico_filter_le_of_right_le]
  rfl
#align multiset.Ico_filter_le_of_right_le Multiset.Ico_filter_le_of_right_le

theorem Ico_filter_le_of_left_le [DecidablePred ((· ≤ ·) c)] (hac : a ≤ c) :
    ((Ico a b).filter fun x => c ≤ x) = Ico c b := by
  rw [Ico, ← Finset.filter_val, Finset.Ico_filter_le_of_left_le hac]
  rfl
#align multiset.Ico_filter_le_of_left_le Multiset.Ico_filter_le_of_left_le

end Preorder

section PartialOrder

variable [PartialOrder α] [LocallyFiniteOrder α] {a b : α}

@[simp]
theorem Icc_self (a : α) : Icc a a = {a} := by rw [Icc, Finset.Icc_self, Finset.singleton_val]
#align multiset.Icc_self Multiset.Icc_self

theorem Ico_cons_right (h : a ≤ b) : b ::ₘ Ico a b = Icc a b := by
  classical
    rw [Ico, ← Finset.insert_val_of_not_mem right_not_mem_Ico, Finset.Ico_insert_right h]
    rfl
#align multiset.Ico_cons_right Multiset.Ico_cons_right

theorem Ioo_cons_left (h : a < b) : a ::ₘ Ioo a b = Ico a b := by
  classical
    rw [Ioo, ← Finset.insert_val_of_not_mem left_not_mem_Ioo, Finset.Ioo_insert_left h]
    rfl
#align multiset.Ioo_cons_left Multiset.Ioo_cons_left

theorem Ico_disjoint_Ico {a b c d : α} (h : b ≤ c) : (Ico a b).Disjoint (Ico c d) :=
  fun x hab hbc => by
  rw [mem_Ico] at hab hbc
  exact hab.2.not_le (h.trans hbc.1)
#align multiset.Ico_disjoint_Ico Multiset.Ico_disjoint_Ico

@[simp]
theorem Ico_inter_Ico_of_le [DecidableEq α] {a b c d : α} (h : b ≤ c) : Ico a b ∩ Ico c d = 0 :=
  Multiset.inter_eq_zero_iff_disjoint.2 <| Ico_disjoint_Ico h
#align multiset.Ico_inter_Ico_of_le Multiset.Ico_inter_Ico_of_le

theorem Ico_filter_le_left {a b : α} [DecidablePred (· ≤ a)] (hab : a < b) :
    ((Ico a b).filter fun x => x ≤ a) = {a} := by
  rw [Ico, ← Finset.filter_val, Finset.Ico_filter_le_left hab]
  rfl
#align multiset.Ico_filter_le_left Multiset.Ico_filter_le_left

theorem card_Ico_eq_card_Icc_sub_one (a b : α) : card (Ico a b) = card (Icc a b) - 1 :=
  Finset.card_Ico_eq_card_Icc_sub_one _ _
#align multiset.card_Ico_eq_card_Icc_sub_one Multiset.card_Ico_eq_card_Icc_sub_one

theorem card_Ioc_eq_card_Icc_sub_one (a b : α) : card (Ioc a b) = card (Icc a b) - 1 :=
  Finset.card_Ioc_eq_card_Icc_sub_one _ _
#align multiset.card_Ioc_eq_card_Icc_sub_one Multiset.card_Ioc_eq_card_Icc_sub_one

theorem card_Ioo_eq_card_Ico_sub_one (a b : α) : card (Ioo a b) = card (Ico a b) - 1 :=
  Finset.card_Ioo_eq_card_Ico_sub_one _ _
#align multiset.card_Ioo_eq_card_Ico_sub_one Multiset.card_Ioo_eq_card_Ico_sub_one

theorem card_Ioo_eq_card_Icc_sub_two (a b : α) : card (Ioo a b) = card (Icc a b) - 2 :=
  Finset.card_Ioo_eq_card_Icc_sub_two _ _
#align multiset.card_Ioo_eq_card_Icc_sub_two Multiset.card_Ioo_eq_card_Icc_sub_two

end PartialOrder

section LinearOrder

variable [LinearOrder α] [LocallyFiniteOrder α] {a b c d : α}

theorem Ico_subset_Ico_iff {a₁ b₁ a₂ b₂ : α} (h : a₁ < b₁) :
    Ico a₁ b₁ ⊆ Ico a₂ b₂ ↔ a₂ ≤ a₁ ∧ b₁ ≤ b₂ :=
  Finset.Ico_subset_Ico_iff h
#align multiset.Ico_subset_Ico_iff Multiset.Ico_subset_Ico_iff

theorem Ico_add_Ico_eq_Ico {a b c : α} (hab : a ≤ b) (hbc : b ≤ c) : Ico a b + Ico b c = Ico a c :=
  by
  rw [add_eq_union_iff_disjoint.2 (Ico_disjoint_Ico le_rfl), Ico, Ico, Ico, ← Finset.union_val,
    Finset.Ico_union_Ico_eq_Ico hab hbc]
#align multiset.Ico_add_Ico_eq_Ico Multiset.Ico_add_Ico_eq_Ico

theorem Ico_inter_Ico : Ico a b ∩ Ico c d = Ico (max a c) (min b d) := by
  rw [Ico, Ico, Ico, ← Finset.inter_val, Finset.Ico_inter_Ico]
#align multiset.Ico_inter_Ico Multiset.Ico_inter_Ico

@[simp]
theorem Ico_filter_lt (a b c : α) : ((Ico a b).filter fun x => x < c) = Ico a (min b c) := by
  rw [Ico, Ico, ← Finset.filter_val, Finset.Ico_filter_lt]
#align multiset.Ico_filter_lt Multiset.Ico_filter_lt

@[simp]
theorem Ico_filter_le (a b c : α) : ((Ico a b).filter fun x => c ≤ x) = Ico (max a c) b := by
  rw [Ico, Ico, ← Finset.filter_val, Finset.Ico_filter_le]
#align multiset.Ico_filter_le Multiset.Ico_filter_le

@[simp]
theorem Ico_sub_Ico_left (a b c : α) : Ico a b - Ico a c = Ico (max a c) b := by
  rw [Ico, Ico, Ico, ← Finset.sdiff_val, Finset.Ico_diff_Ico_left]
#align multiset.Ico_sub_Ico_left Multiset.Ico_sub_Ico_left

@[simp]
theorem Ico_sub_Ico_right (a b c : α) : Ico a b - Ico c b = Ico a (min b c) := by
  rw [Ico, Ico, Ico, ← Finset.sdiff_val, Finset.Ico_diff_Ico_right]
#align multiset.Ico_sub_Ico_right Multiset.Ico_sub_Ico_right

end LinearOrder

section OrderedCancelAddCommMonoid

variable [OrderedCancelAddCommMonoid α] [ExistsAddOfLE α] [LocallyFiniteOrder α]

theorem map_add_left_Icc (a b c : α) : (Icc a b).map ((· + ·) c) = Icc (c + a) (c + b) := by
  classical rw [Icc, Icc, ← Finset.image_add_left_Icc, Finset.image_val,
      ((Finset.nodup _).map <| add_right_injective c).dedup]
#align multiset.map_add_left_Icc Multiset.map_add_left_Icc

theorem map_add_left_Ico (a b c : α) : (Ico a b).map ((· + ·) c) = Ico (c + a) (c + b) := by
  classical rw [Ico, Ico, ← Finset.image_add_left_Ico, Finset.image_val,
      ((Finset.nodup _).map <| add_right_injective c).dedup]
#align multiset.map_add_left_Ico Multiset.map_add_left_Ico

theorem map_add_left_Ioc (a b c : α) : (Ioc a b).map ((· + ·) c) = Ioc (c + a) (c + b) := by
  classical rw [Ioc, Ioc, ← Finset.image_add_left_Ioc, Finset.image_val,
      ((Finset.nodup _).map <| add_right_injective c).dedup]
#align multiset.map_add_left_Ioc Multiset.map_add_left_Ioc

theorem map_add_left_Ioo (a b c : α) : (Ioo a b).map ((· + ·) c) = Ioo (c + a) (c + b) := by
  classical rw [Ioo, Ioo, ← Finset.image_add_left_Ioo, Finset.image_val,
      ((Finset.nodup _).map <| add_right_injective c).dedup]
#align multiset.map_add_left_Ioo Multiset.map_add_left_Ioo

theorem map_add_right_Icc (a b c : α) : ((Icc a b).map fun x => x + c) = Icc (a + c) (b + c) := by
  simp_rw [add_comm _ c]
  exact map_add_left_Icc _ _ _
#align multiset.map_add_right_Icc Multiset.map_add_right_Icc

theorem map_add_right_Ico (a b c : α) : ((Ico a b).map fun x => x + c) = Ico (a + c) (b + c) := by
  simp_rw [add_comm _ c]
  exact map_add_left_Ico _ _ _
#align multiset.map_add_right_Ico Multiset.map_add_right_Ico

theorem map_add_right_Ioc (a b c : α) : ((Ioc a b).map fun x => x + c) = Ioc (a + c) (b + c) := by
  simp_rw [add_comm _ c]
  exact map_add_left_Ioc _ _ _
#align multiset.map_add_right_Ioc Multiset.map_add_right_Ioc

theorem map_add_right_Ioo (a b c : α) : ((Ioo a b).map fun x => x + c) = Ioo (a + c) (b + c) := by
  simp_rw [add_comm _ c]
  exact map_add_left_Ioo _ _ _
#align multiset.map_add_right_Ioo Multiset.map_add_right_Ioo

end OrderedCancelAddCommMonoid

end Multiset


import for_mathlib.commsq
import for_mathlib.snake_lemma_naturality2
import for_mathlib.AddCommGroup.pt
import for_mathlib.bicartesian4
import for_mathlib.abelian_sheaves.functor_category

import system_of_complexes.shift_sub_id
import pseudo_normed_group.system_of_complexes2

noncomputable theory

universes u

open_locale nnreal

open opposite category_theory category_theory.limits category_theory.preadditive

section step1

variables {A B C : ℝ≥0ᵒᵖ ⥤ Ab.{u}} (f : A ⟶ B)
variables (ι : ulift.{u} ℕ → ℝ≥0)

def shift_sub_id.commsq (hι : monotone ι) :
  commsq (shift_sub_id A ι hι)
    (pi.map $ λ _, f.app _) (pi.map $ λ _, f.app _)
         (shift_sub_id B ι hι) :=
commsq.of_eq
begin
  simp only [shift_sub_id, sub_comp, comp_sub, category.id_comp, category.comp_id, shift_sub_id.shift],
  congr' 1,
  apply limit.hom_ext,
  intro j,
  simp only [limit.lift_map, limit.lift_π, cones.postcompose_obj_π, nat_trans.comp_app,
    fan.mk_π_app, discrete.nat_trans_app, category.assoc, nat_trans.naturality, lim_map_π_assoc],
end

end step1

section step2

variables {A B C : ulift.{u} ℕ → Ab.{u}} (f : Π k, A k ⟶ B k) (g : Π k, B k ⟶ C k)

lemma pi_map_exact (H : ∀ k, exact (f k) (g k)) :
  exact (pi.map f) (pi.map g) :=
begin
  simp only [AddCommGroup.exact_iff'] at H ⊢,
  split,
  { apply limit.hom_ext, intro j,
    simp only [category.assoc, lim_map_π, discrete.nat_trans_app, lim_map_π_assoc,
      zero_comp, (H j.1).1, comp_zero], },
  intros x hx,
  rw [add_monoid_hom.mem_ker, Ab.apply_eq_zero] at hx,
  have : ∀ k, (Ab.pt (limit.π (discrete.functor (λ k, B k)) k x)) ≫ g k.1 = 0,
  { intro k,
    suffices : Ab.pt x ≫ pi.map g ≫ pi.π _ k.1 = 0,
    { cases k,
      simpa [lim_map_π, discrete.nat_trans_app, ← category.assoc, hx, Ab.pt_comp] },
    rw [← category.assoc, hx, zero_comp] },
  simp only [← Ab.apply_eq_zero] at this,
  replace := λ k, (H k).2 (this ⟨k⟩),
  choose y hy using this,
  refine ⟨pi.lift (λ k, Ab.pt (y k)) ⟨1⟩, _⟩,
  rw [← category_theory.comp_apply, ← Ab.pt_apply' x],
  congr' 1,
  apply limit.hom_ext,
  rintro ⟨j⟩,
  simp only [limit.lift_map, limit.lift_π, cones.postcompose_obj_π, nat_trans.comp_app,
    fan.mk_π_app, discrete.nat_trans_app, Ab.pt_comp, hy],
end

end step2

section step3

variables {A B C : ℝ≥0ᵒᵖ ⥤ cochain_complex Ab.{u} ℕ} (f : A ⟶ B) (g : B ⟶ C)
variables (ι : ulift.{u} ℕ → ℝ≥0) (n : ℕ)

def piH_hom :
  (∏ (λ x, (A.obj (op $ ι x)).homology n)) ⟶ (∏ (λ x, (B.obj (op $ ι x)).homology n)) :=
pi.map $ λ k, (homology_functor _ _ _).map $ f.app _

def shift_sub_id.δ (H : ∀ c n, short_exact ((f.app c).f n) ((g.app c).f n)) :
  C ⋙ homology_functor _ _ n ⟶ A ⋙ homology_functor _ _ (n+1) :=
{ app := λ c, homological_complex.δ (f.app _) (g.app _) (H _) _ _ rfl,
  naturality' := λ c₁ c₂ h, by { symmetry, apply homological_complex.δ_natural } }

def piδ (H : ∀ c n, short_exact ((f.app c).f n) ((g.app c).f n)) :
  (∏ (λ x, (C.obj (op $ ι x)).homology n)) ⟶ (∏ (λ x, (A.obj (op $ ι x)).homology (n+1))) :=
pi.map $ λ k, (shift_sub_id.δ _ _ _ H).app _

lemma piH_les (H : ∀ c n, short_exact ((f.app c).f n) ((g.app c).f n)) :
  exact_seq Ab.{u} [piH_hom f ι n, piH_hom g ι n, piδ f g ι n H] :=
begin
  apply exact.cons,
  { apply pi_map_exact, intro k,
    have := homological_complex.six_term_exact_seq _ _ (H (op $ ι k)) n (n+1) rfl,
    exact this.pair, },
  apply exact.exact_seq,
  { apply pi_map_exact, intro k,
    have := homological_complex.six_term_exact_seq _ _ (H (op $ ι k)) n (n+1) rfl,
    exact (this.drop 1).pair, },
end

end step3

section step4

variables {A B C : system_of_complexes.{u}} (f : A.to_Ab ⟶ B.to_Ab) (g : B.to_Ab ⟶ C.to_Ab)
variables (n : ℕ) (ι : ulift.{u} ℕ → ℝ≥0) (hι : monotone ι)

lemma shift_sub_id.bicartesian
  (HA₁ : (shift_sub_id.shift (A.to_AbH n) ι hι) = 0)
  (HA₂ : (shift_sub_id.shift (A.to_AbH (n+1)) ι hι) = 0)
  (H : ∀ c n, short_exact ((f.app c).f n) ((g.app c).f n)) :
  (@shift_sub_id.commsq (B.to_AbH n) (C.to_AbH n)
    (whisker_right g _) ι hι).bicartesian :=
begin
  rw ← commsq.bicartesian.symm_iff,
  let S1 := ((@shift_sub_id.commsq (A.to_AbH n) (B.to_AbH n) (whisker_right f _) ι hι)).symm,
  let S2 := ((@shift_sub_id.commsq (B.to_AbH n) (C.to_AbH n) (whisker_right g _) ι hι)).symm,
  let S3 := ((@shift_sub_id.commsq (C.to_AbH n) (A.to_AbH (n+1)) (shift_sub_id.δ _ _ _ H) ι hι)).symm,
  apply bicartesian_of_id_of_end_of_end_of_id (piH_les _ _ _ _ _) S1 S2 S3; clear S1 S2 S3,
  { rw [shift_sub_id, HA₁, zero_sub], refl },
  { rw [shift_sub_id, HA₂, zero_sub], refl },
end

end step4

section step5

variables {A B A' B' : ℝ≥0ᵒᵖ ⥤ Ab.{u}} (f : A ⟶ B) (f' : A' ⟶ B') (eA : A ≅ A') (eB : B ≅ B')
variables (ι : ulift.{u} ℕ → ℝ≥0) (hι : monotone ι)

lemma shift_sub_id.bicartesian_iso (w : f ≫ eB.hom = eA.hom ≫ f')
  (sq : (shift_sub_id.commsq f ι hι).bicartesian) :
  (shift_sub_id.commsq f' ι hι).bicartesian :=
begin
  let H : _ := _,
  apply commsq.bicartesian.of_iso _ _ _ _ _ H H _ sq,
  { refine limits.lim.map_iso (discrete.nat_iso $ λ k, eA.app _), },
  { refine limits.lim.map_iso (discrete.nat_iso $ λ k, eB.app _), },
  { apply shift_sub_id.commsq },
  { apply shift_sub_id.commsq },
  { apply commsq.of_eq, delta pi.map,
    simp only [functor.map_iso_hom, ← lim_map_eq_lim_map, ← category_theory.functor.map_comp],
    apply limit.hom_ext,
    simp only [lim_map_eq_lim_map, lim_map_π, nat_trans.comp_app, discrete.nat_trans_app,
      discrete.nat_iso_hom_app, iso.app_hom],
    intro, simp only [← nat_trans.comp_app, w], }
end

end step5


import for_mathlib.category_theory.triangulated.shift_compatibility
import for_mathlib.category_theory.shift_misc
import algebra.group.commute
import tactic.abel

noncomputable theory

namespace category_theory

open category

variables (C : Type*) {A G : Type*} [category C] [add_monoid A] [add_comm_group G]
  [has_shift C A] [has_shift C G]

def shift_functor_add₃' (a₁ a₂ a₃ : A) (b : A) (h : b = a₁+a₂+a₃) :
  shift_functor C b ≅ shift_functor C a₁ ⋙
    shift_functor C a₂ ⋙ shift_functor C a₃ :=
shift_functor_add' C (a₁+a₂) a₃ b h ≪≫ iso_whisker_right (shift_functor_add C a₁ a₂) _ ≪≫ functor.associator _ _ _

variable {C}

lemma shift_functor_add₃'_hom_app (a₁ a₂ a₃ : A) (b : A) (h : b = a₁+a₂+a₃) (a₁₂ : A) (h₁₂ : a₁₂ = a₁ + a₂) (X : C) :
  (shift_functor_add₃' C a₁ a₂ a₃ b h).hom.app X =
    (shift_functor_add' C a₁₂ a₃ b (by rw [h₁₂, h])).hom.app X ≫
    ((shift_functor_add' C a₁ a₂ a₁₂ h₁₂).hom.app X)⟦a₃⟧' :=
begin
  substs h₁₂ h,
  dsimp only [shift_functor_add₃', iso.trans, iso_whisker_right,
    functor.associator, nat_trans.comp_app, whiskering_right,
    functor.map_iso, whisker_right],
  simp only [comp_id, shift_functor_add'_eq_shift_functor_add],
end

lemma shift_functor_add₃'_inv_app (a₁ a₂ a₃ : A) (b : A) (h : b = a₁+a₂+a₃) (a₁₂ : A) (h₁₂ : a₁₂ = a₁ + a₂) (X : C) :
  (shift_functor_add₃' C a₁ a₂ a₃ b h).inv.app X =
    ((shift_functor_add' C a₁ a₂ a₁₂ h₁₂).inv.app X)⟦a₃⟧' ≫
    (shift_functor_add' C a₁₂ a₃ b (by rw [h₁₂, h])).inv.app X :=
begin
  substs h₁₂ h,
  dsimp only [shift_functor_add₃', iso.trans, iso_whisker_right,
    functor.associator, nat_trans.comp_app, whiskering_right,
    functor.map_iso, whisker_right],
  simp only [id_comp, shift_functor_add'_eq_shift_functor_add],
end

local attribute [instance, reducible] endofunctor_monoidal_category
local attribute [reducible] discrete.add_monoidal

lemma shift_functor_add₃'_hom_app' (a₁ a₂ a₃ : A) (b : A) (h : b = a₁+a₂+a₃) (a₂₃ : A) (h₂₃ : a₂₃ = a₂ + a₃) (X : C) :
  (shift_functor_add₃' C a₁ a₂ a₃ b h).hom.app X =
  (shift_functor_add' C a₁ a₂₃ b (by rw [h, h₂₃, add_assoc])).hom.app _ ≫
    (shift_functor_add' C a₂ a₃ a₂₃ h₂₃).hom.app (X⟦a₁⟧) :=
begin
  subst h₂₃,
  simp only [shift_functor_add₃'_hom_app a₁ a₂ a₃ b h (a₁+a₂) rfl,
    shift_functor_add'_eq_shift_functor_add],
  have h : b = a₁+(a₂+a₃) := by rw [h, add_assoc],
  subst h,
  rw shift_functor_add'_eq_shift_functor_add,
  have eq := congr_arg iso.inv (monoidal_functor.associativity_iso_eq (shift_monoidal_functor C A)
    (discrete.mk a₁) (discrete.mk a₂) (discrete.mk a₃)),
  replace eq := congr_app eq X,
  dsimp [shift_functor_add'] at eq ⊢,
  simpa only [assoc, id_comp, comp_id,
    functor.map_id, eq_to_hom_map] using eq,
end

lemma shift_functor_add₃'_inv_app' (a₁ a₂ a₃ : A) (b : A) (h : b = a₁+a₂+a₃) (a₂₃ : A) (h₂₃ : a₂₃ = a₂ + a₃) (X : C) :
  (shift_functor_add₃' C a₁ a₂ a₃ b h).inv.app X =
  (shift_functor_add' C a₂ a₃ a₂₃ h₂₃).inv.app (X⟦a₁⟧) ≫
  (shift_functor_add' C a₁ a₂₃ b (by rw [h, h₂₃, add_assoc])).inv.app _ :=
begin
  simp only [← cancel_mono ((shift_functor_add₃' C a₁ a₂ a₃ b h).hom.app X),
    iso.inv_hom_id_app, assoc],
  subst h₂₃,
  simpa only [shift_functor_add₃'_hom_app' _ _ _ _ h _ rfl,
    iso.inv_hom_id_app_assoc, iso.inv_hom_id_app],
end

lemma shift_shift_neg_hom_of_shift (X : C) (a b : G) :
  (shift_shift_neg (X⟦a⟧) b).hom = (shift_functor_add₃' C a b (-b) a (by simp)).inv.app X :=
begin
  rw shift_functor_add₃'_inv_app' a b (-b) a (by abel) 0 (by abel),
  dsimp [shift_functor_add'],
  simp only [assoc, ε_inv_app_obj, eq_to_hom_map],
  congr' 3,
  erw eq_to_hom_map,
end

lemma shift_compatibility_add_comm (X : C) (a b c : G) (h : a = b + c):
  (shift_functor_add' C a (-b) c (by rw [h, add_neg_cancel_comm])).inv.app (X⟦b⟧) ≫
    (shift_functor_add' C b c a h).inv.app X =
  ((shift_functor_add_comm C b a).hom.app X)⟦-b⟧' ≫ (shift_shift_neg (X⟦a⟧) b).hom :=
begin
  rw ← shift_functor_add₃'_inv_app' b a (-b) a (by abel) c,
  rw shift_shift_neg_hom_of_shift,
  rw shift_functor_add₃'_inv_app b a (-b) a (by abel) (a+b) (by abel),
  rw shift_functor_add₃'_inv_app a b (-b) a (by abel) (a+b) (by abel),
  simp only [← functor.map_comp_assoc],
  congr' 2,
  simp only [shift_functor_add_comm_hom_app, shift_functor_add'_eq_shift_functor_add,
    assoc, iso.hom_inv_id_app, comp_id],
  dsimp only [shift_functor_add'],
  simp only [iso.trans_inv, eq_to_iso.inv, nat_trans.comp_app, eq_to_hom_app],
end

end category_theory


import for_mathlib.algebra.homology.triangulated
import for_mathlib.category_theory.triangulated.homological_functor_localization
import for_mathlib.category_theory.shift_misc
import for_mathlib.category_theory.localization.composition
import for_mathlib.algebra.homology.cylinder

noncomputable theory

open category_theory category_theory.category category_theory.limits
  category_theory.triangulated category_theory.pretriangulated
open_locale zero_object

namespace category_theory.pretriangulated

variables {D : Type*} [category D] [has_zero_object D] [has_shift D ℤ] [preadditive D]
  [∀ (n : ℤ), (shift_functor D n).additive] [pretriangulated D]

namespace triangle

def distinguished (T : triangle D) : Prop :=
  T ∈ dist_triang D

lemma distinguished_iff (T : triangle D) :
  T.distinguished ↔ T ∈ dist_triang D := by refl

lemma distinguished.mk (T : triangle D) (hT : T ∈ dist_triang D) : T.distinguished :=
hT

namespace distinguished

variable {T : triangle D}

lemma comp_zero₁₂ (h : T.distinguished) : T.mor₁ ≫ T.mor₂ = 0 := comp_zero₁₂ _ h
lemma comp_zero₂₃ (h : T.distinguished) : T.mor₂ ≫ T.mor₃ = 0 :=
(candidate_triangle.of_distinguished _ h).2.zero₂₃
lemma comp_zero₃₁ (h : T.distinguished) : T.mor₃ ≫ T.mor₁⟦(1 : ℤ)⟧' = 0 :=
(candidate_triangle.of_distinguished _ h).2.zero₃₁

lemma rotate (h : T.distinguished) : T.rotate.distinguished :=
rot_of_dist_triangle D T h
lemma inv_rotate (h : T.distinguished) : T.inv_rotate.distinguished :=
inv_rot_of_dist_triangle D T h

end distinguished

end triangle

end category_theory.pretriangulated

open category_theory.triangulated category_theory.pretriangulated

section

variables {C ι : Type*} [category C]
  (c : complex_shape ι)

instance homological_complex.single_additive [decidable_eq ι] [preadditive C] [has_zero_object C] (n : ι) :
  (homological_complex.single C c n).additive :=
⟨λ X Y f g, by { ext i, dsimp, split_ifs; simp, }⟩

instance homotopy_category.homology_functor_additive [abelian C] (n : ι) :
  (homotopy_category.homology_functor C c n).additive :=
@quotient.lift_additive _ _ _ _ _ _ _ _ _
    (infer_instance : (homotopy_category.quotient C _).additive) _ _ _

variable (C)

def homotopy_category.comm_shift_quotient [preadditive C] (n : ℤ) :
  shift_functor (cochain_complex C ℤ) n ⋙
    homotopy_category.quotient _ _ ≅
  homotopy_category.quotient _ _ ⋙ shift_functor _ n :=
quotient.comm_shift _ _

namespace cochain_complex

section

variables [preadditive C] (K : cochain_complex C ℤ) (n k m : ℤ) (h : k + n = m)

include h

variable (C)

def shift_eval_prev : (shift_functor _ n) ⋙ homological_complex.eval C _ ((complex_shape.up ℤ).prev k) ≅
  homological_complex.eval C _ ((complex_shape.up ℤ).prev m) :=
preadditive.mul_iso ((-1 : units ℤ)^n) (eq_to_iso (congr_arg (homological_complex.eval _ _)
  (show (complex_shape.up ℤ).prev k + n = (complex_shape.up ℤ).prev m, by { simp, linarith, })))
def shift_eval : (shift_functor _ n) ⋙ homological_complex.eval C (complex_shape.up ℤ) k ≅
  homological_complex.eval C (complex_shape.up ℤ) m :=
eq_to_iso (congr_arg (homological_complex.eval _ _)  h)
def shift_eval_next : (shift_functor _ n) ⋙ homological_complex.eval C _ ((complex_shape.up ℤ).next k) ≅
  homological_complex.eval C _ ((complex_shape.up ℤ).next m) :=
preadditive.mul_iso ((-1 : units ℤ)^n) (eq_to_iso (congr_arg (homological_complex.eval _ _)
  (show (complex_shape.up ℤ).next k + n = (complex_shape.up ℤ).next m, by { simp, linarith, })))

omit h

variable {C}

lemma shift_eval_prev_hom_app_eq (X : cochain_complex C ℤ) :
  (shift_eval_prev C n k m h).hom.app X =
    (-1 : units ℤ)^n • eq_to_hom (congr_arg X.X
      (by rw [prev, prev, ← h, ← add_left_inj (1 : ℤ), sub_add_cancel, sub_eq_add_neg,
        add_assoc k, add_comm _ n, add_assoc, int.add_neg_one, sub_add_cancel])) :=
begin
  dsimp [shift_eval_prev],
  simpa only [nat_trans.app_zsmul, eq_to_hom_app],
end

lemma shift_eval_hom_app_eq (X : cochain_complex C ℤ) :
  (shift_eval C n k m h).hom.app X = eq_to_hom (congr_arg X.X h) :=
begin
  dsimp [shift_eval],
  apply eq_to_hom_app,
end

lemma shift_eval_next_hom_app_eq (X : cochain_complex C ℤ) :
  (shift_eval_next C n k m h).hom.app X =
    (-1 : units ℤ)^n • eq_to_hom (congr_arg X.X
    (by rw [next, next, ← h, add_assoc, add_assoc, add_comm _ n])) :=
begin
  dsimp [shift_eval_next],
  simpa only [nat_trans.app_zsmul, eq_to_hom_app],
end

lemma shift_eval_prev_hom_app_comp_d_to :
  (shift_eval_prev C n k m h).hom.app K ≫ K.d_to m =
    K⟦n⟧.d_to k ≫ (shift_eval C n k m h).hom.app K :=
begin
  subst h,
  simp only [K⟦n⟧.d_to_eq (show (k-1)+1 = k, by linarith),
    K.d_to_eq (show (k-1+n)+1 = k+n, by linarith), shift_functor_obj_d'],
  dsimp [homological_complex.X_prev_iso, shift_eval_prev, shift_eval],
  simp only [add_zero, zero_add, neg_zero, nat_trans.app_zsmul, eq_to_hom_app,
    linear.smul_comp_assoc, eq_to_hom_trans, linear.smul_comp, linear.comp_smul, assoc,
    eq_to_hom_trans_assoc],
  erw comp_id,
  refl,
end

lemma shift_eval_hom_app_comp_d_from :
(shift_eval C n k m h).hom.app K ≫ K.d_from m =
  K⟦n⟧.d_from k ≫ (shift_eval_next C n k m h).hom.app K :=
begin
  subst h,
  simp only [K⟦n⟧.d_from_eq rfl, shift_functor_obj_d',
    K.d_from_eq (show k+n+1=k+1+n, by linarith)],
  dsimp [homological_complex.X_next_iso, shift_eval_next, shift_eval, hom_complex.ε],
  simpa only [id_comp, linear.smul_comp, nat_trans.app_zsmul, eq_to_hom_app,
    linear.comp_smul, assoc, eq_to_hom_trans, smul_smul,
    ← units.coe_mul, ← mul_zpow, neg_mul, mul_neg, neg_neg,
    int.units_mul_self, one_zpow, units.coe_one, one_zsmul],
end

variable (C)

def shift_short_complex_functor_iso :
  shift_functor _ n ⋙ homological_complex.short_complex_functor C (complex_shape.up ℤ) k ≅
    homological_complex.short_complex_functor C (complex_shape.up ℤ) m :=
nat_iso.of_components
  (λ K, short_complex.mk_iso ((shift_eval_prev C _ _ _ h).app K) ((shift_eval C _ _ _ h).app K)
    (((shift_eval_next C _ _ _ h).app K)) (shift_eval_prev_hom_app_comp_d_to _ _ _ _ _)
    (shift_eval_hom_app_comp_d_from _ _ _ _ _))
  (λ K L φ, begin
    ext1,
    { exact (shift_eval_prev C _ _ _ h).hom.naturality φ, },
    { exact (shift_eval C _ _ _ h).hom.naturality φ, },
    { exact (shift_eval_next C _ _ _ h).hom.naturality φ, },
  end)

end

def shift_homology_functor_iso [abelian C] (n k m : ℤ) (h : k + n = m) :
  category_theory.shift_functor _ n ⋙ homology_functor C (complex_shape.up ℤ) k ≅
    homology_functor C _ m :=
(functor.associator _ _ _).symm ≪≫ iso_whisker_right (shift_short_complex_functor_iso C _ _ _ h) _

variable {C}

lemma shift_homology_functor_iso_hom_app [abelian C] (n k m : ℤ) (h : k + n = m)
  (X : cochain_complex C ℤ) :
  (shift_homology_functor_iso C n k m h).hom.app X =
    short_complex.homology_map ((shift_short_complex_functor_iso C _ _ _ h).hom.app X) :=
id_comp _

lemma shift_functor_add'_inv_app_comp_zero_hom_app_eq [abelian C] (n' n k : ℤ) (h : 0 = n' + n)
  (X : cochain_complex C ℤ) :
    ((category_theory.shift_functor_add' (cochain_complex C ℤ) n' n 0 h).inv.app X : _ ⟶ _).f k ≫
  ((shift_functor_zero (homological_complex C (complex_shape.up ℤ)) ℤ).hom.app X : _ ⟶ _).f k =
  eq_to_hom (congr_arg X.X (show k+n+n' = k, by rw [← add_left_inj n, add_assoc, ← h, add_zero])) :=
begin
  rw [shift_functor_add'_eq, shift_functor_zero_eq],
  apply eq_to_hom_trans,
end

@[simp, reassoc]
lemma shift_homology_functor_iso_hom_app_comp [abelian C] (n k m n' : ℤ)
  (h : k+n=m) (h' : m+n' = k) (X : cochain_complex C ℤ) :
  (shift_homology_functor_iso C n k m h).hom.app (X⟦n'⟧) ≫ (shift_homology_functor_iso C n' m k h').hom.app X =
  (_root_.homology_functor C _ k).map
    ((category_theory.shift_functor_add' (cochain_complex C ℤ) n' n 0
      (by rw [← add_right_inj m, ← add_assoc, h', h, add_zero])).inv.app X ≫
    (category_theory.shift_functor_zero _ ℤ).hom.app X) :=
begin
  have hn' : n' = -n := by linarith,
  subst hn',
  simp only [shift_homology_functor_iso_hom_app, homology_functor_map,
    ← short_complex.homology_map_comp],
  dsimp only [homological_complex.short_complex_functor,
      homological_complex.comp_f],
  congr' 1,
  ext1; dsimp only; rw shift_functor_add'_inv_app_comp_zero_hom_app_eq;
    dsimp [shift_short_complex_functor_iso],
  { simp only [shift_eval_prev_hom_app_eq],
    erw [preadditive.comp_zsmul, preadditive.zsmul_comp, smul_smul, eq_to_hom_trans],
    simpa only [← units.coe_mul, ← zpow_add, neg_add_self n,
      zpow_zero, units.coe_one, one_zsmul], },
  { simpa only [shift_eval_hom_app_eq, eq_to_hom_trans], },
  { simp only [shift_eval_next_hom_app_eq],
    erw [preadditive.comp_zsmul, preadditive.zsmul_comp, smul_smul, eq_to_hom_trans],
    simpa only [← units.coe_mul, ← zpow_add, neg_add_self n,
      zpow_zero, units.coe_one, one_zsmul], },
end

end cochain_complex

def homotopy_category.shift_homology_functor_iso [abelian C] (n k m : ℤ) (h : k + n = m):
  shift_functor _ n ⋙ homotopy_category.homology_functor C (complex_shape.up ℤ) k ≅
    homotopy_category.homology_functor C _ m :=
quotient.lift_nat_iso _ _ ((functor.associator _ _ _).symm ≪≫
  iso_whisker_right (quotient.comm_shift _ _).symm _ ≪≫
  functor.associator _ _ _ ≪≫
  iso_whisker_left _ (homotopy_category.homology_factors _ _ _).symm ≪≫
  cochain_complex.shift_homology_functor_iso C _ _ _ h ≪≫
  (homotopy_category.homology_factors _ _ _).symm)

end

variables (C : Type*) [category C] [abelian C]

section

open cochain_complex

lemma homology_functor_comp_ι_mapping_cone {K L : cochain_complex C ℤ} (φ : K ⟶ L) (n : ℤ) :
  (homology_functor C (complex_shape.up ℤ) n).map (φ ≫ mapping_cone.inr φ) = 0 :=
begin
  rw homotopy_category.homology_functor_map_factors,
  have hφ : homotopy_category.induced_triangle (mapping_cone.triangle φ) ∈ dist_triang _,
  { rw homotopy_category.triangle_distinguished_iff,
    exact ⟨_, _, _, ⟨iso.refl _⟩⟩, },
  simpa only [functor.map_comp, functor.map_zero]
    using (homotopy_category.homology_functor _ _ n).congr_map
      ((triangle.comp_eq_zero.of_distinguished _ hφ).zero₁₂),
end

variable {C}

lemma homology_functor_is_homological_aux {K L : cochain_complex C ℤ} (φ : K ⟶ L) (n : ℤ) :
  (short_complex.mk ((homology_functor C (complex_shape.up ℤ) n).map φ)
    ((homology_functor C (complex_shape.up ℤ) n).map (mapping_cone.inr φ))
    (by rw [← functor.map_comp, homology_functor_comp_ι_mapping_cone])).exact :=
begin
  rw short_complex.exact_iff_pseudo_exact',
  intros A₀ γ₂ hγ₂,
  dsimp at γ₂ hγ₂,
  /- the next three operations could be a specialised lemma -/
  obtain ⟨A₁, π₁, hπ₁, z₂, hz₂⟩ := abelian.pseudo_surjective_of_epi'
    (short_complex.homology_π _) γ₂,
  have hz₂' : ∃ z₂' hz₂', z₂ = short_complex.lift_cycles _ z₂' hz₂' :=
    ⟨z₂ ≫ short_complex.cycles_i _,
      by simp only [assoc, short_complex.cycles_i_g, comp_zero],
      by simp only [← cancel_mono ((homological_complex.short_complex_functor C
        (complex_shape.up ℤ) n).obj L).cycles_i, short_complex.lift_cycles_i]⟩,
  obtain ⟨z₂, hz₂', rfl⟩ := hz₂',
  replace hγ₂ := π₁ ≫= hγ₂,
  rw [reassoc_of hz₂, comp_zero, short_complex.homology_π_naturality, ← assoc,
    short_complex.comp_homology_π_eq_zero_iff] at hγ₂,
  obtain ⟨A₂, π₂, hπ₂, c₁, hc₁⟩ := hγ₂,
  dsimp at c₁ hc₁,
  replace hc₁ := hc₁ =≫ (short_complex.cycles_i _),
  simp only [assoc, homological_complex.short_complex_functor_map_τ₂,
    short_complex.lift_cycles_comp_cycles_map, short_complex.lift_cycles_i,
    short_complex.to_cycles_i, homological_complex.short_complex_functor_obj_f,
    @mapping_cone.to_ext_iff _ _ _ _ _ _ φ _ _ _ _ ((complex_shape.up _).next n) (by simp),
    mapping_cone.d_fst _ ((complex_shape.up _).prev n) n ((complex_shape.up _).next n) (by simp) (by simp),
    mapping_cone.d_snd _ ((complex_shape.up _).prev n) n (by simp),
    mapping_cone.inr_fst, comp_zero, preadditive.comp_neg,
    zero_eq_neg, mapping_cone.inr_snd, preadditive.comp_add] at hc₁,
  dsimp at hc₁,
  rw comp_id at hc₁,
  obtain ⟨hc₁, hc₁'⟩ := hc₁,
  rw ← assoc at hc₁,
  haveI := hπ₁,
  haveI := hπ₂,
  refine ⟨A₂, π₂ ≫ π₁, epi_comp _ _,
    ((homological_complex.short_complex_functor C
      (complex_shape.up ℤ) n).obj K).lift_cycles _ hc₁ ≫ short_complex.homology_π _, _⟩,
  dsimp,
  simp only [assoc, hz₂, short_complex.comp_lift_cycles_assoc,
    homological_complex.short_complex_functor_map_τ₂, short_complex.homology_π_naturality,
    short_complex.lift_cycles_comp_cycles_map_assoc,
    short_complex.lift_cycles_comp_homology_π_eq_iff],
  exact ⟨A₂, 𝟙 A₂, infer_instance,
    c₁ ≫ (mapping_cone.snd φ).v ((complex_shape.up ℤ).prev n)
      ((complex_shape.up ℤ).prev n) (add_zero _).symm, by simpa only [id_comp, hc₁', assoc]⟩,
end

end

variable (C)

namespace homotopy_category

instance homology_functor_is_homological (n : ℤ):
  (homology_functor C (complex_shape.up ℤ) n).is_homological :=
functor.is_homological.mk' _ (λ T hT, begin
  rw triangle_distinguished_iff at hT,
  obtain ⟨K, L, φ, ⟨e⟩⟩ := hT,
  refine ⟨_, ⟨_, _, _, ⟨mapping_cone_induced_triangle_iso φ⟩⟩, e,
    homology_functor_is_homological_aux φ n⟩,
end)

abbreviation acyclic : set (homotopy_category C (complex_shape.up ℤ)) :=
(homology_functor C (complex_shape.up ℤ) 0).kernel_of_is_homological

instance : saturated (homotopy_category.acyclic C) := infer_instance

lemma mem_acyclic_W_iff {K L : homotopy_category C (complex_shape.up ℤ)} (φ : K ⟶ L) :
  (subcategory.W (acyclic C)) φ ↔ ∀ (n : ℤ), is_iso ((homology_functor _ _ n).map φ) :=
begin
  rw functor.kernel_of_is_homological_W,
  simpa only [← λ n, nat_iso.is_iso_map_iff (shift_homology_functor_iso C _ _ _ (zero_add n)) φ],
end

lemma homology_functor_is_inverted_by (n : ℤ) :
  (subcategory.W (acyclic C)).is_inverted_by (homology_functor C (complex_shape.up ℤ) n) :=
begin
  intros K L φ hφ,
  rw mem_acyclic_W_iff at hφ,
  exact hφ n,
end

variable {C}

lemma map_quotient_W_iff {K L : cochain_complex C ℤ} (φ : K ⟶ L) :
  (subcategory.W (acyclic C)) ((quotient _ _).map φ) ↔ quasi_iso φ :=
begin
  simp only [mem_acyclic_W_iff, ← homology_functor_map_factors],
  split,
  { intro h,
    exact ⟨h⟩, },
  { intro h,
    exact h.is_iso, }
end

end homotopy_category

section

variables (D : Type*) [category D] [has_zero_morphisms D] [category_with_homology D]
  {ι : Type*} (c : complex_shape ι)

def quasi_isomorphisms :
  morphism_property (homological_complex D c) :=
λ K L φ, ∀ (i : ι), is_iso (homology_map φ i)

variables {D c}

lemma mem_quasi_isomorphisms_iff {K L : homological_complex D c} (φ : K ⟶ L) :
  quasi_isomorphisms D c φ ↔ quasi_iso φ :=
⟨λ h, ⟨h⟩, λ h, h.1⟩

end

abbreviation derived_category := (subcategory.W (homotopy_category.acyclic C)).localization

instance : inhabited (derived_category C) := ⟨0⟩

namespace derived_category

variable {C}

instance : pretriangulated (derived_category C) :=
pretriangulated.localization_pretriangulated _

instance : is_triangulated (derived_category C) :=
pretriangulated.localization_triangulated _

abbreviation Qh : homotopy_category C (complex_shape.up ℤ) ⥤ derived_category C :=
(subcategory.W (homotopy_category.acyclic C)).Q

--instance Qh_has_comm_shift : (Qh : _ ⥤ derived_category C).has_comm_shift ℤ :=
--infer_instance

--instance Qh_additive : (Qh : _ ⥤ (derived_category C)).additive :=
--infer_instance

--instance Qh_is_localization_W :
--  Qh.is_localization (homotopy_category.acyclic C).W := infer_instance

instance Qh_is_triangulated : (Qh : _ ⥤ derived_category C).is_triangulated :=
pretriangulated.localization_functor_is_triangulated _ _

instance : ess_surj (Qh : _ ⥤ derived_category C) :=
localization.ess_surj _ (subcategory.W (homotopy_category.acyclic C))

def Q : cochain_complex C ℤ ⥤ derived_category C :=
homotopy_category.quotient _ _ ⋙ Qh

instance Q_additive : (Q : _ ⥤ derived_category C).additive :=
by { dsimp [Q], apply_instance, }

variable (C)

instance Q_has_comm_shift : (Q : cochain_complex C ℤ ⥤ _).has_comm_shift ℤ :=
(infer_instance : (homotopy_category.quotient C _ ⋙
    Qh : cochain_complex C ℤ ⥤ _).has_comm_shift ℤ)

variable {C}

lemma Q_comm_shift_iso_hom_app (K : cochain_complex C ℤ ) (n : ℤ) :
  (Q.comm_shift_iso n).hom.app K =
    Qh.map (((homotopy_category.quotient C _).comm_shift_iso n).hom.app K) ≫
      (Qh.comm_shift_iso n).hom.app _ :=
functor.comm_shift_comp_hom_app _ _ _

lemma is_iso_Q_map_iff {K L : cochain_complex C ℤ} (φ : K ⟶ L) :
  is_iso (Q.map φ) ↔ quasi_iso φ :=
(subcategory.is_iso_map_iff _ Qh _).trans (homotopy_category.map_quotient_W_iff φ)

instance {K L : cochain_complex C ℤ} (φ : K ⟶ L) [quasi_iso φ] :
  is_iso (Q.map φ) :=
by { rw is_iso_Q_map_iff, apply_instance, }

variable (C)

lemma Q_inverts_quasi_isomorphisms : (quasi_isomorphisms C _).is_inverted_by Q :=
λ K L φ hφ, begin
  rw mem_quasi_isomorphisms_iff at hφ,
  haveI := hφ,
  apply_instance,
end

lemma homotopy_equivalences_subset_quasi_isomorphisms :
  cochain_complex.homotopy_equivalences C ⊆ quasi_isomorphisms C (complex_shape.up ℤ) :=
begin
  rintros K L _ ⟨h, rfl⟩,
  simpa only [mem_quasi_isomorphisms_iff] using h.to_quasi_iso,
end

instance Q_is_localization : Q.is_localization (quasi_isomorphisms C _) :=
localization.comp (homotopy_category.quotient _ _) Qh
    (cochain_complex.homotopy_equivalences C) (subcategory.W (homotopy_category.acyclic C))
    (quasi_isomorphisms C _) (Q_inverts_quasi_isomorphisms C)
    (homotopy_equivalences_subset_quasi_isomorphisms C)
(begin
  rintros ⟨K⟩ ⟨L⟩ φ hφ,
  have hf : ∃ (f : K ⟶ L), (homotopy_category.quotient _ _).map f = φ :=
    ⟨_, (homotopy_category.quotient C (complex_shape.up ℤ)).image_preimage φ⟩,
  obtain ⟨f, rfl⟩ := hf,
  refine ⟨_, _, f, _, ⟨iso.refl _⟩⟩,
  simpa only [mem_quasi_isomorphisms_iff, ← homotopy_category.map_quotient_W_iff] using hφ,
end)

instance : ess_surj (Q : _ ⥤ derived_category C) :=
localization.ess_surj _ (quasi_isomorphisms C _)

variable {C}

section

variables {K L : cochain_complex C ℤ}
  (φ : K ⟶ L)

def mapping_cone := Q.obj (cochain_complex.mapping_cone φ)

def ι_mapping_cone : Q.obj L ⟶ mapping_cone φ :=
Q.map (cochain_complex.mapping_cone.inr φ)

def mapping_cone_δ : mapping_cone φ ⟶ (Q.obj K)⟦(1 : ℤ)⟧ :=
  Q.map (cochain_complex.mapping_cone.δ φ) ≫ (Q.comm_shift_iso 1).hom.app K

def mapping_cone_triangle : triangle (derived_category C) :=
triangle.mk (Q.map φ) (ι_mapping_cone φ) (mapping_cone_δ φ)

lemma Qh_map_mapping_cone_triangle_iso :
  (Qh.map_triangle.obj (homotopy_category.mapping_cone_triangle' φ) ≅
    mapping_cone_triangle φ) :=
begin -- needs cleaning up...
  refine triangle.mk_iso _ _ (iso.refl _) (iso.refl _) (iso.refl _) _ _ _,
  { tidy, },
  { tidy, },
  { dsimp [iso.refl, mapping_cone_triangle, mapping_cone_δ,
      homotopy_category.mapping_cone_triangle',
      cochain_complex.mapping_cone.δ'],
    simp only [category_theory.functor.map_id, comp_id, id_comp,
      Q_comm_shift_iso_hom_app],
    congr' 1,
    symmetry,
    convert id_comp _,
    convert category_theory.functor.map_id _ _, },
end

end

lemma mem_dist_triang_iff' (T : triangle (derived_category C)) :
  (T ∈ dist_triang (derived_category C)) ↔
    ∃ (K L : cochain_complex C ℤ) (φ : K ⟶ L),
      nonempty (T ≅
        Qh.map_triangle.obj (homotopy_category.mapping_cone_triangle' φ)) :=
begin
  split,
  { rintro ⟨Th, e, ⟨K, L, φ, ⟨e'⟩⟩⟩,
    exact ⟨K, L, φ, ⟨e ≪≫ Qh.map_triangle.map_iso e'⟩⟩, },
  { rintro ⟨K, L, φ, ⟨e⟩⟩,
    exact ⟨_, e, ⟨K, L, φ, ⟨iso.refl _⟩⟩⟩, },
end

lemma mem_dist_triang_iff (T : triangle (derived_category C)) :
  (T ∈ dist_triang (derived_category C)) ↔
    ∃ (K L : cochain_complex C ℤ) (φ : K ⟶ L),
      nonempty (T ≅ mapping_cone_triangle φ) :=
begin
  rw mem_dist_triang_iff',
  split,
  { rintro ⟨K, L, φ, ⟨e⟩⟩,
    exact ⟨K, L, φ, ⟨e ≪≫ Qh_map_mapping_cone_triangle_iso _⟩⟩, },
  { rintro ⟨K, L, φ, ⟨e⟩⟩,
    exact ⟨K, L, φ, ⟨e ≪≫ (Qh_map_mapping_cone_triangle_iso _).symm⟩⟩, },
end

instance is_iso_Q_map_from_mapping_cone_of_ses
  {S : short_complex (cochain_complex C ℤ)}
  (ex : S.short_exact) :
  quasi_iso (cochain_complex.from_mapping_cone_of_ses ex) :=
cochain_complex.from_mapping_cone_of_ses_quasi_iso ex

def triangle_of_ses_δ {S : short_complex (cochain_complex C ℤ)}
  (ex : S.short_exact) : Q.obj S.X₃ ⟶ (Q.obj S.X₁)⟦(1 : ℤ)⟧ :=
inv (Q.map (cochain_complex.from_mapping_cone_of_ses ex)) ≫ (mapping_cone_triangle S.f).mor₃

@[simps]
def triangle_of_ses {S : short_complex (cochain_complex C ℤ)}
  (ex : S.short_exact) : triangle (derived_category C) :=
triangle.mk (Q.map S.f) (Q.map S.g) (triangle_of_ses_δ ex)

lemma triangle_of_ses_dist {S : short_complex (cochain_complex C ℤ)}
  (ex : S.short_exact) : (triangle_of_ses ex).distinguished :=
triangle.distinguished.mk _ begin
  rw mem_dist_triang_iff,
  refine ⟨_, _, S.f, ⟨_⟩⟩,
  refine triangle.mk_iso _ _ (iso.refl _) (iso.refl _)
    (as_iso (Q.map (cochain_complex.from_mapping_cone_of_ses ex))).symm (by tidy) _ _,
  { dsimp [triangle_of_ses, mapping_cone_triangle, ι_mapping_cone],
    simp only [← cancel_mono (Q.map (cochain_complex.from_mapping_cone_of_ses ex)),
      id_comp, assoc, is_iso.inv_hom_id, comp_id, ← Q.map_comp,
      cochain_complex.inr_mapping_cone_comp_from_mapping_cone_of_ses], },
  { dsimp [triangle_of_ses, triangle_of_ses_δ],
    simp only [category_theory.functor.map_id, comp_id], },
end

lemma left_factorisation {K L : cochain_complex C ℤ} (φ : Q.obj K ⟶ Q.obj L) :
  ∃ (L' : cochain_complex C ℤ) (f : K ⟶ L') (s : L ⟶ L') (hs : quasi_iso s),
    φ = Q.map f ≫ (by { haveI := hs, exact inv (Q.map s), }) :=
begin
  obtain ⟨⟨⟨L'⟩, f, s, hs⟩ , hz⟩ :=
    left_calculus_of_fractions.L_map_fac Qh
      (subcategory.W (homotopy_category.acyclic C)) φ,
  refine ⟨_, (homotopy_category.quotient _ _).preimage f,
    (homotopy_category.quotient _ _).preimage s, _, _⟩,
  { simpa only [← homotopy_category.map_quotient_W_iff, functor.image_preimage] using hs, },
  { dsimp [Q],
    simpa only [functor.image_preimage] using hz, },
end

lemma right_factorisation {K L : cochain_complex C ℤ} (φ : Q.obj K ⟶ Q.obj L) :
  ∃ (K' : cochain_complex C ℤ) (s : K' ⟶ K) (f : K' ⟶ L) (hs : quasi_iso s),
    φ = (by { haveI := hs, exact inv (Q.map s), }) ≫ Q.map f :=
begin
  obtain ⟨⟨⟨L'⟩, s, f, hs⟩ , hz⟩ :=
    right_calculus_of_fractions.L_map_fac Qh (subcategory.W (homotopy_category.acyclic C)) φ,
  refine ⟨_, (homotopy_category.quotient _ _).preimage s,
    (homotopy_category.quotient _ _).preimage f, _, _⟩,
  { simpa only [← homotopy_category.map_quotient_W_iff, functor.image_preimage] using hs, },
  { dsimp [Q],
    simpa only [functor.image_preimage] using hz, },
end

variable (C)

def homology_functor (n : ℤ) : derived_category C ⥤ C :=
localization.lift (homotopy_category.homology_functor C (complex_shape.up ℤ) n)
  (homotopy_category.homology_functor_is_inverted_by C n) Qh

instance (n : ℤ) : localization.lifting Qh (subcategory.W (homotopy_category.acyclic C))
  (homotopy_category.homology_functor C (complex_shape.up ℤ) n) (homology_functor C n) :=
localization.lifting_lift _ _ _

def homology_functor_factors_Qh (n : ℤ) :
  Qh ⋙ homology_functor C n ≅
    homotopy_category.homology_functor C (complex_shape.up ℤ) n :=
localization.lifting.iso _ (subcategory.W (homotopy_category.acyclic C)) _ _

instance homology_functor_lifting (n : ℤ) : localization.lifting Q (quasi_isomorphisms C (complex_shape.up ℤ))
  (_root_.homology_functor C _ n) (homology_functor C n) :=
⟨functor.associator _ _ _ ≪≫ iso_whisker_left _ ((homology_functor_factors_Qh C n)) ≪≫
  homotopy_category.homology_factors C _ n⟩

def homology_functor_factors (n : ℤ) :
  Q ⋙ homology_functor C n ≅ _root_.homology_functor C (complex_shape.up ℤ) n :=
localization.lifting.iso _ (quasi_isomorphisms C (complex_shape.up ℤ)) _ _

@[simp]
lemma lifting_iso_eq_homology_functor_factors (n : ℤ) :
  localization.lifting.iso Q (quasi_isomorphisms C (complex_shape.up ℤ))
    (_root_.homology_functor C (complex_shape.up ℤ) n) (homology_functor C n) =
homology_functor_factors C n := rfl

instance homology_functor_preserves_zero_morphisms (n : ℤ) :
  (homology_functor C n).preserves_zero_morphisms :=
functor.is_homological.localization_lift_preserves_zero_morphisms _ _ _

instance homology_functor_is_homological (n : ℤ) :
  (homology_functor C n).is_homological :=
functor.is_homological.localization_lift_is_homological _ _ _

variable {C}

lemma is_iso_iff_is_iso_homology {K L : derived_category C} (φ : K ⟶ L) :
  is_iso φ ↔ ∀ (n : ℤ), is_iso ((homology_functor C n).map φ) :=
begin
  split,
  { introI,
    exact λ n, infer_instance, },
  { suffices : ∀ ⦃K' L' : cochain_complex C ℤ⦄ (φ' : Q.obj K' ⟶ Q.obj L')
      (hφ' : ∀ (n : ℤ), is_iso ((homology_functor C n).map φ')), is_iso φ',
    { introI,
      let ψ := (Q.obj_obj_preimage_iso K).hom ≫ φ ≫ (Q.obj_obj_preimage_iso L).inv,
      have eq : φ = (Q.obj_obj_preimage_iso K).inv ≫ ψ ≫ (Q.obj_obj_preimage_iso L).hom,
      { simp only [assoc, iso.inv_hom_id, comp_id, iso.inv_hom_id_assoc], },
      rw eq,
      haveI : is_iso ψ := this ψ (λ n, begin
        dsimp only [ψ],
        simp only [functor.map_comp],
        apply_instance,
      end),
      apply_instance, },
    intros K' L' φ' hφ',
    obtain ⟨L', f, s, hs, eq⟩ := left_factorisation φ',
    haveI : is_iso (Q.map f),
    { simp only [eq, functor.map_comp] at hφ',
      haveI := hφ',
      haveI : ∀ (n : ℤ), is_iso ((homology_functor C n).map (Q.map f)),
      { intro n,
        exact is_iso.of_is_iso_comp_right _ ((homology_functor C n).map (inv (Q.map s))), },
      haveI : quasi_iso f,
      { rw ← mem_quasi_isomorphisms_iff,
        intro n,
        refine (nat_iso.is_iso_map_iff (homology_functor_factors C n) f).1 _,
        dsimp,
        apply_instance, },
      apply_instance, },
    rw eq,
    apply_instance, },
end

abbreviation homology (K : derived_category C) (n : ℤ) := (homology_functor C n).obj K

lemma Q_map_eq_of_homotopy {K L : cochain_complex C ℤ} (f₁ f₂ : K ⟶ L)
  (h : homotopy f₁ f₂) : Q.map f₁ = Q.map f₂ :=
begin
  dsimp [Q],
  rw homotopy_category.eq_of_homotopy _ _ h,
end

@[instance]
def shift_functor_comp_homology_lifting (a b : ℤ) :
  localization.lifting Q (quasi_isomorphisms C (complex_shape.up ℤ))
  (shift_functor (cochain_complex C ℤ) a ⋙ _root_.homology_functor C (complex_shape.up ℤ) b)
  (shift_functor (derived_category C) a ⋙ homology_functor C b) :=
⟨(functor.associator _ _ _).symm ≪≫ iso_whisker_right (Q.comm_shift_iso a).symm _ ≪≫
    functor.associator _ _ _ ≪≫ iso_whisker_left _ (homology_functor_factors C b)⟩

@[simp]
lemma shift_functor_comp_homology_lifting_iso_hom_app (a b : ℤ) (X : cochain_complex C ℤ) :
  (localization.lifting.iso Q (quasi_isomorphisms C (complex_shape.up ℤ))
  (shift_functor (cochain_complex C ℤ) a ⋙ _root_.homology_functor C (complex_shape.up ℤ) b)
  (shift_functor (derived_category C) a ⋙ homology_functor C b)).hom.app X =
    (homology_functor C b).map ((Q.comm_shift_iso a).inv.app X) ≫
      (homology_functor_factors C b).hom.app (X⟦a⟧) :=
begin
  dsimp [shift_functor_comp_homology_lifting],
  simp only [id_comp],
end

variable (C)

def shift_homology_functor_iso (n k m : ℤ) (h : k + n = m):
  shift_functor _ n ⋙ homology_functor C k ≅ homology_functor C m :=
localization.lift_nat_iso Q (quasi_isomorphisms C _) _ _ _ _
    (cochain_complex.shift_homology_functor_iso C n k m h)

variable {C}

lemma shift_homology_functor_iso_hom_app_Q_obj (n k m : ℤ) (h : k + n = m)
  (X : cochain_complex C ℤ) :
  (shift_homology_functor_iso C n k m h).hom.app (Q.obj X) =
  (homology_functor C k).map ((Q.comm_shift_iso n).inv.app X) ≫
      (homology_functor_factors C k).hom.app (X⟦n⟧) ≫
      ((cochain_complex.shift_homology_functor_iso C n k m h).hom.app X) ≫
      (homology_functor_factors C m).inv.app X :=
begin
  dsimp only [shift_homology_functor_iso],
  simp only [localization.lift_nat_iso_hom, localization.lift_nat_trans_app,
    shift_functor_comp_homology_lifting_iso_hom_app,
    lifting_iso_eq_homology_functor_factors, assoc],
end

variable (C)

@[simp, reassoc]
lemma shift_homology_functor_iso_hom_comp (n k m n' : ℤ) (h : k+n=m) (h' : m+n' = k) :
  whisker_left (shift_functor (derived_category C) n')
    (shift_homology_functor_iso C n k m h).hom ≫ (shift_homology_functor_iso C n' m k h').hom =
  (whisker_right ((shift_functor_add' (derived_category C) n' n 0
      (by rw [← add_right_inj m, ← add_assoc, h', h, add_zero])).inv ≫
      (shift_functor_zero (derived_category C) ℤ).hom) (homology_functor C k)) :=
localization.nat_trans_ext Q (quasi_isomorphisms C _) _ _ (λ K, begin
  dsimp only [whisker_left, whisker_right, nat_trans.comp_app,
    shift_homology_functor_iso, localization.lift_nat_iso],
  simp only [assoc, localization.lift_nat_trans_app,
    shift_functor_comp_homology_lifting_iso_hom_app,
    ← nat_trans.naturality_assoc, functor.comp_map],
  erw localization.lift_nat_trans_app,
  simp only [assoc, lifting_iso_eq_homology_functor_factors, iso.inv_hom_id_app_assoc],
  simp only [assoc, lifting_iso_eq_homology_functor_factors, iso.inv_hom_id_app_assoc,
    shift_functor_comp_homology_lifting_iso_hom_app,
    cochain_complex.shift_homology_functor_iso_hom_app_comp_assoc,
    (homology_functor_factors C k).inv.naturality, functor.comp_map,
    iso.hom_inv_id_app_assoc, ← functor.map_comp,
    Q.shift_functor_zero_hom_app_obj ℤ K],
  congr' 1,
  simp only [← cancel_epi ((shift_functor_add' (derived_category C)
    n' n 0 (by linarith)).hom.app (Q.obj K)), iso.hom_inv_id_app_assoc],
  rw Q.shift_functor_add'_hom_app_obj n' n 0 (by linarith) K,
  slice_lhs 4 5 { erw [← functor.map_comp, iso.hom_inv_id_app,
    category_theory.functor.map_id], },
  erw [id_comp, iso.hom_inv_id_app_assoc],
  rw [Q.map_comp, ← Q.map_comp_assoc, iso.hom_inv_id_app, Q.map_id, id_comp],
end)

lemma shift_homology_functor_iso_hom_app_comp (n k m n' : ℤ) (h : k+n=m) (h' : m+n' = k)
  (X : derived_category C) :
  (shift_homology_functor_iso C n k m h).hom.app (X⟦n'⟧) ≫ (shift_homology_functor_iso C n' m k h').hom.app X =
  (homology_functor C k).map ((shift_functor_add' (derived_category C) n' n 0 (by linarith)).inv.app X ≫
      (shift_functor_zero (derived_category C) ℤ).hom.app X) :=
congr_app (shift_homology_functor_iso_hom_comp C n k m n' h h') X

section

variables {C} {T : triangle (derived_category C)}

lemma homology_sequence.ex₂ (hT : T.distinguished) (n : ℤ) :
  (short_complex.mk ((homology_functor C n).map T.mor₁) ((homology_functor C n).map T.mor₂)
    (by simp only [← functor.map_comp, hT.comp_zero₁₂, functor.map_zero])).exact :=
functor.is_homological.map_distinguished (homology_functor C n) T hT

def homology_sequence.δ (hT : T.distinguished) (n₀ n₁ : ℤ) (h : n₁ = n₀+1) :
  (homology_functor C n₀).obj T.obj₃ ⟶ (homology_functor C n₁).obj T.obj₁ :=
(homology_functor C n₀).map T.mor₃ ≫
  (shift_homology_functor_iso C _ _ _ h.symm).hom.app T.obj₁

@[simp, reassoc]
lemma homology_sequence.δ_comp (hT : T.distinguished) (n₀ n₁ : ℤ) (h : n₁ = n₀+1) :
  homology_sequence.δ hT _ _ h ≫ (homology_functor C n₁).map T.mor₁ = 0 :=
begin
  dsimp only [homology_sequence.δ],
  simp only [assoc, ← nat_trans.naturality, functor.comp_map, ← functor.map_comp_assoc,
    hT.comp_zero₃₁, functor.map_zero, zero_comp],
end

@[simp, reassoc]
lemma homology_sequence.comp_δ (hT : T.distinguished) (n₀ n₁ : ℤ) (h : n₁ = n₀+1) :
  (homology_functor C n₀).map T.mor₂ ≫ homology_sequence.δ hT _ _ h = 0 :=
begin
  dsimp only [homology_sequence.δ],
  rw [← functor.map_comp_assoc, hT.comp_zero₂₃, functor.map_zero, zero_comp],
end

lemma homology_sequence.ex₃ (hT : T.distinguished) (n₀ n₁ : ℤ) (h : n₁ = n₀+1) :
  (short_complex.mk ((homology_functor C n₀).map T.mor₂) (homology_sequence.δ hT _ _ h)
    (by simp)).exact :=
begin
  refine (short_complex.exact_iff_of_iso _).1 (homology_sequence.ex₂ hT.rotate n₀),
  exact short_complex.mk_iso (iso.refl _) (iso.refl _)
    ((shift_homology_functor_iso C _ _ _ h.symm).app _)
    (by { dsimp, simp only [id_comp, comp_id], }) (id_comp _),
end

lemma homology_sequence.ex₁ (hT : T.distinguished) (n₀ n₁ : ℤ) (h : n₁ = n₀+1) :
  (short_complex.mk (homology_sequence.δ hT _ _ h) ((homology_functor C n₁).map T.mor₁)
    (by simp)).exact :=
begin
  refine (short_complex.exact_iff_of_iso _).1 (homology_sequence.ex₂ hT.inv_rotate n₁),
  refine short_complex.mk_iso (preadditive.mul_iso (-1) ((shift_homology_functor_iso C (-1) n₁ n₀ (by linarith)).app _))
    (iso.refl _) (iso.refl _) _ _,
  { dsimp only [triangle.inv_rotate, preadditive.mul_iso, iso.refl, triangle.mk, homology_sequence.δ],
    simp only [comp_id, functor.map_neg, units.coe_neg_one, neg_smul, one_smul,
      preadditive.neg_comp, neg_inj, iso.app_hom, ← nat_trans.naturality_assoc,
      functor.comp_map, functor.map_comp, shift_homology_functor_iso_hom_app_comp,
      shift_functor_comp_shift_functor_neg_eq_add'_comp_zero], },
  { dsimp, simp only [id_comp, comp_id], },
end

end

end derived_category


/-
Copyright (c) 2022 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.abelian.basic
import category_theory.preadditive.functor_category
import category_theory.limits.shapes.functor_category
import category_theory.limits.preserves.shapes.kernels

/-!
# If `D` is abelian, then the functor category `C ⥤ D` is also abelian.

-/

noncomputable theory

namespace category_theory
open category_theory.limits

namespace abelian

section
universes z w v u
variables {C : Type (max v u)} [category.{v} C]
variables {D : Type w} [category.{max z v u} D] [abelian D]

namespace functor_category
variables {F G : C ⥤ D} (α : F ⟶ G) (X : C)

/-- The abelian coimage in a functor category can be calculated componentwise. -/
@[simps]
def coimage_obj_iso : (abelian.coimage α).obj X ≅ abelian.coimage (α.app X) :=
preserves_cokernel.iso ((evaluation C D).obj X) _ ≪≫
  cokernel.map_iso _ _ (preserves_kernel.iso ((evaluation C D).obj X) _) (iso.refl _)
  begin
    dsimp,
    simp only [category.comp_id],
    exact (kernel_comparison_comp_ι _ ((evaluation C D).obj X)).symm,
  end

/-- The abelian image in a functor category can be calculated componentwise. -/
@[simps]
def image_obj_iso : (abelian.image α).obj X ≅ abelian.image (α.app X) :=
preserves_kernel.iso ((evaluation C D).obj X) _ ≪≫
  kernel.map_iso _ _ (iso.refl _) (preserves_cokernel.iso ((evaluation C D).obj X) _)
  begin
    apply (cancel_mono (preserves_cokernel.iso ((evaluation C D).obj X) α).inv).1,
    simp only [category.assoc, iso.hom_inv_id],
    dsimp,
    simp only [category.id_comp, category.comp_id],
    exact (π_comp_cokernel_comparison _ ((evaluation C D).obj X)).symm,
  end

lemma coimage_image_comparison_app :
  coimage_image_comparison (α.app X) =
    (coimage_obj_iso α X).inv ≫ (coimage_image_comparison α).app X ≫ (image_obj_iso α X).hom :=
begin
  ext,
  dsimp,
  simp only [category.comp_id, category.id_comp, category.assoc,
    coimage_image_factorisation, limits.cokernel.π_desc_assoc, limits.kernel.lift_ι],
  simp only [←evaluation_obj_map C D X],
  erw kernel_comparison_comp_ι _ ((evaluation C D).obj X),
  erw π_comp_cokernel_comparison_assoc _ ((evaluation C D).obj X),
  simp only [←functor.map_comp],
  simp only [coimage_image_factorisation, evaluation_obj_map],
end

lemma coimage_image_comparison_app' :
  (coimage_image_comparison α).app X =
    (coimage_obj_iso α X).hom ≫ coimage_image_comparison (α.app X) ≫ (image_obj_iso α X).inv :=
by simp only [coimage_image_comparison_app, iso.hom_inv_id_assoc, iso.hom_inv_id, category.assoc,
  category.comp_id]

instance functor_category_is_iso_coimage_image_comparison :
  is_iso (abelian.coimage_image_comparison α) :=
begin
  haveI : ∀ X : C, is_iso ((abelian.coimage_image_comparison α).app X),
  { intros, rw coimage_image_comparison_app', apply_instance, },
  apply nat_iso.is_iso_of_is_iso_app,
end

end functor_category

noncomputable instance functor_category_abelian : abelian (C ⥤ D) :=
abelian.of_coimage_image_comparison_is_iso

end

section

universes u
variables {C : Type u} [small_category C]
variables {D : Type (u+1)} [large_category D] [abelian D]

/-- A variant with specialized universes for a common case. -/
noncomputable instance functor_category_abelian' : abelian (C ⥤ D) :=
abelian.functor_category_abelian.{u u+1 u u}

end

end abelian

end category_theory


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.Lean3Lib.data.rbtree.default

universes u v

namespace Mathlib

namespace rbmap

/- Auxiliary instances -/

/- Helper lemmas for reusing rbtree results. -/

theorem eq_some_of_to_value_eq_some {α : Type u} {β : Type v} {e : Option (α × β)} {v : β} :
    to_value e = some v → ∃ (k : α), e = some (k, v) :=
  sorry

theorem eq_none_of_to_value_eq_none {α : Type u} {β : Type v} {e : Option (α × β)} :
    to_value e = none → e = none :=
  sorry

/- Lemmas -/

theorem not_mem_mk_rbmap {α : Type u} {β : Type v} {lt : α → α → Prop} (k : α) :
    ¬k ∈ mk_rbmap α β :=
  sorry

theorem not_mem_of_empty {α : Type u} {β : Type v} {lt : α → α → Prop} {m : rbmap α β} (k : α) :
    empty m = tt → ¬k ∈ m :=
  sorry

theorem not_mem_of_find_entry_none {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] {k : α} {m : rbmap α β} : find_entry m k = none → ¬k ∈ m :=
  sorry

theorem not_mem_of_find_none {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] {k : α} {m : rbmap α β} : find m k = none → ¬k ∈ m :=
  sorry

theorem mem_of_find_entry_some {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] {k₁ : α} {e : α × β} {m : rbmap α β} :
    find_entry m k₁ = some e → k₁ ∈ m :=
  sorry

theorem mem_of_find_some {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] {k : α} {v : β} {m : rbmap α β} : find m k = some v → k ∈ m :=
  sorry

theorem find_entry_eq_find_entry_of_eqv {α : Type u} {β : Type v} {lt : α → α → Prop}
    [DecidableRel lt] [is_strict_weak_order α lt] {m : rbmap α β} {k₁ : α} {k₂ : α} :
    strict_weak_order.equiv k₁ k₂ → find_entry m k₁ = find_entry m k₂ :=
  sorry

theorem find_eq_find_of_eqv {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] {k₁ : α} {k₂ : α} (m : rbmap α β) :
    strict_weak_order.equiv k₁ k₂ → find m k₁ = find m k₂ :=
  sorry

theorem find_entry_correct {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] (k : α) (m : rbmap α β) :
    k ∈ m ↔ ∃ (e : α × β), find_entry m k = some e ∧ strict_weak_order.equiv k (prod.fst e) :=
  sorry

theorem eqv_of_find_entry_some {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] {k₁ : α} {k₂ : α} {v : β} {m : rbmap α β} :
    find_entry m k₁ = some (k₂, v) → strict_weak_order.equiv k₁ k₂ :=
  sorry

theorem eq_of_find_entry_some {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_total_order α lt] {k₁ : α} {k₂ : α} {v : β} {m : rbmap α β} :
    find_entry m k₁ = some (k₂, v) → k₁ = k₂ :=
  fun (h : find_entry m k₁ = some (k₂, v)) =>
    (fun (this : strict_weak_order.equiv k₁ k₂) => eq_of_eqv_lt this) (eqv_of_find_entry_some h)

theorem find_correct {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] (k : α) (m : rbmap α β) : k ∈ m ↔ ∃ (v : β), find m k = some v :=
  sorry

theorem constains_correct {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] (k : α) (m : rbmap α β) : k ∈ m ↔ contains m k = tt :=
  sorry

theorem mem_of_mem_of_eqv {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] {m : rbmap α β} {k₁ : α} {k₂ : α} :
    k₁ ∈ m → strict_weak_order.equiv k₁ k₂ → k₂ ∈ m :=
  sorry

theorem mem_insert_of_incomp {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] {k₁ : α} {k₂ : α} (m : rbmap α β) (v : β) :
    ¬lt k₁ k₂ ∧ ¬lt k₂ k₁ → k₁ ∈ insert m k₂ v :=
  fun (h : ¬lt k₁ k₂ ∧ ¬lt k₂ k₁) =>
    to_rbmap_mem (rbtree.mem_insert_of_incomp m (eqv_entries_of_eqv_keys v v h))

theorem mem_insert {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] (k : α) (m : rbmap α β) (v : β) : k ∈ insert m k v :=
  to_rbmap_mem (rbtree.mem_insert (k, v) m)

theorem mem_insert_of_equiv {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] {k₁ : α} {k₂ : α} (m : rbmap α β) (v : β) :
    strict_weak_order.equiv k₁ k₂ → k₁ ∈ insert m k₂ v :=
  mem_insert_of_incomp m v

theorem mem_insert_of_mem {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] {k₁ : α} {m : rbmap α β} (k₂ : α) (v : β) :
    k₁ ∈ m → k₁ ∈ insert m k₂ v :=
  fun (h : k₁ ∈ m) => to_rbmap_mem (rbtree.mem_insert_of_mem (k₂, v) (to_rbtree_mem' v h))

theorem equiv_or_mem_of_mem_insert {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] {k₁ : α} {k₂ : α} {v : β} {m : rbmap α β} :
    k₁ ∈ insert m k₂ v → strict_weak_order.equiv k₁ k₂ ∨ k₁ ∈ m :=
  sorry

theorem incomp_or_mem_of_mem_ins {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] {k₁ : α} {k₂ : α} {v : β} {m : rbmap α β} :
    k₁ ∈ insert m k₂ v → ¬lt k₁ k₂ ∧ ¬lt k₂ k₁ ∨ k₁ ∈ m :=
  equiv_or_mem_of_mem_insert

theorem eq_or_mem_of_mem_ins {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_total_order α lt] {k₁ : α} {k₂ : α} {v : β} {m : rbmap α β} :
    k₁ ∈ insert m k₂ v → k₁ = k₂ ∨ k₁ ∈ m :=
  sorry

theorem find_entry_insert_of_eqv {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] (m : rbmap α β) {k₁ : α} {k₂ : α} (v : β) :
    strict_weak_order.equiv k₁ k₂ → find_entry (insert m k₁ v) k₂ = some (k₁, v) :=
  sorry

theorem find_entry_insert {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] (m : rbmap α β) (k : α) (v : β) :
    find_entry (insert m k v) k = some (k, v) :=
  find_entry_insert_of_eqv m v (refl k)

theorem find_insert_of_eqv {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] (m : rbmap α β) {k₁ : α} {k₂ : α} (v : β) :
    strict_weak_order.equiv k₁ k₂ → find (insert m k₁ v) k₂ = some v :=
  sorry

theorem find_insert {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] (m : rbmap α β) (k : α) (v : β) : find (insert m k v) k = some v :=
  find_insert_of_eqv m v (refl k)

theorem find_entry_insert_of_disj {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] {k₁ : α} {k₂ : α} (m : rbmap α β) (v : β) :
    lt k₁ k₂ ∨ lt k₂ k₁ → find_entry (insert m k₁ v) k₂ = find_entry m k₂ :=
  sorry

theorem find_entry_insert_of_not_eqv {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] {k₁ : α} {k₂ : α} (m : rbmap α β) (v : β) :
    ¬strict_weak_order.equiv k₁ k₂ → find_entry (insert m k₁ v) k₂ = find_entry m k₂ :=
  sorry

theorem find_entry_insert_of_ne {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_total_order α lt] {k₁ : α} {k₂ : α} (m : rbmap α β) (v : β) :
    k₁ ≠ k₂ → find_entry (insert m k₁ v) k₂ = find_entry m k₂ :=
  fun (h : k₁ ≠ k₂) =>
    find_entry_insert_of_not_eqv m v fun (h' : strict_weak_order.equiv k₁ k₂) => h (eq_of_eqv_lt h')

theorem find_insert_of_disj {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] {k₁ : α} {k₂ : α} (m : rbmap α β) (v : β) :
    lt k₁ k₂ ∨ lt k₂ k₁ → find (insert m k₁ v) k₂ = find m k₂ :=
  sorry

theorem find_insert_of_not_eqv {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] {k₁ : α} {k₂ : α} (m : rbmap α β) (v : β) :
    ¬strict_weak_order.equiv k₁ k₂ → find (insert m k₁ v) k₂ = find m k₂ :=
  sorry

theorem find_insert_of_ne {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_total_order α lt] {k₁ : α} {k₂ : α} (m : rbmap α β) (v : β) :
    k₁ ≠ k₂ → find (insert m k₁ v) k₂ = find m k₂ :=
  sorry

theorem mem_of_min_eq {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_total_order α lt] {k : α} {v : β} {m : rbmap α β} : min m = some (k, v) → k ∈ m :=
  fun (h : min m = some (k, v)) => to_rbmap_mem (rbtree.mem_of_min_eq h)

theorem mem_of_max_eq {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_total_order α lt] {k : α} {v : β} {m : rbmap α β} : max m = some (k, v) → k ∈ m :=
  fun (h : max m = some (k, v)) => to_rbmap_mem (rbtree.mem_of_max_eq h)

theorem eq_leaf_of_min_eq_none {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] {m : rbmap α β} : min m = none → m = mk_rbmap α β :=
  rbtree.eq_leaf_of_min_eq_none

theorem eq_leaf_of_max_eq_none {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] {m : rbmap α β} : max m = none → m = mk_rbmap α β :=
  rbtree.eq_leaf_of_max_eq_none

theorem min_is_minimal {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] {k : α} {v : β} {m : rbmap α β} :
    min m = some (k, v) → ∀ {k' : α}, k' ∈ m → strict_weak_order.equiv k k' ∨ lt k k' :=
  sorry

theorem max_is_maximal {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_weak_order α lt] {k : α} {v : β} {m : rbmap α β} :
    max m = some (k, v) → ∀ {k' : α}, k' ∈ m → strict_weak_order.equiv k k' ∨ lt k' k :=
  sorry

theorem min_is_minimal_of_total {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_total_order α lt] {k : α} {v : β} {m : rbmap α β} :
    min m = some (k, v) → ∀ {k' : α}, k' ∈ m → k = k' ∨ lt k k' :=
  sorry

theorem max_is_maximal_of_total {α : Type u} {β : Type v} {lt : α → α → Prop} [DecidableRel lt]
    [is_strict_total_order α lt] {k : α} {v : β} {m : rbmap α β} :
    max m = some (k, v) → ∀ {k' : α}, k' ∈ m → k = k' ∨ lt k' k :=
  sorry

end Mathlib


example (p q r : Prop) (hp : p) : q ∨ p ∨ r :=
  by repeat (first |apply Or.inl; assumption | apply Or.inr | assumption)
 example (p q r : Prop) (hp : p)
         : (p ∨ q ∨ r) ∧ (q ∨ p ∨ r) ∧ (q ∨ r ∨ p) := by
  repeat(any_goals (first | apply And.intro | apply Or.inl; assumption | apply Or.inr | assumption))

variable (x y : Nat)

def double := x + x
#eval Lean.versionString

#check double y
#check Nat.succ_ne_zero


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

universes v u l

namespace Mathlib

/-!
# Presheafed spaces

Introduces the category of topological spaces equipped with a presheaf (taking values in an
arbitrary target category `C`.)

We further describe how to apply functors and natural transformations to the values of the
presheaves.
-/

namespace algebraic_geometry

/-- A `PresheafedSpace C` is a topological space equipped with a presheaf of `C`s. -/
structure PresheafedSpace (C : Type u) [category_theory.category C] where
  carrier : Top
  presheaf : Top.presheaf C carrier

namespace PresheafedSpace

protected instance coe_carrier {C : Type u} [category_theory.category C] :
    has_coe (PresheafedSpace C) Top :=
  has_coe.mk fun (X : PresheafedSpace C) => carrier X

@[simp] theorem as_coe {C : Type u} [category_theory.category C] (X : PresheafedSpace C) :
    carrier X = ↑X :=
  rfl

@[simp] theorem mk_coe {C : Type u} [category_theory.category C] (carrier : Top)
    (presheaf : Top.presheaf C carrier) : ↑(mk carrier presheaf) = carrier :=
  rfl

protected instance topological_space {C : Type u} [category_theory.category C]
    (X : PresheafedSpace C) : topological_space ↥X :=
  category_theory.bundled.str (carrier X)

/-- The constant presheaf on `X` with value `Z`. -/
def const {C : Type u} [category_theory.category C] (X : Top) (Z : C) : PresheafedSpace C :=
  mk X
    (category_theory.functor.mk (fun (U : topological_space.opens ↥Xᵒᵖ) => Z)
      fun (U V : topological_space.opens ↥Xᵒᵖ) (f : U ⟶ V) => 𝟙)

protected instance inhabited {C : Type u} [category_theory.category C] [Inhabited C] :
    Inhabited (PresheafedSpace C) :=
  { default := const (Top.of pempty) Inhabited.default }

/-- A morphism between presheafed spaces `X` and `Y` consists of a continuous map
    `f` between the underlying topological spaces, and a (notice contravariant!) map
    from the presheaf on `Y` to the pushforward of the presheaf on `X` via `f`. -/
structure hom {C : Type u} [category_theory.category C] (X : PresheafedSpace C)
    (Y : PresheafedSpace C)
    where
  base : ↑X ⟶ ↑Y
  c : PresheafedSpace.presheaf Y ⟶ base _* PresheafedSpace.presheaf X

theorem ext {C : Type u} [category_theory.category C] {X : PresheafedSpace C}
    {Y : PresheafedSpace C} (α : hom X Y) (β : hom X Y) (w : hom.base α = hom.base β)
    (h :
      hom.c α ≫
          category_theory.whisker_right
            (category_theory.nat_trans.op
              (category_theory.iso.inv
                (topological_space.opens.map_iso (hom.base α) (hom.base β) w)))
            (PresheafedSpace.presheaf X) =
        hom.c β) :
    α = β :=
  sorry

/-- The identity morphism of a `PresheafedSpace`. -/
def id {C : Type u} [category_theory.category C] (X : PresheafedSpace C) : hom X X :=
  hom.mk 𝟙
    (category_theory.iso.inv (category_theory.functor.left_unitor (PresheafedSpace.presheaf X)) ≫
      category_theory.whisker_right
        (category_theory.nat_trans.op
          (category_theory.iso.hom (topological_space.opens.map_id (carrier X))))
        (PresheafedSpace.presheaf X))

protected instance hom_inhabited {C : Type u} [category_theory.category C] (X : PresheafedSpace C) :
    Inhabited (hom X X) :=
  { default := id X }

/-- Composition of morphisms of `PresheafedSpace`s. -/
def comp {C : Type u} [category_theory.category C] {X : PresheafedSpace C} {Y : PresheafedSpace C}
    {Z : PresheafedSpace C} (α : hom X Y) (β : hom Y Z) : hom X Z :=
  hom.mk (hom.base α ≫ hom.base β)
    (hom.c β ≫
      category_theory.whisker_left
          (category_theory.functor.op (topological_space.opens.map (hom.base β))) (hom.c α) ≫
        category_theory.iso.inv
          (Top.presheaf.pushforward.comp (PresheafedSpace.presheaf X) (hom.base α) (hom.base β)))

/- The proofs below can be done by `tidy`, but it is too slow,
   and we don't have a tactic caching mechanism. -/

/-- The category of PresheafedSpaces. Morphisms are pairs, a continuous map and a presheaf map
    from the presheaf on the target to the pushforward of the presheaf on the source. -/
protected instance category_of_PresheafedSpaces (C : Type u) [category_theory.category C] :
    category_theory.category (PresheafedSpace C) :=
  category_theory.category.mk

@[simp] theorem id_base {C : Type u} [category_theory.category C] (X : PresheafedSpace C) :
    hom.base 𝟙 = 𝟙 :=
  rfl

theorem id_c {C : Type u} [category_theory.category C] (X : PresheafedSpace C) :
    hom.c 𝟙 =
        category_theory.iso.inv (category_theory.functor.left_unitor (PresheafedSpace.presheaf X)) ≫
          category_theory.whisker_right
            (category_theory.nat_trans.op
              (category_theory.iso.hom (topological_space.opens.map_id (carrier X))))
            (PresheafedSpace.presheaf X) :=
  rfl

@[simp] theorem id_c_app {C : Type u} [category_theory.category C] (X : PresheafedSpace C)
    (U : topological_space.opens ↥(carrier X)ᵒᵖ) :
    category_theory.nat_trans.app (hom.c 𝟙) U =
        category_theory.eq_to_hom
          (opposite.op_induction
            (fun (U : topological_space.opens ↥(carrier X)) =>
              subtype.cases_on U
                fun (U_val : set ↥(carrier X)) (U_property : is_open U_val) =>
                  Eq.refl
                    (category_theory.functor.obj (PresheafedSpace.presheaf X)
                      (opposite.op { val := U_val, property := U_property })))
            U) :=
  sorry

@[simp] theorem comp_base {C : Type u} [category_theory.category C] {X : PresheafedSpace C}
    {Y : PresheafedSpace C} {Z : PresheafedSpace C} (f : X ⟶ Y) (g : Y ⟶ Z) :
    hom.base (f ≫ g) = hom.base f ≫ hom.base g :=
  rfl

@[simp] theorem comp_c_app {C : Type u} [category_theory.category C] {X : PresheafedSpace C}
    {Y : PresheafedSpace C} {Z : PresheafedSpace C} (α : X ⟶ Y) (β : Y ⟶ Z)
    (U : topological_space.opens ↥(carrier Z)ᵒᵖ) :
    category_theory.nat_trans.app (hom.c (α ≫ β)) U =
        category_theory.nat_trans.app (hom.c β) U ≫
          category_theory.nat_trans.app (hom.c α)
              (opposite.op
                (category_theory.functor.obj (topological_space.opens.map (hom.base β))
                  (opposite.unop U))) ≫
            category_theory.nat_trans.app
              (category_theory.iso.inv
                (Top.presheaf.pushforward.comp (PresheafedSpace.presheaf X) (hom.base α)
                  (hom.base β)))
              U :=
  rfl

theorem congr_app {C : Type u} [category_theory.category C] {X : PresheafedSpace C}
    {Y : PresheafedSpace C} {α : X ⟶ Y} {β : X ⟶ Y} (h : α = β)
    (U : topological_space.opens ↥(carrier Y)ᵒᵖ) :
    category_theory.nat_trans.app (hom.c α) U =
        category_theory.nat_trans.app (hom.c β) U ≫
          category_theory.functor.map (PresheafedSpace.presheaf X)
            (category_theory.eq_to_hom
              (Eq._oldrec
                (Eq.refl
                  (category_theory.functor.obj
                    (category_theory.functor.op (topological_space.opens.map (hom.base α))) U))
                h)) :=
  sorry

/-- The forgetful functor from `PresheafedSpace` to `Top`. -/
def forget (C : Type u) [category_theory.category C] : PresheafedSpace C ⥤ Top :=
  category_theory.functor.mk (fun (X : PresheafedSpace C) => ↑X)
    fun (X Y : PresheafedSpace C) (f : X ⟶ Y) => hom.base f

/--
The restriction of a presheafed space along an open embedding into the space.
-/
@[simp] theorem restrict_carrier {C : Type u} [category_theory.category C] {U : Top}
    (X : PresheafedSpace C) (f : U ⟶ ↑X) (h : open_embedding ⇑f) : carrier (restrict X f h) = U :=
  Eq.refl (carrier (restrict X f h))

/--
The map from the restriction of a presheafed space.
-/
@[simp] theorem of_restrict_c_app {C : Type u} [category_theory.category C] (U : Top)
    (X : PresheafedSpace C) (f : U ⟶ ↑X) (h : open_embedding ⇑f)
    (V : topological_space.opens ↥(carrier X)ᵒᵖ) :
    category_theory.nat_trans.app (hom.c (of_restrict U X f h)) V =
        category_theory.functor.map (PresheafedSpace.presheaf X)
          (category_theory.has_hom.hom.op
            (coe_fn
              (equiv.symm
                (category_theory.adjunction.hom_equiv
                  (is_open_map.adjunction (of_restrict._proof_2 U X f h))
                  (category_theory.functor.obj (topological_space.opens.map f) (opposite.unop V))
                  (opposite.unop V)))
              𝟙)) :=
  Eq.refl (category_theory.nat_trans.app (hom.c (of_restrict U X f h)) V)

/--
The map to the restriction of a presheafed space along the canonical inclusion from the top
subspace.
-/
@[simp] theorem to_restrict_top_base_to_fun_coe {C : Type u} [category_theory.category C]
    (X : PresheafedSpace C) (x : ↥↑X) : ↑(coe_fn (hom.base (to_restrict_top X)) x) = x :=
  Eq.refl ↑(coe_fn (hom.base (to_restrict_top X)) x)

/--
The isomorphism from the restriction to the top subspace.
-/
def restrict_top_iso {C : Type u} [category_theory.category C] (X : PresheafedSpace C) :
    restrict X (topological_space.opens.inclusion ⊤) (restrict_top_iso._proof_1 X) ≅ X :=
  category_theory.iso.mk
    (of_restrict (category_theory.functor.obj (topological_space.opens.to_Top ↑X) ⊤) X
      (topological_space.opens.inclusion ⊤) sorry)
    (to_restrict_top X)

/--
The global sections, notated Gamma.
-/
@[simp] theorem Γ_obj {C : Type u} [category_theory.category C] (X : PresheafedSpace Cᵒᵖ) :
    category_theory.functor.obj Γ X =
        category_theory.functor.obj (PresheafedSpace.presheaf (opposite.unop X)) (opposite.op ⊤) :=
  Eq.refl (category_theory.functor.obj Γ X)

theorem Γ_obj_op {C : Type u} [category_theory.category C] (X : PresheafedSpace C) :
    category_theory.functor.obj Γ (opposite.op X) =
        category_theory.functor.obj (PresheafedSpace.presheaf X) (opposite.op ⊤) :=
  rfl

theorem Γ_map_op {C : Type u} [category_theory.category C] {X : PresheafedSpace C}
    {Y : PresheafedSpace C} (f : X ⟶ Y) :
    category_theory.functor.map Γ (category_theory.has_hom.hom.op f) =
        category_theory.nat_trans.app (hom.c f) (opposite.op ⊤) ≫
          category_theory.functor.map (PresheafedSpace.presheaf X)
            (category_theory.has_hom.hom.op (topological_space.opens.le_map_top (hom.base f) ⊤)) :=
  rfl

end PresheafedSpace

end algebraic_geometry

namespace category_theory

namespace functor

/-- We can apply a functor `F : C ⥤ D` to the values of the presheaf in any `PresheafedSpace C`,
    giving a functor `PresheafedSpace C ⥤ PresheafedSpace D` -/
def map_presheaf {C : Type u} [category C] {D : Type u} [category D] (F : C ⥤ D) :
    algebraic_geometry.PresheafedSpace C ⥤ algebraic_geometry.PresheafedSpace D :=
  mk
    (fun (X : algebraic_geometry.PresheafedSpace C) =>
      algebraic_geometry.PresheafedSpace.mk (algebraic_geometry.PresheafedSpace.carrier X)
        (algebraic_geometry.PresheafedSpace.presheaf X ⋙ F))
    fun (X Y : algebraic_geometry.PresheafedSpace C) (f : X ⟶ Y) =>
      algebraic_geometry.PresheafedSpace.hom.mk (algebraic_geometry.PresheafedSpace.hom.base f)
        (whisker_right (algebraic_geometry.PresheafedSpace.hom.c f) F)

@[simp] theorem map_presheaf_obj_X {C : Type u} [category C] {D : Type u} [category D] (F : C ⥤ D)
    (X : algebraic_geometry.PresheafedSpace C) : ↑(obj (map_presheaf F) X) = ↑X :=
  rfl

@[simp] theorem map_presheaf_obj_presheaf {C : Type u} [category C] {D : Type u} [category D]
    (F : C ⥤ D) (X : algebraic_geometry.PresheafedSpace C) :
    algebraic_geometry.PresheafedSpace.presheaf (obj (map_presheaf F) X) =
        algebraic_geometry.PresheafedSpace.presheaf X ⋙ F :=
  rfl

@[simp] theorem map_presheaf_map_f {C : Type u} [category C] {D : Type u} [category D] (F : C ⥤ D)
    {X : algebraic_geometry.PresheafedSpace C} {Y : algebraic_geometry.PresheafedSpace C}
    (f : X ⟶ Y) :
    algebraic_geometry.PresheafedSpace.hom.base (map (map_presheaf F) f) =
        algebraic_geometry.PresheafedSpace.hom.base f :=
  rfl

@[simp] theorem map_presheaf_map_c {C : Type u} [category C] {D : Type u} [category D] (F : C ⥤ D)
    {X : algebraic_geometry.PresheafedSpace C} {Y : algebraic_geometry.PresheafedSpace C}
    (f : X ⟶ Y) :
    algebraic_geometry.PresheafedSpace.hom.c (map (map_presheaf F) f) =
        whisker_right (algebraic_geometry.PresheafedSpace.hom.c f) F :=
  rfl

end functor

namespace nat_trans

/--
A natural transformation induces a natural transformation between the `map_presheaf` functors.
-/
def on_presheaf {C : Type u} [category C] {D : Type u} [category D] {F : C ⥤ D} {G : C ⥤ D}
    (α : F ⟶ G) : functor.map_presheaf G ⟶ functor.map_presheaf F :=
  mk
    fun (X : algebraic_geometry.PresheafedSpace C) =>
      algebraic_geometry.PresheafedSpace.hom.mk 𝟙
        (whisker_left (algebraic_geometry.PresheafedSpace.presheaf X) α ≫
          iso.inv (functor.left_unitor (algebraic_geometry.PresheafedSpace.presheaf X ⋙ G)) ≫
            whisker_right
              (nat_trans.op
                (iso.hom
                  (topological_space.opens.map_id (algebraic_geometry.PresheafedSpace.carrier X))))
              (algebraic_geometry.PresheafedSpace.presheaf X ⋙ G))

end Mathlib


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.group.pi
import algebra.category.Group.preadditive
import category_theory.preadditive.biproducts
import algebra.category.Group.limits

/-!
# The category of abelian groups has finite biproducts
-/

open category_theory
open category_theory.limits

open_locale big_operators

universes w u

namespace AddCommGroup

-- As `AddCommGroup` is preadditive, and has all limits, it automatically has biproducts.
instance : has_binary_biproducts AddCommGroup :=
has_binary_biproducts.of_has_binary_products

instance : has_finite_biproducts AddCommGroup :=
has_finite_biproducts.of_has_finite_products

-- We now construct explicit limit data,
-- so we can compare the biproducts to the usual unbundled constructions.

/--
Construct limit data for a binary product in `AddCommGroup`, using `AddCommGroup.of (G × H)`.
-/
@[simps cone_X is_limit_lift]
def binary_product_limit_cone (G H : AddCommGroup.{u}) : limits.limit_cone (pair G H) :=
{ cone :=
  { X := AddCommGroup.of (G × H),
    π := { app := λ j, discrete.cases_on j
      (λ j, walking_pair.cases_on j (add_monoid_hom.fst G H) (add_monoid_hom.snd G H)),
      naturality' := by rintros ⟨⟨⟩⟩ ⟨⟨⟩⟩ ⟨⟨⟨⟩⟩⟩; refl, }},
  is_limit :=
  { lift := λ s, add_monoid_hom.prod (s.π.app ⟨walking_pair.left⟩) (s.π.app ⟨walking_pair.right⟩),
    fac' := by { rintros s (⟨⟩|⟨⟩); { ext x, simp, } },
    uniq' := λ s m w, begin
      ext; [rw ← w ⟨walking_pair.left⟩, rw ← w ⟨walking_pair.right⟩]; refl,
    end, } }

@[simp] lemma binary_product_limit_cone_cone_π_app_left (G H : AddCommGroup.{u}) :
  (binary_product_limit_cone G H).cone.π.app ⟨walking_pair.left⟩ = add_monoid_hom.fst G H := rfl

@[simp] lemma binary_product_limit_cone_cone_π_app_right (G H : AddCommGroup.{u}) :
  (binary_product_limit_cone G H).cone.π.app ⟨walking_pair.right⟩ = add_monoid_hom.snd G H := rfl

/--
We verify that the biproduct in AddCommGroup is isomorphic to
the cartesian product of the underlying types:
-/
@[simps hom_apply] noncomputable
def biprod_iso_prod (G H : AddCommGroup.{u}) : (G ⊞ H : AddCommGroup) ≅ AddCommGroup.of (G × H) :=
is_limit.cone_point_unique_up_to_iso
  (binary_biproduct.is_limit G H)
  (binary_product_limit_cone G H).is_limit

@[simp, elementwise] lemma biprod_iso_prod_inv_comp_fst (G H : AddCommGroup.{u}) :
  (biprod_iso_prod G H).inv ≫ biprod.fst = add_monoid_hom.fst G H :=
is_limit.cone_point_unique_up_to_iso_inv_comp _ _ (discrete.mk walking_pair.left)

@[simp, elementwise] lemma biprod_iso_prod_inv_comp_snd (G H : AddCommGroup.{u}) :
  (biprod_iso_prod G H).inv ≫ biprod.snd = add_monoid_hom.snd G H :=
is_limit.cone_point_unique_up_to_iso_inv_comp _ _ (discrete.mk walking_pair.right)

namespace has_limit
variables {J : Type w} (f : J → AddCommGroup.{max w u})

/--
The map from an arbitrary cone over a indexed family of abelian groups
to the cartesian product of those groups.
-/
@[simps]
def lift (s : fan f) :
  s.X ⟶ AddCommGroup.of (Π j,f j) :=
{ to_fun := λ x j, s.π.app ⟨j⟩ x,
  map_zero' := by { ext, simp },
  map_add' := λ x y, by { ext, simp }, }

/--
Construct limit data for a product in `AddCommGroup`, using `AddCommGroup.of (Π j, F.obj j)`.
-/
@[simps] def product_limit_cone : limits.limit_cone (discrete.functor f) :=
{ cone :=
  { X := AddCommGroup.of (Π j, f j),
    π := discrete.nat_trans (λ j, pi.eval_add_monoid_hom (λ j, f j) j.as), },
  is_limit :=
  { lift := lift f,
    fac' := λ s j, by { cases j, ext, simp, },
    uniq' := λ s m w,
    begin
      ext x j,
      dsimp only [has_limit.lift],
      simp only [add_monoid_hom.coe_mk],
      exact congr_arg (λ g : s.X ⟶ f j, (g : s.X → f j) x) (w ⟨j⟩),
    end, }, }

end has_limit

open has_limit

variables {J : Type} [fintype J]

/--
We verify that the biproduct we've just defined is isomorphic to the AddCommGroup structure
on the dependent function type
-/
@[simps hom_apply] noncomputable
def biproduct_iso_pi (f : J → AddCommGroup.{u}) :
  (⨁ f : AddCommGroup) ≅ AddCommGroup.of (Π j, f j) :=
is_limit.cone_point_unique_up_to_iso
  (biproduct.is_limit f)
  (product_limit_cone f).is_limit

@[simp, elementwise] lemma biproduct_iso_pi_inv_comp_π (f : J → AddCommGroup.{u}) (j : J) :
  (biproduct_iso_pi f).inv ≫ biproduct.π f j = pi.eval_add_monoid_hom (λ j, f j) j :=
is_limit.cone_point_unique_up_to_iso_inv_comp _ _ (discrete.mk j)

end AddCommGroup


import Lean
open Lean Meta

/- ## `MetaM`: Solutions -/

/- ### 1. -/

#eval show MetaM Unit from do
  let hi ← Lean.Meta.mkFreshExprMVar (Expr.const `Nat []) (userName := `hi)
  IO.println s!"value in hi: {← instantiateMVars hi}" -- ?_uniq.1

  hi.mvarId!.assign (Expr.app (Expr.const `Nat.succ []) (Expr.const ``Nat.zero []))
  IO.println s!"value in hi: {← instantiateMVars hi}" -- Nat.succ Nat.zero

/- ### 2. -/

-- It would output the same expression we gave it - there were no metavariables to instantiate.
#eval show MetaM Unit from do
  let instantiatedExpr ← instantiateMVars (Expr.lam `x (Expr.const `Nat []) (Expr.bvar 0) BinderInfo.default)
  IO.println instantiatedExpr -- fun (x : Nat) => x

/- ### 3. -/

#eval show MetaM Unit from do
  let oneExpr := Expr.app (Expr.const `Nat.succ []) (Expr.const ``Nat.zero [])
  let twoExpr := Expr.app (Expr.const `Nat.succ []) oneExpr

  -- Create `mvar1` with type `Nat`
  let mvar1 ← Lean.Meta.mkFreshExprMVar (Expr.const `Nat []) (userName := `mvar1)
  -- Create `mvar2` with type `Nat`
  let mvar2 ← Lean.Meta.mkFreshExprMVar (Expr.const `Nat []) (userName := `mvar2)
  -- Create `mvar3` with type `Nat`
  let mvar3 ← Lean.Meta.mkFreshExprMVar (Expr.const `Nat []) (userName := `mvar3)

  -- Assign `mvar1` to `2 + ?mvar2 + ?mvar3`
  mvar1.mvarId!.assign (Lean.mkAppN (Expr.const `Nat.add []) #[(Lean.mkAppN (Expr.const `Nat.add []) #[twoExpr, mvar2]), mvar3])

  -- Assign `mvar3` to `1`
  mvar3.mvarId!.assign oneExpr

  -- Instantiate `mvar1`, which should result in expression `2 + ?mvar2 + 1`
  let instantiatedMvar1 ← instantiateMVars mvar1
  IO.println instantiatedMvar1 -- Nat.add (Nat.add 2 ?_uniq.2) 1

/- ### 4. -/

elab "explore" : tactic => do
  let mvarId : MVarId ← Lean.Elab.Tactic.getMainGoal
  let metavarDecl : MetavarDecl ← mvarId.getDecl

  IO.println "Our metavariable"
  -- [anonymous] : 2 = 2
  IO.println s!"\n{metavarDecl.userName} : {metavarDecl.type}"

  IO.println "\nAll of its local declarations"
  let localContext : LocalContext := metavarDecl.lctx
  for (localDecl : LocalDecl) in localContext do
    if localDecl.isImplementationDetail then
      -- (implementation detail) red : 1 = 1 → 2 = 2 → 2 = 2
      IO.println s!"\n(implementation detail) {localDecl.userName} : {localDecl.type}"
    else
      -- hA : 1 = 1
      -- hB : 2 = 2
      IO.println s!"\n{localDecl.userName} : {localDecl.type}"

theorem red (hA : 1 = 1) (hB : 2 = 2) : 2 = 2 := by
  explore
  sorry

/- ### 5. -/

-- The type of our metavariable `2 + 2`. We want to find a `localDecl` that has the same type, and `assign` our metavariable to that `localDecl`.
elab "solve" : tactic => do
  let mvarId : MVarId ← Lean.Elab.Tactic.getMainGoal
  let metavarDecl : MetavarDecl ← mvarId.getDecl

  let localContext : LocalContext := metavarDecl.lctx
  for (localDecl : LocalDecl) in localContext do
    if ← Lean.Meta.isDefEq localDecl.type metavarDecl.type then
      mvarId.assign localDecl.toExpr

theorem redSolved (hA : 1 = 1) (hB : 2 = 2) : 2 = 2 := by
  solve

/- ### 6. -/

def sixA : Bool → Bool := fun x => x
-- .lam `x (.const `Bool []) (.bvar 0) (Lean.BinderInfo.default)
#eval Lean.Meta.reduce (Expr.const `sixA [])

def sixB : Bool := (fun x => x) ((true && false) || true)
-- .const `Bool.true []
#eval Lean.Meta.reduce (Expr.const `sixB [])

def sixC : Nat := 800 + 2
-- .lit (Lean.Literal.natVal 802)
#eval Lean.Meta.reduce (Expr.const `sixC [])

/- ### 7. -/

#eval show MetaM Unit from do
  let litExpr := Expr.lit (Lean.Literal.natVal 1)
  let standardExpr := Expr.app (Expr.const ``Nat.succ []) (Expr.const ``Nat.zero [])

  let isEqual ← Lean.Meta.isDefEq litExpr standardExpr
  IO.println isEqual -- true

/- ### 8. -/

-- a) `5 =?= (fun x => 5) ((fun y : Nat → Nat => y) (fun z : Nat => z))`
-- Definitionally equal.
def expr2 := (fun x => 5) ((fun y : Nat → Nat => y) (fun z : Nat => z))
#eval show MetaM Unit from do
  let expr1 := Lean.mkNatLit 5
  let expr2 := Expr.const `expr2 []
  let isEqual ← Lean.Meta.isDefEq expr1 expr2
  IO.println isEqual -- true

-- b) `2 + 1 =?= 1 + 2`
-- Definitionally equal.
#eval show MetaM Unit from do
  let expr1 := Lean.mkAppN (Expr.const `Nat.add []) #[Lean.mkNatLit 2, Lean.mkNatLit 1]
  let expr2 := Lean.mkAppN (Expr.const `Nat.add []) #[Lean.mkNatLit 1, Lean.mkNatLit 2]
  let isEqual ← Lean.Meta.isDefEq expr1 expr2
  IO.println isEqual -- true

-- c) `?a =?= 2`, where `?a` has a type `String`
-- Not definitionally equal.
#eval show MetaM Unit from do
  let expr1 ← Lean.Meta.mkFreshExprMVar (Expr.const `String []) (userName := `expr1)
  let expr2 := Lean.mkNatLit 2
  let isEqual ← Lean.Meta.isDefEq expr1 expr2
  IO.println isEqual -- false

-- d) `?a + Int =?= "hi" + ?b`, where `?a` and `?b` don't have a type
-- Definitionally equal.
-- `?a` is assigned to `"hi"`, `?b` is assigned to `Int`.
#eval show MetaM Unit from do
  let a ← Lean.Meta.mkFreshExprMVar Option.none (userName := `a)
  let b ← Lean.Meta.mkFreshExprMVar Option.none (userName := `b)
  let expr1 := Lean.mkAppN (Expr.const `Nat.add []) #[a, Expr.const `Int []]
  let expr2 := Lean.mkAppN (Expr.const `Nat.add []) #[Lean.mkStrLit "hi", b]
  let isEqual ← Lean.Meta.isDefEq expr1 expr2
  IO.println isEqual -- true

  IO.println s!"a: {← instantiateMVars a}"
  IO.println s!"b: {← instantiateMVars b}"

-- e) `2 + ?a =?= 3`
-- Not definitionally equal.
#eval show MetaM Unit from do
  let a ← Lean.Meta.mkFreshExprMVar (Expr.const `Nat []) (userName := `a)
  let expr1 := Lean.mkAppN (Expr.const `Nat.add []) #[Lean.mkNatLit 2, a]
  let expr2 := Lean.mkNatLit 3
  let isEqual ← Lean.Meta.isDefEq expr1 expr2
  IO.println isEqual -- false

-- f) `2 + ?a =?= 2 + 1`
-- Definitionally equal.
-- `?a` is assigned to `1`.
#eval show MetaM Unit from do
  let a ← Lean.Meta.mkFreshExprMVar (Expr.const `Nat []) (userName := `a)
  let expr1 := Lean.mkAppN (Expr.const `Nat.add []) #[Lean.mkNatLit 2, a]
  let expr2 := Lean.mkAppN (Expr.const `Nat.add []) #[Lean.mkNatLit 2, Lean.mkNatLit 1]
  let isEqual ← Lean.Meta.isDefEq expr1 expr2
  IO.println isEqual -- true

  IO.println s!"a: {← instantiateMVars a}"

/- ### 9. -/
@[reducible] def reducibleDef     : Nat := 1 -- same as `abbrev`
@[instance] def instanceDef       : Nat := 2 -- same as `instance`
def defaultDef                    : Nat := 3
@[irreducible] def irreducibleDef : Nat := 4

@[reducible] def sum := [reducibleDef, instanceDef, defaultDef, irreducibleDef]

#eval show MetaM Unit from do
  let constantExpr := Expr.const `sum []

  Meta.withTransparency Meta.TransparencyMode.reducible do
    let reducedExpr ← Meta.reduce constantExpr
    dbg_trace (← ppExpr reducedExpr) -- [1, instanceDef, defaultDef, irreducibleDef]

  Meta.withTransparency Meta.TransparencyMode.instances do
    let reducedExpr ← Meta.reduce constantExpr
    dbg_trace (← ppExpr reducedExpr) -- [1, 2, defaultDef, irreducibleDef]

  Meta.withTransparency Meta.TransparencyMode.default do
    let reducedExpr ← Meta.reduce constantExpr
    dbg_trace (← ppExpr reducedExpr) -- [1, 2, 3, irreducibleDef]

  Meta.withTransparency Meta.TransparencyMode.all do
    let reducedExpr ← Meta.reduce constantExpr
    dbg_trace (← ppExpr reducedExpr) -- [1, 2, 3, 4]

  -- Note: if we don't set the transparency mode, we get a pretty strong `TransparencyMode.default`.
  let reducedExpr ← Meta.reduce constantExpr
  dbg_trace (← ppExpr reducedExpr) -- [1, 2, 3, irreducibleDef]

/- ### 10. -/

-- Non-idiomatic: we can only use `Lean.mkAppN`.
def tenA : MetaM Expr := do
  let body := Lean.mkAppN (Expr.const `Nat.add []) #[Lean.mkNatLit 1, Expr.bvar 0]
  return Expr.lam `x (Expr.const `Nat []) body BinderInfo.default

-- Idiomatic: we can use both `Lean.mkAppN` and `Lean.Meta.mkAppM`.
def tenB : MetaM Expr := do
  Lean.Meta.withLocalDecl `x .default (Expr.const `Nat []) (fun x => do
    -- let body := Lean.mkAppN (Expr.const `Nat.add []) #[Lean.mkNatLit 1, x]
    let body ← Lean.Meta.mkAppM `Nat.add #[Lean.mkNatLit 1, x]
    Lean.Meta.mkLambdaFVars #[x] body
  )

#eval show MetaM _ from do
  ppExpr (← tenA) -- fun x => Nat.add 1 x
#eval show MetaM _ from do
  ppExpr (← tenB) -- fun x => Nat.add 1 x

/- ### 11. -/

def eleven : MetaM Expr :=
  return Expr.forallE `yellow (Expr.const `Nat []) (Expr.bvar 0) BinderInfo.default

#eval show MetaM _ from do
  dbg_trace (← eleven) -- forall (yellow : Nat), yellow

/- ### 12. -/

-- Non-idiomatic: we can only use `Lean.mkApp3`.
def twelveA : MetaM Expr := do
  let nPlusOne := Expr.app (Expr.app (Expr.const `Nat.add []) (Expr.bvar 0)) (Lean.mkNatLit 1)
  let forAllBody := Lean.mkApp3 (Expr.const ``Eq []) (Expr.const `Nat []) (Expr.bvar 0) nPlusOne
  let forAll := Expr.forallE `n (Expr.const `Nat []) forAllBody BinderInfo.default
  return forAll

-- Idiomatic: we can use both `Lean.mkApp3` and `Lean.Meta.mkEq`.
def twelveB : MetaM Expr := do
  withLocalDecl `n BinderInfo.default (Expr.const `Nat []) (fun x => do
    let nPlusOne := Expr.app (Expr.app (Expr.const `Nat.add []) x) (Lean.mkNatLit 1)
    -- let forAllBody := Lean.mkApp3 (Expr.const ``Eq []) (Expr.const `Nat []) x nPlusOne
    let forAllBody ← Lean.Meta.mkEq x nPlusOne
    let forAll := mkForallFVars #[x] forAllBody
    forAll
  )

#eval show MetaM _ from do
  ppExpr (← twelveA) -- (n : Nat) → Eq Nat n (Nat.add n 1)

#eval show MetaM _ from do
  ppExpr (← twelveB) -- ∀ (n : Nat), n = Nat.add n 1

/- ### 13. -/
def thirteen : MetaM Expr := do
  withLocalDecl `f BinderInfo.default (Expr.forallE `a (Expr.const `Nat []) (Expr.const `Nat []) .default) (fun y => do
    let lamBody ← withLocalDecl `n BinderInfo.default (Expr.const `Nat []) (fun x => do
      let fn := Expr.app y x
      let fnPlusOne := Expr.app y (Expr.app (Expr.app (Expr.const `Nat.add []) (x)) (Lean.mkNatLit 1))
      let forAllBody := mkApp3 (mkConst ``Eq []) (Expr.const `Nat []) fn fnPlusOne
      let forAll := mkForallFVars #[x] forAllBody
      forAll
    )
    let lam := mkLambdaFVars #[y] lamBody
    lam
  )

#eval show MetaM _ from do
  ppExpr (← thirteen) -- fun f => (n : Nat) → Eq Nat (f n) (f (Nat.add n 1))

/- ### 14. -/

#eval show Lean.Elab.Term.TermElabM _ from do
  let stx : Syntax ← `(∀ (a : Prop) (b : Prop), a ∨ b → b → a ∧ a)
  let expr ← Elab.Term.elabTermAndSynthesize stx none

  let (_, _, conclusion) ← forallMetaTelescope expr
  dbg_trace conclusion -- And ?_uniq.10 ?_uniq.10

  let (_, _, conclusion) ← forallMetaBoundedTelescope expr 2
  dbg_trace conclusion -- (Or ?_uniq.14 ?_uniq.15) -> ?_uniq.15 -> (And ?_uniq.14 ?_uniq.14)

  let (_, _, conclusion) ← lambdaMetaTelescope expr
  dbg_trace conclusion -- forall (a.1 : Prop) (b.1 : Prop), (Or a.1 b.1) -> b.1 -> (And a.1 a.1)

/- ### 15. -/

#eval show MetaM Unit from do
  let a ← Lean.Meta.mkFreshExprMVar (Expr.const `String []) (userName := `a)
  let b ← Lean.Meta.mkFreshExprMVar (Expr.sort (Nat.toLevel 1)) (userName := `b)
  -- ?a + Int
  let c := Lean.mkAppN (Expr.const `Nat.add []) #[a, Expr.const `Int []]
  -- "hi" + ?b
  let d := Lean.mkAppN (Expr.const `Nat.add []) #[Lean.mkStrLit "hi", b]

  IO.println s!"value in c: {← instantiateMVars c}" -- Nat.add ?_uniq.1 Int
  IO.println s!"value in d: {← instantiateMVars d}" -- Nat.add String ?_uniq.2

  let state : SavedState ← saveState
  IO.println "\nSaved state\n"

  if ← Lean.Meta.isDefEq c d then
    IO.println true
    IO.println s!"value in c: {← instantiateMVars c}"
    IO.println s!"value in d: {← instantiateMVars d}"

  restoreState state
  IO.println "\nRestored state\n"

  IO.println s!"value in c: {← instantiateMVars c}"
  IO.println s!"value in d: {← instantiateMVars d}"