import tactic
import .«2_2_part_ii_integers»

namespace notes

-- Add this line in the beginning of each file to override the default ℕ
local notation `ℕ` : 1024 := mynat
-- Add this line in the beginning of each file to override the default ℤ
local notation `ℤ` : 1024 := myint
-- Nonzero integers
def nzint : Type := {x : ℤ // x ≠ 0}
local notation `ℤ*` : 1024 := nzint

universe u

--------------------------------------------------------------------------------
-- # Rationals

namespace myrat

-- The equivalence relation
  def eqv : ℤ × ℤ* → ℤ × ℤ* → Prop :=
    λ ⟨a, b, _⟩ ⟨c, d, _⟩, a * d = c * b

  local infix `∼` : 50 := eqv

  lemma eqv_refl : ∀ x, x ∼ x :=
    λ ⟨a, b, hb⟩, rfl

  lemma eqv_symm : ∀ x y, x ∼ y → y ∼ x :=
    λ ⟨a, b, hb⟩ ⟨c, d, hd⟩ h, h.symm

  lemma eqv_trans : ∀ x y z, x ∼ y → y ∼ z → x ∼ z :=
    λ ⟨a, b, hb⟩ ⟨c, d, hd⟩ ⟨e, f, hf⟩ h₁ h₂, by
    { unfold eqv at *,
      cases classical.em (c = 0) with hc hc, -- TODO: `decidable_eq`
      { have h₁ : a * d = 0 * d, { sorry, /- rewrite_search [h₁, hc, myint.mul_comm, myint.mul_assoc, myint.mul_zero], -/ },
        replace h₁ : a = 0 := myint.mul_right_cancel _ _ _ hd h₁,
        have h₂ : 0 * d = e * d, { sorry, },
        replace h₂ : 0 = e := myint.mul_right_cancel _ _ _ hd h₂,
        simp [h₁, ← h₂, myint.zero_mul], },
      have h : d * (c * (a * f)) = d * (c * (e * b)),
      { sorry, /- rewrite_search [myint.mul_comm, myint.mul_assoc, h₁, h₂] -/ },
      exact (myint.mul_left_cancel _ _ _ hc (myint.mul_left_cancel _ _ _ hd h)) }

  lemma eqv_equivalence_relation : is_equivalence_relation (∼) :=
    ⟨eqv_refl, eqv_symm, eqv_trans⟩

end myrat

-- Definition of ℝ as a quotient type
-- (i.e. equivalence classes under the equivalence relation)
def myrat : Type :=
  @quot (ℤ × ℤ*) myrat.eqv

-- Add this line in the beginning of each file to override the default ℝ
local notation `ℚ` : 1024 := myrat

namespace myrat
section
  local infix ` ∼ ` : 50 := eqv

-- Addition
  def add_fn : ℤ × ℤ* → ℤ × ℤ* → ℤ × ℤ* :=
    λ ⟨a, b, hb⟩ ⟨c, d, hd⟩, (a * d + c * b, ⟨b * d, sorry⟩)

  lemma add_respects_fst :
    ∀ (x₁ x₂ y : ℤ × ℤ*), (x₁ ∼ x₂) → (add_fn x₁ y ∼ add_fn x₂ y)
  :=
  begin
    rintros ⟨a₁, b₁, hb₁⟩ ⟨a₂, b₂, hb₂⟩ ⟨c, d, hd⟩ h,
    unfold add_fn at *,
    unfold eqv at *,
    sorry
  end

  lemma add_respects_snd :
    ∀ (x y₁ y₂ : ℤ × ℤ*), (y₁ ∼ y₂) → (add_fn x y₁ ∼ add_fn x y₂)
  :=
  begin
    rintros ⟨a, b, hb⟩ ⟨c₁, d₁, hd₁⟩ ⟨c₂, d₂, hd₂⟩ h,
    unfold add_fn at *,
    unfold eqv at *,
    sorry
  end

  def add : ℚ → ℚ → ℚ :=
    quot.map₂ add_fn add_respects_snd add_respects_fst
  instance : has_add ℚ := ⟨add⟩

-- Negation
  def neg_fn : ℤ × ℤ* → ℤ × ℤ* :=
    λ ⟨a, b, hb⟩, (-a, ⟨b, hb⟩)

  lemma neg_respects :
    ∀ (x₁ x₂ : ℤ × ℤ*), (x₁ ∼ x₂) → (neg_fn x₁ ∼ neg_fn x₂)
  :=
  begin
    rintros ⟨a₁, b₁, hb₁⟩ ⟨a₂, b₂, hb₂⟩ h,
    unfold neg_fn at *,
    unfold eqv at *,
    sorry
  end

  def neg : ℚ → ℚ :=
    quot.map neg_fn neg_respects
  instance : has_neg ℚ := ⟨neg⟩

-- Multiplication
  def mul_fn : ℤ × ℤ* → ℤ × ℤ* → ℤ × ℤ* :=
    λ ⟨a, b, hb⟩ ⟨c, d, hd⟩, (a * c, ⟨b * d, sorry⟩)

  lemma mul_respects_fst :
    ∀ (x₁ x₂ y : ℤ × ℤ*), (x₁ ∼ x₂) → (mul_fn x₁ y ∼ mul_fn x₂ y)
  :=
  begin
    rintros ⟨a₁, b₁, hb₁⟩ ⟨a₂, b₂, hb₂⟩ ⟨c, d, hd⟩ h,
    unfold mul_fn at *,
    unfold eqv at *,
    sorry
  end

  lemma mul_respects_snd :
    ∀ (x y₁ y₂ : ℤ × ℤ*), (y₁ ∼ y₂) → (mul_fn x y₁ ∼ mul_fn x y₂)
  :=
  begin
    rintros ⟨a, b, hb⟩ ⟨c₁, d₁, hd₁⟩ ⟨c₂, d₂, hd₂⟩ h,
    unfold mul_fn at *,
    unfold eqv at *,
    sorry
  end

  def mul : ℚ → ℚ → ℚ :=
    quot.map₂ mul_fn mul_respects_snd mul_respects_fst
  instance : has_mul ℚ := ⟨mul⟩

-- Inversion
  def inv_fn : Π (x : ℤ × ℤ*), (x.fst ≠ 0) → ℤ × ℤ* :=
    λ ⟨a, b, hb⟩ ha, (b, ⟨a, ha⟩)

  def inv_fn' : Π (x : ℤ × ℤ*)

/-
  lemma inv_respects :
    ∀ (x₁ x₂ : ℤ × ℤ*), (x₁ ∼ x₂) → (inv_fn x₁ ∼ inv_fn x₂)
  :=
  begin
    rintros ⟨a₁, b₁, hb₁⟩ ⟨a₂, b₂, hb₂⟩ h,
    unfold inv_fn at *,
    unfold eqv at *,
    sorry
  end

  def inv : ℚ → ℚ :=
    quot.map inv_fn inv_respects
  instance : has_inv ℚ := ⟨inv⟩
-/

-- Less or equal than
  def le_fn : ℤ × ℤ* → ℤ × ℤ* → Prop :=
    λ ⟨a, b, hb⟩ ⟨c, d, hd⟩, a * d ≤ c * b

  lemma le_respects_fst :
    ∀ (x₁ x₂ y : ℤ × ℤ*), x₁ ∼ x₂ → le_fn x₁ y = le_fn x₂ y
  :=
  begin
    rintros ⟨a₁, b₁, hb₁⟩ ⟨a₂, b₂, hb₂⟩ ⟨c, d, hd⟩ h,
    unfold le_fn at *,
    unfold eqv at *,
    apply propext,
    split,
    { intros h₁, sorry },
    { intros h₁, sorry }
  end

  lemma le_respects_snd :
    ∀ (x y₁ y₂ : ℤ × ℤ*), (y₁ ∼ y₂) → le_fn x y₁ = le_fn x y₂
  :=
  begin
    rintros ⟨a, b, hb⟩ ⟨c₁, d₁, hd₁⟩ ⟨c₂, d₂, hd₂⟩ h,
    unfold le_fn at *,
    unfold eqv at *,
    sorry
  end

  def le : ℚ → ℚ → Prop :=
    quot.lift₂ le_fn le_respects_snd le_respects_fst
  instance : has_le ℚ := ⟨le⟩

-- Less than
  def lt_fn : ℤ × ℤ* → ℤ × ℤ* → Prop :=
    λ ⟨a, b, hb⟩ ⟨c, d, hd⟩, a * d < c * b

  lemma lt_respects_fst :
    ∀ (x₁ x₂ y : ℤ × ℤ*), x₁ ∼ x₂ → lt_fn x₁ y = lt_fn x₂ y
  :=
  begin
    rintros ⟨a₁, b₁, hb₁⟩ ⟨a₂, b₂, hb₂⟩ ⟨c, d, hd⟩ h,
    unfold lt_fn at *,
    unfold eqv at *,
    sorry
  end

  lemma lt_respects_snd :
    ∀ (x y₁ y₂ : ℤ × ℤ*), (y₁ ∼ y₂) → lt_fn x y₁ = lt_fn x y₂
  :=
  begin
    rintros ⟨a, b, hb⟩ ⟨c₁, d₁, hd₁⟩ ⟨c₂, d₂, hd₂⟩ h,
    unfold lt_fn at *,
    unfold eqv at *,
    sorry
  end

  def lt : ℚ → ℚ → Prop :=
    quot.lift₂ lt_fn lt_respects_snd lt_respects_fst
  instance : has_lt ℚ := ⟨lt⟩

end

section
-- TODO: ℤ as a subset of ℚ

  def zero : ℚ := quot.mk eqv (0, ⟨1, myint.zero_ne_one.symm⟩)
  def one : ℚ := quot.mk eqv (1, ⟨1, myint.zero_ne_one.symm⟩)

  instance : has_zero ℚ := ⟨zero⟩
  instance : has_one ℚ := ⟨one⟩

  lemma zero_ne_one :
    zero ≠ one
  :=
    sorry
end

section
  local infix ` ∼ ` : 50 := eqv
  variables (x y z : ℚ)

  @[simp]
  theorem add_assoc :
    (x + y) + z = x + (y + z)
  :=
  begin
    sorry
  end

  @[simp]
  theorem zero_add :
    zero + x = x
  :=
  begin
    sorry
  end

  @[simp]
  theorem add_zero :
    x + zero = x
  :=
  begin
    sorry
  end

  @[simp]
  theorem neg_add :
    (-x) + x = zero
  :=
  begin
    sorry
  end

  @[simp]
  theorem add_neg :
    x + (-x) = zero
  :=
  begin
    sorry
  end

  --@[simp]
  theorem add_comm :
    x + y = y + x
  :=
  begin
    sorry
  end

  @[simp]
  theorem mul_assoc :
    (x * y) * z = x * (y * z)
  :=
  begin
    sorry
  end

  @[simp]
  theorem one_mul :
    one * x = x
  :=
  begin
    sorry
  end

  @[simp]
  theorem mul_one :
    x * one = x
  :=
  begin
    sorry
  end

  -- TODO: `inv_mul` and `mul_inv`

  --@[simp]
  theorem mul_comm :
    x * y = y * x
  :=
  begin
    sorry
  end

  @[simp]
  theorem add_mul :
    (x + y) * z = x * z + y * z
  :=
  begin
    sorry
  end

  @[simp]
  lemma mul_add : x * (y + z) = x * y + x * z :=
    by rw [mul_comm, add_mul, mul_comm y x, mul_comm z x]

end

section
  local infix ` ∼ ` : 50 := eqv
  variables (x y z : ℚ)

  theorem add_right_cancel :
    x + z = y + z → x = y
  :=
  begin
    sorry
  end

  lemma add_left_cancel : z + x = z + y → x = y :=
    by { rw [add_comm z x, add_comm z y], exact add_right_cancel _ _ _ }

  theorem mul_right_cancel :
    z ≠ zero → x * z = y * z → x = y
  :=
  begin
    sorry
  end

  lemma mul_left_cancel : z ≠ zero → z * x = z * y → x = y :=
    by { rw [mul_comm z x, mul_comm z y], exact mul_right_cancel _ _ _ }

end

-- TODO: lemmas related to le, lt...

end myrat

--------------------------------------------------------------------------------

end notes


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.limits.shapes.equalizers

/-!
# Split coequalizers

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

We define what it means for a triple of morphisms `f g : X ⟶ Y`, `π : Y ⟶ Z` to be a split
coequalizer: there is a section `s` of `π` and a section `t` of `g`, which additionally satisfy
`t ≫ f = π ≫ s`.

In addition, we show that every split coequalizer is a coequalizer
(`category_theory.is_split_coequalizer.is_coequalizer`) and absolute
(`category_theory.is_split_coequalizer.map`)

A pair `f g : X ⟶ Y` has a split coequalizer if there is a `Z` and `π : Y ⟶ Z` making `f,g,π` a
split coequalizer.
A pair `f g : X ⟶ Y` has a `G`-split coequalizer if `G f, G g` has a split coequalizer.

These definitions and constructions are useful in particular for the monadicity theorems.

## TODO

Dualise to split equalizers.
-/

namespace category_theory

universes v v₂ u u₂

variables {C : Type u} [category.{v} C]
variables {D : Type u₂} [category.{v₂} D]
variables (G : C ⥤ D)
variables {X Y : C} (f g : X ⟶ Y)

/--
A split coequalizer diagram consists of morphisms

      f   π
    X ⇉ Y → Z
      g

satisfying `f ≫ π = g ≫ π` together with morphisms

      t   s
    X ← Y ← Z

satisfying `s ≫ π = 𝟙 Z`, `t ≫ g = 𝟙 Y` and `t ≫ f = π ≫ s`.

The name "coequalizer" is appropriate, since any split coequalizer is a coequalizer, see
`category_theory.is_split_coequalizer.is_coequalizer`.
Split coequalizers are also absolute, since a functor preserves all the structure above.
-/
structure is_split_coequalizer {Z : C} (π : Y ⟶ Z) :=
(right_section : Z ⟶ Y)
(left_section : Y ⟶ X)
(condition : f ≫ π = g ≫ π)
(right_section_π : right_section ≫ π = 𝟙 Z)
(left_section_bottom : left_section ≫ g = 𝟙 Y)
(left_section_top : left_section ≫ f = π ≫ right_section)

instance {X : C} : inhabited (is_split_coequalizer (𝟙 X) (𝟙 X) (𝟙 X)) :=
⟨⟨𝟙 _, 𝟙 _, rfl, category.id_comp _, category.id_comp _, rfl⟩⟩

open is_split_coequalizer
attribute [reassoc] condition
attribute [simp, reassoc] right_section_π left_section_bottom left_section_top

variables {f g}

/-- Split coequalizers are absolute: they are preserved by any functor. -/
@[simps]
def is_split_coequalizer.map {Z : C} {π : Y ⟶ Z} (q : is_split_coequalizer f g π) (F : C ⥤ D) :
  is_split_coequalizer (F.map f) (F.map g) (F.map π) :=
{ right_section := F.map q.right_section,
  left_section := F.map q.left_section,
  condition := by rw [←F.map_comp, q.condition, F.map_comp],
  right_section_π := by rw [←F.map_comp, q.right_section_π, F.map_id],
  left_section_bottom := by rw [←F.map_comp, q.left_section_bottom, F.map_id],
  left_section_top := by rw [←F.map_comp, q.left_section_top, F.map_comp] }

section

open limits

/-- A split coequalizer clearly induces a cofork. -/
@[simps X]
def is_split_coequalizer.as_cofork {Z : C} {h : Y ⟶ Z} (t : is_split_coequalizer f g h) :
  cofork f g :=
cofork.of_π h t.condition

@[simp] lemma is_split_coequalizer.as_cofork_π  {Z : C} {h : Y ⟶ Z}
  (t : is_split_coequalizer f g h) : t.as_cofork.π = h := rfl

/--
The cofork induced by a split coequalizer is a coequalizer, justifying the name. In some cases it
is more convenient to show a given cofork is a coequalizer by showing it is split.
-/
def is_split_coequalizer.is_coequalizer
  {Z : C} {h : Y ⟶ Z} (t : is_split_coequalizer f g h) :
  is_colimit t.as_cofork :=
cofork.is_colimit.mk' _ $ λ s,
⟨t.right_section ≫ s.π,
 by { dsimp, rw [← t.left_section_top_assoc, s.condition, t.left_section_bottom_assoc] },
 λ m hm, by { simp [←hm] }⟩

end

variables (f g)
/--
The pair `f,g` is a split pair if there is a `h : Y ⟶ Z` so that `f, g, h` forms a split coequalizer
in `C`.
-/
class has_split_coequalizer : Prop :=
(splittable [] : ∃ {Z : C} (h : Y ⟶ Z), nonempty (is_split_coequalizer f g h))

/--
The pair `f,g` is a `G`-split pair if there is a `h : G Y ⟶ Z` so that `G f, G g, h` forms a split
coequalizer in `D`.
-/
abbreviation functor.is_split_pair : Prop := has_split_coequalizer (G.map f) (G.map g)

/-- Get the coequalizer object from the typeclass `is_split_pair`. -/
noncomputable def has_split_coequalizer.coequalizer_of_split [has_split_coequalizer f g] : C :=
(has_split_coequalizer.splittable f g).some

/-- Get the coequalizer morphism from the typeclass `is_split_pair`. -/
noncomputable def has_split_coequalizer.coequalizer_π [has_split_coequalizer f g] :
  Y ⟶ has_split_coequalizer.coequalizer_of_split f g :=
(has_split_coequalizer.splittable f g).some_spec.some

/-- The coequalizer morphism `coequalizer_ι` gives a split coequalizer on `f,g`. -/
noncomputable def has_split_coequalizer.is_split_coequalizer [has_split_coequalizer f g] :
  is_split_coequalizer f g (has_split_coequalizer.coequalizer_π f g) :=
classical.choice (has_split_coequalizer.splittable f g).some_spec.some_spec

/-- If `f, g` is split, then `G f, G g` is split. -/
instance map_is_split_pair [has_split_coequalizer f g] :
  has_split_coequalizer (G.map f) (G.map g) :=
{ splittable :=
  ⟨_, _, ⟨is_split_coequalizer.map (has_split_coequalizer.is_split_coequalizer f g) _⟩⟩ }

namespace limits

/-- If a pair has a split coequalizer, it has a coequalizer. -/
@[priority 1]
instance has_coequalizer_of_has_split_coequalizer [has_split_coequalizer f g] :
  has_coequalizer f g :=
has_colimit.mk ⟨_, (has_split_coequalizer.is_split_coequalizer f g).is_coequalizer⟩

end limits

end category_theory


import condensed.ab
import condensed.top_comparison
import condensed.extr.equivalence
import category_theory.sites.limits
import algebra.category.Group.filtered_colimits

import for_mathlib.abelian_category
import for_mathlib.AddCommGroup.epi

universe u

open category_theory

/-

S extr. disc.
A cond ab group.

A ↦ Hom_{CondSet}(S,A) = A(S) commutes with limits and colimits.

A(-) commutes with finite products, in Ab, finite products = finite coproducts.

Z[S] is projective.

A -> B epi, Hom(Z[S],A) -> Hom(Z[S],B) -- A(S) -> B(S) WTS: surjective.

1. If S is extr. disc. and A -> B is an epi of cond ab, then A(S) -> B(S) surjective.
  B -> B/A

-/

noncomputable theory

def Condensed_Ab.free (S : CondensedSet) : Condensed Ab :=
CondensedSet_to_Condensed_Ab.obj $ S

local notation `ℤ[`S`]` := Condensed_Ab.free S.to_Condensed

def Condensed.forget_Ab (S : Condensed Ab) : CondensedSet :=
Condensed_Ab_to_CondensedSet.obj S

def quiver.hom.forget_Ab {S T : Condensed Ab} (e : S ⟶ T) :
  S.forget_Ab ⟶ T.forget_Ab :=
Condensed_Ab_to_CondensedSet.map e

namespace Condensed_Ab

def to_free (S : CondensedSet) : S ⟶ Condensed_Ab_to_CondensedSet.obj (free S) :=
Condensed_Ab_CondensedSet_adjunction.hom_equiv _ _ $ 𝟙 _

def free_lift {S : CondensedSet} {A : Condensed Ab} (e : S ⟶ A.forget_Ab) :
  free S ⟶ A :=
(Condensed_Ab_CondensedSet_adjunction.hom_equiv _ _).symm e

@[simp]
lemma to_free_free_lift {S : CondensedSet} {A : Condensed Ab} (e : S ⟶ A.forget_Ab) :
  to_free S ≫ (free_lift e).forget_Ab = e :=
begin
  dsimp only [Condensed.forget_Ab, to_free, free_lift, quiver.hom.forget_Ab],
  rw [adjunction.hom_equiv_unit, adjunction.hom_equiv_counit, category.assoc,
    category_theory.functor.map_id, category.id_comp, functor.map_comp,
    Condensed_Ab_CondensedSet_adjunction.unit_naturality_assoc,
    adjunction.right_triangle_components, category.comp_id],
end

lemma free_lift_unique {S : CondensedSet} {A : Condensed Ab} (e : S ⟶ A.forget_Ab) (f : free S ⟶ A)
  (h : to_free S ≫ f.forget_Ab = e) : f = free_lift e :=
begin
  apply_fun (Condensed_Ab_CondensedSet_adjunction.hom_equiv _ _),
  dsimp [free_lift],
  rw equiv.apply_symm_apply,
  exact h
end

@[ext]
lemma free_hom_ext {S : CondensedSet} {A : Condensed Ab} (f g : free S ⟶ A)
  (h : to_free S ≫ f.forget_Ab = to_free S ≫ g.forget_Ab) : f = g :=
by rw [free_lift_unique _ f rfl, free_lift_unique _ g rfl, h]

end Condensed_Ab

@[simps]
def hom_equiv_evaluation (S : Profinite.{u}) (A : Condensed Ab) :
  (ℤ[S] ⟶ A) ≃ ((Condensed_Ab_to_CondensedSet ⋙ CondensedSet.evaluation S).obj A) :=
(Condensed_Ab_CondensedSet_adjunction.hom_equiv S.to_Condensed A).trans $
  (equiv_of_fully_faithful $ Sheaf_to_presheaf.{u} _ _).trans $ yoneda'_equiv _ _

lemma hom_equiv_evaluation_apply_eq_app_id (S : Profinite.{u}) (A : Condensed Ab)
  (f : ℤ[S] ⟶ A) : hom_equiv_evaluation S A f =
  (Condensed_Ab.to_free _ ≫ Condensed_Ab_to_CondensedSet.map f).val.app _ ⟨𝟙 _⟩ := rfl

lemma exists_hom_equiv_evaluation_symm_app_eq
  (S : Profinite.{u}) (A : Condensed Ab)
  (f : A.val.obj (opposite.op S)) : ∃ (t : ℤ[S].val.obj (opposite.op S)),
  ((hom_equiv_evaluation S A).symm f).val.app _ t = f :=
begin
  -- This proof can probably be made simpler using some adjunction voodoo...
  use (hom_equiv_evaluation _ _) (𝟙 _),
  dsimp [hom_equiv_evaluation, adjunction.whisker_right],
  simp_rw [← comp_apply, ← nat_trans.comp_app],
  erw [category.comp_id, proetale_topology.to_sheafify_sheafify_lift],
  dsimp [functor.preimage, full.preimage, yoneda'_equiv],
  simp only [comp_apply, AddCommGroup.free_map_coe, category.id_comp, category.comp_id],
  dsimp [functor.right_unitor, AddCommGroup.adj, applicative.to_functor],
  erw equiv.apply_symm_apply,
  simp only [op_id, category_theory.functor.map_id, id_apply, one_mul, monoid_hom.to_fun_eq_coe,
    free_group.lift.of, types_id_apply],
end

local attribute [instance] limits.has_zero_object.has_zero

open category_theory.limits
open opposite

-- sanity check
example (S : Profinite.{u}) : preserves_zero_objects (Condensed.evaluation Ab.{u+1} S) :=
infer_instance

instance (S : Profinite.{u}) [projective S] :
  projective (ℤ[S]) :=
{ factors := λ A B f g hg, begin
    rw epi_iff_is_zero_cokernel at hg,
    -- this follows from the fact that evaluation preserves colimits.
    let e : (cokernel g).val.obj (op S) ≅ cokernel (g.val.app (op S)) := begin
      refine (is_colimit_of_preserves (Condensed.evaluation Ab S)
      (colimit.is_colimit _)).cocone_point_unique_up_to_iso
        (colimit.is_colimit _) ≪≫ has_colimit.iso_of_nat_iso _,
      refine nat_iso.of_components _ _,
      { rintros (a|b), exact eq_to_iso rfl, exact eq_to_iso rfl },
      rintros (a|b) (c|d) (e|e),
      all_goals { dsimp },
      all_goals { simp, try { refl } },
    end,
    replace hg := is_zero_of_preserves (Condensed.evaluation Ab.{u+1} S) hg,
    dsimp [Condensed.evaluation] at hg,
    replace hg := is_zero_of_iso_of_zero hg e,
    rw ← epi_iff_is_zero_cokernel at hg,
    replace hg : function.surjective (g.val.app (op S)) := begin
      resetI,
      apply AddCommGroup.surjective_of_epi,
    end,
    let f₁ := hom_equiv_evaluation _ _ f,
    dsimp at f₁,
    obtain ⟨f',h⟩ := hg f₁,
    use (hom_equiv_evaluation _ _).symm f',
    apply_fun (hom_equiv_evaluation _ _),
    change _ = f₁,
    rw [← h, hom_equiv_evaluation_apply, Sheaf.hom.comp_val, nat_trans.comp_app],
    erw [← comp_apply, ← comp_apply, category.id_comp, ← nat_trans.comp_app, ← nat_trans.comp_app],
    dsimp [hom_equiv_evaluation],
    simp_rw [← category.assoc, ← nat_trans.comp_app],
    rw proetale_topology.to_sheafify_sheafify_lift,
    rw adjunction.hom_equiv_counit,
    dsimp,
    simp only [category.assoc, adjunction.whisker_right_counit_app_app],
    simp_rw [comp_apply],
    congr' 1,
    dsimp [functor.preimage, yoneda'_equiv, full.preimage, AddCommGroup.adj, ulift_functor],
    change (free_abelian_group.lift id) (_ <$> free_abelian_group.of _) = _,
    simp,
  end }

lemma is_zero_iff_forall_zero {A : Condensed.{u} Ab.{u+1}} :
  is_zero A ↔ ∀ (S : ExtrDisc), is_zero (A.val.obj (op S.val)) :=
begin
  split,
  { intros h S,
    apply is_zero_of_preserves (Condensed.evaluation Ab.{u+1} S.val),
    assumption },
  { intro h,
    let FF := ((Sheaf_to_presheaf _ _ : Condensed.{u} Ab.{u+1} ⥤ _) ⋙
      (whiskering_left _ _ _).obj (ExtrDisc_to_Profinite.op)),
    haveI : creates_colimits FF :=
      by apply Condensed_to_ExtrDisc_presheaf_creates_colimits,
    suffices : A ≅ ⊥_ _, by { apply is_zero_of_iso_of_zero _ this.symm, exact is_zero_initial },
    let e : Π S : ExtrDisc, (A.val.obj (op S.val)) ≅ ⊥_ _ :=
      λ S, is_zero.iso (h S) is_zero_initial,
    symmetry,
    apply (colimit.is_colimit _).cocone_point_unique_up_to_iso (_ : is_colimit (as_empty_cocone _)),
    haveI := reflects_colimits_of_size_shrink.{0 u+1 0 u+1} FF,
    apply (is_colimit_of_reflects.{0 0 (u+1) (u+1) (u+2) (u+2)} FF),
    apply evaluation_jointly_reflects_colimits,
    intros S,
    have := is_colimit_empty_cocone_equiv Ab (as_empty_cocone (A.val.obj (op S.unop.val)))
      (((evaluation ExtrDiscᵒᵖ Ab).obj S).map_cocone (FF.map_cocone (as_empty_cocone A)))
     (eq_to_iso rfl),
    apply this.to_fun,
    specialize e S.unop,
    let t : as_empty_cocone (A.val.obj (op (unop S).val)) ≅ as_empty_cocone (⊥_ _) :=
      cocones.ext e (by rintros ⟨⟨⟩⟩),
    apply is_colimit.of_iso_colimit _ t.symm,
    refine ⟨λ r, _, _, _⟩,
    { dsimp, refine initial.to r.X, },
    { simp only [as_empty_cocone_ι_app, id.def, auto_param_eq],
      rintros s ⟨⟨⟩⟩ },
    { tidy } }
end

lemma is_epi_iff_forall_surjective {A B : Condensed.{u} Ab.{u+1}} (f : A ⟶ B) :
  epi f ↔ ∀ (S : ExtrDisc), function.surjective (f.val.app (op S.val)) :=
begin
  rw epi_iff_is_zero_cokernel,
  rw is_zero_iff_forall_zero,
  apply forall_congr (λ S, _),
  let FF := Condensed.evaluation Ab.{u+1} S.val,
  haveI : preserves_colimits FF := infer_instance,
  let e : (cokernel f).val.obj (op S.val) ≅ cokernel (f.val.app (op S.val)) := begin
    change FF.obj (cokernel f) ≅ cokernel (FF.map f),
    change (FF.map_cocone _).X ≅ _,
    refine (is_colimit_of_preserves FF (colimit.is_colimit _)).cocone_point_unique_up_to_iso
      (colimit.is_colimit _) ≪≫ _,
    dsimp,
    apply has_colimit.iso_of_nat_iso,
    -- This isomorphism is probably somewhere in mathlib... or somewhere in this repo.
    refine nat_iso.of_components _ _,
    { rintros (i|i),
      { exact iso.refl _ },
      { exact iso.refl _ } },
    { rintros (i|i) (j|j) (f|f),
      { dsimp, simpa, },
      { dsimp, simp, },
      { dsimp, simpa, },
      { dsimp, simpa, } },
  end,
  have : is_zero ((cokernel f).val.obj (op S.val)) ↔ is_zero (cokernel (f.val.app (op S.val))),
  { split,
    { intro h, apply is_zero_of_iso_of_zero h e, },
    { intro h, apply is_zero_of_iso_of_zero h e.symm, } },
  rw [this, ← epi_iff_is_zero_cokernel],
  clear e,
  split,
  { introsI h, apply AddCommGroup.surjective_of_epi },
  { intros h, exact concrete_category.epi_of_surjective (f.val.app (op S.val)) h}
end

theorem Condensed_Ab_has_enough_projectives_aux (A : Condensed.{u} Ab.{u+1}) :
  ∃ (B : Condensed Ab) (hB : projective B) (f : B ⟶ A), epi f :=
begin
  let II := Σ (S : ExtrDisc), A.val.obj (op S.val),
  let X : II → Condensed Ab := λ i, ℤ[i.1.val],
  let f : Π i, X i ⟶ A := λ i, (hom_equiv_evaluation i.1.val A).symm i.2,
  -- Move this.
  haveI : has_colimits (Condensed.{u} Ab.{u+1}) := begin
    change has_colimits (Sheaf _ _),
    exact category_theory.Sheaf.category_theory.limits.has_colimits.{(u+2) u (u+1)},
  end,
  use [∐ X, infer_instance, sigma.desc f],
  rw is_epi_iff_forall_surjective,
  intros S t,
  obtain ⟨w,hw⟩ := exists_hom_equiv_evaluation_symm_app_eq S.val A t,
  use (sigma.ι X ⟨S,t⟩).val.app (op S.val) w,
  rw [← comp_apply, ← nat_trans.comp_app],
  change (((sigma.ι X ⟨S,t⟩) ≫ sigma.desc f).val.app (op S.val)) w = _,
  erw colimit.ι_desc,
  exact hw,
end

instance Condensed_Ab_has_enough_projective : enough_projectives (Condensed.{u} Ab.{u+1}) :=
begin
  constructor,
  intros B,
  obtain ⟨X,hX,f,hf⟩ := Condensed_Ab_has_enough_projectives_aux B,
  resetI,
  constructor,
  refine ⟨X,hX,f,hf⟩,
end


import topology.basic
import topology.continuous_function.basic

structure pointed_space (X : Type) [topological_space X] : Type :=
-- (to_topological_space : topological_space X)
(basepoint : X)

structure pointed_continuous_map {X Y : Type} [topological_space X] [topological_space Y]
  (Xp : pointed_space X) (Yp : pointed_space Y)
  extends continuous_map X Y : Type :=
(pointed_map : to_fun Xp.basepoint = Yp.basepoint)

notation `Cp(` Xp `, ` Yp `)` := pointed_continuous_map Xp Yp

instance has_coe_to_fun.pointed_continuous_map {X Y : Type} [topological_space X] [topological_space Y]
  (Xp : pointed_space X) (Yp : pointed_space Y) :
  has_coe_to_fun Cp(Xp, Yp) (λ _, X → Y) :=
⟨λf, pointed_continuous_map.to_continuous_map f⟩

def pointed_map_of_continuous_map {X Y : Type} [topological_space X] [topological_space Y] [inhabited X] (f : C(X, Y)) :
  Cp((pointed_space.mk (inhabited.default X)), (pointed_space.mk (f (inhabited.default X)))) := {
  to_fun := f,
  pointed_map := by simp,
}

lemma nonempty_of_pointed_space {X : Type} [topological_space X] (Xp : pointed_space X) :
  nonempty X :=
begin
  apply @nonempty_of_exists _ (λ_, true),
  apply exists.intro Xp.basepoint,
  tautology,
end

lemma ptd_continuous_map_is_original {X Y : Type} [topological_space X] [topological_space Y] [inhabited X] (f : C(X, Y)) :
  (pointed_map_of_continuous_map f).to_continuous_map = f :=
begin
  ext,
  simp [pointed_map_of_continuous_map],
end


open classical

variable p: Prop
#check em p

theorem dne {p: Prop} (h: ¬ ¬ p) : p :=
  (em p).elim
    (assume hp: p, hp)
    (assume hnp: ¬ p, absurd hnp h)

#check by_cases


import tactic

inductive MForm (α : Type)
-- The absurdity, ⊥
| bot : MForm
-- Atomic MFormulas are introduced via α
| atom : α → MForm
-- conjunction
| and : MForm → MForm → MForm
-- disjunction
| or  : MForm → MForm → MForm
-- implication
| imp : MForm → MForm → MForm
-- possibility
| pos : MForm → MForm
-- necessity
| nec : MForm → MForm

variable {α : Type}

-- we define `¬A` as `A ⟹ ⊥` (makes proofs smaller)
@[reducible]
def MForm.neg (A : MForm α) : MForm α := MForm.imp A MForm.bot

-- Coerce atoms type objects to Formulas
-- Given p : ℕ, just write `p` or `↑p` instead of `atom p`
-- (`↑p` forces the coercion)
instance nat_coe_MForm : has_coe α (MForm α) := ⟨MForm.atom⟩

infix ` ⋀ `:75 := MForm.and
infix ` ⋁ `:74 := MForm.or
infix ` ⟹ `:75 := MForm.imp
prefix `¬` := MForm.neg
prefix `◇`:76 := MForm.pos
prefix `□`:76 := MForm.nec

instance MForm_has_bot : has_bot (MForm α) := ⟨MForm.bot⟩

inductive necessitive : MForm α → Prop
| mk_nec {A} : necessitive □A
| mk_neg_pos {A} : necessitive ¬◇A

inductive modal : MForm α → Prop
| mk_nec {A} : modal □A
| mk_pos {A} : modal ◇A
| mk_neg_nec {A} : modal ¬□A
| mk_neg_pos {A} : modal ¬◇A

@[simp]
theorem modal_insert {X : set (MForm α)} {A : MForm α} :
  (∀ B ∈ (insert A X), modal B) ↔ (modal A ∧ ∀ B ∈ X, modal B) := set.ball_insert_iff

@[simp]
theorem modal_singleton {α : Type} {A : MForm α} :
  (∀ B : MForm α, B ∈ ({A} : set (MForm α)) →  @modal α B) ↔ modal A := by simp;refl

@[simp]
theorem necessitive_insert {X : set (MForm α)} {A : MForm α} :
  (∀ B ∈ (insert A X), necessitive B) ↔ (necessitive A ∧ ∀ B ∈ X, necessitive B) := set.ball_insert_iff

@[simp]
theorem necessitive_singleton {A : MForm α} :
  (∀ B : MForm α, B ∈ ({A} : set (MForm α)) →  @necessitive α B) ↔ necessitive A := by simp;refl

/-- Inductive definition of a S5.deduction X ≻ A (argument) from a set of Formulas X
to a Formula A. This is equivalent to the usual proof tree presentation, however,
there is no need to "discharge" Formulas - we just choose to keep them as assumptions
or not. This forces us to add a weakening rule to the usual collection of rules.
-/
inductive S5.deduction : set (MForm α) → (MForm α) → Type
| assumption  {X} {A}           : (A ∈ X) → S5.deduction X A
| and_intro   {X Y} {A B}       : S5.deduction X A → S5.deduction Y B → S5.deduction (X ∪ Y) (A ⋀ B)
| and_left    {X} (A B)         : S5.deduction X (A ⋀ B) → S5.deduction X A
| and_right   {X} (A B)         : S5.deduction X (A ⋀ B) → S5.deduction X B
| imp_intro   {X} {A B}         : S5.deduction (X ∪ {A}) B → S5.deduction X (A ⟹ B)
| imp_elim    {X Y} (A) {B}     : S5.deduction X (A ⟹ B) → S5.deduction Y A → S5.deduction (X ∪ Y) B
| or_left     {X} {A B}         : S5.deduction X A → S5.deduction X (A ⋁ B)
| or_right    {X} {A B}         : S5.deduction X B → S5.deduction X (A ⋁ B)
| or_elim     {X Y Z} (A B) {C} : S5.deduction X (A ⋁ B) → S5.deduction (Y ∪ {A}) C → S5.deduction (Z ∪ {B}) C → S5.deduction (X ∪ Y ∪ Z) C
| falsum_elim {X} {A}           : S5.deduction X ⊥ → S5.deduction X A
| dne         {X} {A}           : S5.deduction X (¬¬A) → S5.deduction X A
| nec_intro   {X} (Y) {A}       : (∀ B ∈ Y, modal B) → Y ⊆ X → S5.deduction Y A → S5.deduction X □A
| nec_elim    {X} {A}           : S5.deduction X □A → S5.deduction X A
| pos_intro   {X} {A}           : S5.deduction X A → S5.deduction X ◇A
| pos_elim    {X} (Y) (A)         : (∀ B ∈ Y, modal B) → S5.deduction X ◇A → S5.deduction (Y ∪ {A}) ⊥  → S5.deduction (X ∪ Y) ⊥

-- Notation for deduction types with natural number atoms
infix ` ≻₅ `:60 := S5.deduction

-- Derived rules for negation
def S5.deduction.neg_intro {X} {A : MForm α} : (X ∪ {A}) ≻₅ ⊥ → X ≻₅ ¬A := S5.deduction.imp_intro
def S5.deduction.neg_elim {X Y} (A : MForm α) : X ≻₅ ¬A → Y ≻₅ A → X ∪ Y ≻₅ ⊥ := S5.deduction.imp_elim A
def S5.deduction.imp_elim' {X} (A : MForm α) {B} : X ≻₅ (A ⟹ B) → X ≻₅ A → X ≻₅ B :=
  λ h k, by { convert S5.deduction.imp_elim _ h k, tidy}
def S5.deduction.neg_elim' {X} (A : MForm α) : X ≻₅ ¬A → X ≻₅ A → X ≻₅ ⊥ := S5.deduction.imp_elim' A
def S5.deduction.and_intro' {X} (A : MForm α) {B} : X ≻₅ A → X ≻₅ B → X ≻₅ A ⋀ B :=
  λ h k, by { convert S5.deduction.and_intro h k, tidy}
def S5.deduction.or_elim' {X} (A B : MForm α) {C} : X ≻₅ A ⋁ B → X ∪ {A} ≻₅ C → X ∪ {B} ≻₅ C → X ≻₅ C :=
  λ h j k, by { convert S5.deduction.or_elim A B h j k, tidy }

def S5.deduction.nec_intro' {X} {A : MForm α} : (∀ B ∈ X, modal B) → X ≻₅ A → X  ≻₅ □A :=
  λ mX h, S5.deduction.nec_intro X mX set.subset.rfl h

notation `⋀I` := S5.deduction.and_intro
notation `⋀I'` := S5.deduction.and_intro'
notation `⋀E₁` := S5.deduction.and_left
notation `⋀E₂` := S5.deduction.and_right
notation `⟹I` := S5.deduction.imp_intro
notation `⟹E` := S5.deduction.imp_elim
notation `⟹E'` := S5.deduction.imp_elim'
notation `⋁E` := S5.deduction.or_elim
notation `⋁E'` := S5.deduction.or_elim'
notation `⋁I₁` := S5.deduction.or_left
notation `⋁I₂` := S5.deduction.or_right
notation `⊥E` := S5.deduction.falsum
notation `¬I` := S5.deduction.neg_intro
notation `¬E` := S5.deduction.neg_elim
notation `¬E'` := S5.deduction.neg_elim'
notation `DNE` := S5.deduction.dne
notation `□I` := S5.deduction.nec_intro
notation `□I'` := S5.deduction.nec_intro'
notation `□E` := S5.deduction.nec_elim
notation `◇I` := S5.deduction.pos_intro
notation `◇E` := S5.deduction.pos_elim

structure pwm (α W : Type) :=
(worlds : set W)
(val : α → W → bool)

-- def models {α W} (M : pwm α W) : Π (w ∈ M.worlds), MForm α → Prop
-- | w _ ⊥ := false
-- | w h (p : α) := M.val p w = tt
-- | w h (A ⋀ B) := models w h A ∧ models w h B
-- | w h (A ⋁ B) := models w h A ∨ models w h B
-- | w h (A ⟹ B) := models w h A → models w h B
-- | _ _ (◇A) := ∃ u ∈ M.worlds, models u (by assumption) A
-- | _ _ (□A) := ∀ u ∈ M.worlds, models u (by assumption) A

-- def countermodel {α W} (X : set (MForm α)) (A : MForm α) :=
-- {C : pwm α W × W   // C.2 ∈ C.1.worlds ∧ (∀ F ∈ X, models M w (by assumption) F) ∧  }

-- structure countermodel {α β : Type} (X : set (MForm α)) (A : MForm α) extends model α β :=
-- (cw : β)
-- (cw_here : cw ∈ worlds)
-- (premises_true : ∀ F ∈ X, models )
-- (conclustion_false : ∀ F ∈ X, val )

/-- A tactic to produce a deduction of something like `X ∪ {A} ≻ A`,
via the assumption rule and an automated proof of `A ∈ X ∪ {A}`
-/
meta def tactic.interactive.assump : tactic unit :=
  do `[apply S5.deduction.assumption _; obviously]