import category_theory.limits.shapes.kernels
import category_theory.limits.functor_category
import category_theory.preadditive.functor_category
import category_theory.additive.basic
import category_theory.abelian.exact

-- This can be removed after #13686 is merged

namespace category_theory

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

open category_theory.limits

example [has_zero_morphisms D] : has_zero_morphisms (C ⥤ D) := infer_instance
example [preadditive D] : preadditive (C ⥤ D) := infer_instance

noncomputable theory

section kernels

variables [has_zero_morphisms D] [has_kernels D]

@[simps]
def nat_trans.kernel_functor {F G : C ⥤ D} (η : F ⟶ G) : C ⥤ D :=
{ obj := λ X, kernel (η.app X),
  map := λ X Y f, kernel.map _ _ (F.map f) (G.map f) (η.naturality f).symm,
  map_id' := λ X, by { ext, simp },
  map_comp' := λ X Y Z f g, by { ext, simp } }

@[simps]
def nat_trans.kernel_ι {F G : C ⥤ D} (η : F ⟶ G) :
  η.kernel_functor ⟶ F :=
{ app := λ X, kernel.ι _,
  naturality' := λ X Y f, by simp }

@[simps]
def nat_trans.kernel_fork {F G : C ⥤ D} (η : F ⟶ G) :
  kernel_fork η :=
limits.kernel_fork.of_ι η.kernel_ι $ by { ext, simp }

@[simps]
def nat_trans.is_limit_kernel_fork {F G : C ⥤ D} (η : F ⟶ G) :
  is_limit η.kernel_fork :=
is_limit_aux _ (λ S,
  { app := λ X, kernel.lift _ (S.ι.app X) $ by simp [← nat_trans.comp_app],
    naturality' := λ X Y f, by { ext, dsimp, simp } })
begin
  intros S,
  ext,
  delta fork.ι,
  dsimp,
  simp only [kernel.lift_ι],
end begin
  intros S m hm,
  ext X,
  apply_fun (λ e, e.app X) at hm,
  delta fork.ι at hm,
  dsimp at ⊢ hm,
  simp only [hm, kernel.lift_ι],
end

instance functor_category_has_kernels :
  has_kernels (C ⥤ D) := ⟨λ F G η, ⟨⟨⟨_, η.is_limit_kernel_fork⟩⟩⟩⟩

def nat_trans.kernel_obj_iso {F G : C ⥤ D} (η : F ⟶ G) (X : C) :
  (kernel η).obj X ≅ kernel (η.app X) :=
((limit.is_limit _).cone_point_unique_up_to_iso η.is_limit_kernel_fork).app X

@[simp, reassoc]
lemma nat_trans.kernel_obj_iso_hom_ι {F G : C ⥤ D} (η : F ⟶ G) (X : C) :
  (nat_trans.kernel_obj_iso η X).hom ≫ kernel.ι (η.app X) = (kernel.ι η).app X :=
begin
  have h := ((limit.is_limit _).unique_up_to_iso η.is_limit_kernel_fork).hom.w
    walking_parallel_pair.zero,
  apply_fun (λ e, e.app X) at h,
  exact h
end

@[simp, reassoc]
lemma nat_trans.kernel_obj_iso_inv_ι {F G : C ⥤ D} (η : F ⟶ G) (X : C) :
  (nat_trans.kernel_obj_iso η X).inv ≫ (kernel.ι η).app X = kernel.ι _ :=
by simp [iso.inv_comp_eq]

@[simps]
def nat_trans.cokernel_kernel_ι_iso [has_cokernels D] {F G : C ⥤ D} (η : F ⟶ G) (X : C) :
  cokernel ((kernel.ι η).app X) ≅ cokernel (kernel.ι (η.app X)) :=
{ hom := cokernel.map _ _ (nat_trans.kernel_obj_iso _ _).hom (𝟙 _) (by simp),
  inv := cokernel.map _ _ (nat_trans.kernel_obj_iso _ _).inv (𝟙 _) (by simp),
  hom_inv_id' := by { ext, dsimp, simp },
  inv_hom_id' := by { ext, dsimp, simp } }

end kernels

section cokernels

variables [has_zero_morphisms D] [has_cokernels D]

@[simps]
def nat_trans.cokernel_functor {F G : C ⥤ D} (η : F ⟶ G) : C ⥤ D :=
{ obj := λ X, cokernel (η.app X),
  map := λ X Y f, cokernel.map _ _ (F.map f) (G.map f) (η.naturality f).symm,
  map_id' := λ X, by { ext, simp },
  map_comp' := λ X Y Z f g, by { ext, simp } }

@[simps]
def nat_trans.cokernel_π {F G : C ⥤ D} (η : F ⟶ G) :
  G ⟶ η.cokernel_functor :=
{ app := λ X, cokernel.π _,
  naturality' := λ X Y f, by simp }

@[simps]
def nat_trans.cokernel_cofork {F G : C ⥤ D} (η : F ⟶ G) :
  cokernel_cofork η :=
limits.cokernel_cofork.of_π η.cokernel_π $ by { ext, simp }

@[simps]
def nat_trans.is_colimit_cokernel_cofork {F G : C ⥤ D} (η : F ⟶ G) :
  is_colimit η.cokernel_cofork :=
is_colimit_aux _ (λ S,
  { app := λ X, cokernel.desc _ (S.π.app X) $ by simp [← nat_trans.comp_app],
    naturality' := λ X Y f, by { ext, dsimp, simp } })
begin
  intros S,
  ext,
  delta cofork.π,
  dsimp,
  simp only [cokernel.π_desc],
end begin
  intros S m hm,
  ext X,
  apply_fun (λ e, e.app X) at hm,
  delta cofork.π at hm,
  dsimp at ⊢ hm,
  simp only [hm, cokernel.π_desc]
end

instance functor_category_has_cokernels :
  has_cokernels (C ⥤ D) := ⟨λ F G η, ⟨⟨⟨_, η.is_colimit_cokernel_cofork⟩⟩⟩⟩

def nat_trans.cokernel_obj_iso {F G : C ⥤ D} (η : F ⟶ G) (X : C) :
  (cokernel η).obj X ≅ cokernel (η.app X) :=
((colimit.is_colimit _).cocone_point_unique_up_to_iso η.is_colimit_cokernel_cofork).app X

@[simp, reassoc]
lemma nat_trans.cokernel_obj_iso_π_hom {F G : C ⥤ D} (η : F ⟶ G) (X : C) :
  (cokernel.π η).app X ≫ (nat_trans.cokernel_obj_iso η X).hom = cokernel.π _ :=
begin
  have h := ((colimit.is_colimit _).unique_up_to_iso η.is_colimit_cokernel_cofork).hom.w
    walking_parallel_pair.one,
  apply_fun (λ e, e.app X) at h,
  exact h,
end

@[simp, reassoc]
lemma nat_trans.cokernel_obj_iso_π_inv {F G : C ⥤ D} (η : F ⟶ G) (X : C) :
  cokernel.π (η.app X) ≫ (nat_trans.cokernel_obj_iso η X).inv = (cokernel.π η).app X :=
by simp [iso.comp_inv_eq]

@[simps]
def nat_trans.kernel_cokernel_π_iso [has_kernels D] {F G : C ⥤ D} (η : F ⟶ G) (X : C) :
  kernel ((cokernel.π η).app X) ≅ kernel (cokernel.π (η.app X)) :=
{ hom := kernel.map _ _ (𝟙 _) (nat_trans.cokernel_obj_iso η X).hom (by simp),
  inv := kernel.map _ _ (𝟙 _) (nat_trans.cokernel_obj_iso η X).inv (by simp),
  hom_inv_id' := by { ext, dsimp, simp },
  inv_hom_id' := by { ext, dsimp, simp } }

end cokernels

section cokernels_and_kernels

variables [has_zero_morphisms D] [has_cokernels D] [has_kernels D]

lemma nat_trans.coimage_image_comparison_app {F G : C ⥤ D} (η : F ⟶ G) (X : C) :
 (nat_trans.cokernel_kernel_ι_iso _ _).inv ≫
 (nat_trans.cokernel_obj_iso _ _).inv ≫ (abelian.coimage_image_comparison η).app X ≫
 (nat_trans.kernel_obj_iso _ _).hom ≫
 (nat_trans.kernel_cokernel_π_iso _ _).hom = abelian.coimage_image_comparison (η.app X) :=
begin
  dsimp [abelian.coimage_image_comparison],
  ext,
  dsimp [nat_trans.cokernel_obj_iso, is_colimit.cocone_point_unique_up_to_iso],
  dsimp [nat_trans.kernel_obj_iso, is_limit.cone_point_unique_up_to_iso],
  simp,
end

end cokernels_and_kernels

section additivity

variables [additive_category D]

instance : additive_category (C ⥤ D) :=
{ has_biproducts_of_shape := begin
    introsI J _,
    constructor,
    intros F,
    apply limits.has_biproduct.of_has_product
  end,
  -- without the infer instance, this becomes REALLY slow...
  ..(infer_instance : preadditive (C ⥤ D)) }

end additivity

section abelian

variable [abelian D]

instance additive_category_of_abelian : additive_category D :=
{ ..(infer_instance : preadditive D) } -- without the infer instance, this becomes REALLY slow...

instance functor_category_is_iso_coim_to_im_app {F G : C ⥤ D} (η : F ⟶ G) (X : C) :
  is_iso ((abelian.coimage_image_comparison η).app X) :=
begin
  have : (abelian.coimage_image_comparison η).app X =
    (nat_trans.cokernel_obj_iso _ _).hom ≫
    (nat_trans.cokernel_kernel_ι_iso _ _).hom ≫
    abelian.coimage_image_comparison _ ≫
    (nat_trans.kernel_cokernel_π_iso _ _).inv ≫
    (nat_trans.kernel_obj_iso _ _).inv,
  { rw ← nat_trans.coimage_image_comparison_app,
    simp only [category.assoc, iso.inv_hom_id, iso.inv_hom_id_assoc,
      iso.hom_inv_id, iso.hom_inv_id_assoc, category.comp_id] },
  rw this,
  apply is_iso.comp_is_iso,
end

instance functor_category_is_iso_coim_to_im {F G : C ⥤ D} (η : F ⟶ G) :
  is_iso (abelian.coimage_image_comparison η) := nat_iso.is_iso_of_is_iso_app _

instance functor_category_is_abelian : abelian (C ⥤ D) :=
abelian.of_coimage_image_comparison_is_iso

theorem nat_trans.exact_iff_forall {F G H : C ⥤ D} (η : F ⟶ G) (γ : G ⟶ H) :
  exact η γ ↔ (∀ j, exact (η.app j) (γ.app j)) :=
begin
  simp_rw abelian.exact_iff,
  split,
  { rintros ⟨h1,h2⟩ j,
    split,
    { apply_fun (λ e, e.app j) at h1, simpa using h1 },
    { apply_fun (λ e, e.app j) at h2,
      simp only [nat_trans.comp_app, nat_trans.app_zero] at h2,
      let eK : (kernel γ).obj j ≅ kernel (γ.app j) :=
        (nat_trans.kernel_obj_iso γ j),
      let eQ : (cokernel η).obj j ≅ cokernel (η.app j) :=
        (nat_trans.cokernel_obj_iso η j),
      have : kernel.ι (γ.app j) = eK.inv ≫ (kernel.ι γ).app j, by simp, rw this, clear this,
      have : cokernel.π (η.app j) = (cokernel.π η).app j ≫ eQ.hom, by simp, rw this, clear this,
      simp only [category.assoc, reassoc_of h2, zero_comp, comp_zero] } },
  { intros h,
    split,
    { ext j,
      exact (h j).1 },
    { ext j,
      dsimp,
      let eK : (kernel γ).obj j ≅ kernel (γ.app j) :=
        (nat_trans.kernel_obj_iso γ j),
      let eQ : (cokernel η).obj j ≅ cokernel (η.app j) :=
        (nat_trans.cokernel_obj_iso η j),
      have : (kernel.ι γ).app j = eK.hom ≫ kernel.ι _, by simp, rw this, clear this,
      have : (cokernel.π η).app j = cokernel.π _ ≫ eQ.inv, by simp, rw this, clear this,
      simp only [category.assoc, reassoc_of (h j).2, comp_zero, zero_comp] } },
end

set_option pp.universes true

-- We need to help lean out a little bit because of the `max` in the universe parameters above.
instance functor_category_is_abelian' {A : Type u} [category.{v} A] [abelian A]
  {J : Type v} [small_category J] : abelian (J ⥤ A) :=
@category_theory.functor_category_is_abelian.{u v v} J _ A _ _

end abelian

end category_theory


import number_theory.padics.padic_integers

--OUTPUT 1
theorem p_adic_units (p : ℕ) (x : ℕ) (h : coprime p x) : is_unit (x : ℤ_p) :=
begin
  -- prove the contrapositive
  have h1 : ¬ is_unit (x : ℤ_p) → ¬ coprime p x, from sorry,
  -- we know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1
  have h2 : is_unit (x : ℤ_p) ↔ (x : ℤ_p).norm = 1, from sorry,
  -- thus $\Vert x \Vert \neq 1$
  have h3 : ¬ is_unit (x : ℤ_p) → (x : ℤ_p).norm ≠ 1, from sorry,
  -- Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1
  have h4 : (x : ℤ_p).norm ≤ 1, from sorry,
  -- we conclude that $\Vert x \Vert < 1$
  have h5 : ¬ is_unit (x : ℤ_p) → (x : ℤ_p).norm < 1, from sorry,
  -- But this must imply that $p | x$
  have h6 : ¬ is_unit (x : ℤ_p) → p ∣ x, from sorry,
  -- This completes our proof.
  show is_unit (x : ℤ_p), from sorry,
end

--OUTPUT 2
theorem p_adic_units (p : ℕ) (x : ℕ) (h : nat.coprime p x) : (x : ℤ_[p]) ∈ units ℤ_[p] :=
begin
  -- prove the contrapositive
  have h1 : ¬ (x : ℤ_[p]) ∈ units ℤ_[p] → ¬ nat.coprime p x, from sorry,
  have h2 : ¬ (x : ℤ_[p]) ∈ units ℤ_[p] → p ∣ x, from sorry,
  have h3 : ¬ nat.coprime p x → p ∣ x, from sorry,
  show (x : ℤ_[p]) ∈ units ℤ_[p], from sorry,
end

--OUTPUT 3
theorem p_adic_units (p : ℕ) (x : ℕ) (h : coprime p x) : is_unit (x : ℤ_[p]) :=
begin
  -- prove the contrapositive
  have h1 : ¬ is_unit (x : ℤ_[p]) → ¬ coprime p x, from sorry,
  have h2 : ¬ is_unit (x : ℤ_[p]) → p ∣ x, from sorry,
  show is_unit (x : ℤ_[p]), from sorry,
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from sorry,
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from sorry,
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from sorry,
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by sorry
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by sorry
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by sorry,
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
end

/--`theorem`
p-adic units
Given a prime number $p$ and a natural number $x$, if $x$ is coprime to $p$, then $x$ is a unit in the $p$-adic integers.
`proof`
Let us prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, thus $\Vert x \Vert \neq 1$. Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$.
But this must imply that $p | x$.
This completes our proof.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


/-Partitions Part 1-/

section

parameter α : Type

structure part := (box : α -> α -> Prop) (is_equiv : is_equiv _ box)

def refines (pl pr : part) := ∀ x y, pr.box x y -> pl.box x y

lemma refines_refl : ∀ p, refines p p
| p := begin simp [refines], intros, assumption end

lemma refines_trans : ∀ a b c, refines a b -> refines b c -> refines a c :=
  begin simp [refines], intros a b c ab bc x y H
              , apply (ab x y (bc x y H)) end

#print refines_trans

instance Part_preorder : preorder part :=
{preorder
. le := refines
, le_refl := refines_refl
, le_trans :=
}

#print

end


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

import topology.sheaves.sheaf_condition.opens_le_cover
import category_theory.limits.final
import category_theory.limits.preserves.basic
import category_theory.category.pairwise
import category_theory.limits.constructions.binary_products
import algebra.category.Ring.constructions

/-!
# Equivalent formulations of the sheaf condition

We give an equivalent formulation of the sheaf condition.

Given any indexed type `ι`, we define `overlap ι`,
a category with objects corresponding to
* individual open sets, `single i`, and
* intersections of pairs of open sets, `pair i j`,
with morphisms from `pair i j` to both `single i` and `single j`.

Any open cover `U : ι → opens X` provides a functor `diagram U : overlap ι ⥤ (opens X)ᵒᵖ`.

There is a canonical cone over this functor, `cone U`, whose cone point is `supr U`,
and in fact this is a limit cone.

A presheaf `F : presheaf C X` is a sheaf precisely if it preserves this limit.
We express this in two equivalent ways, as
* `is_limit (F.map_cone (cone U))`, or
* `preserves_limit (diagram U) F`

We show that this sheaf condition is equivalent to the `opens_le_cover` sheaf condition, and
thereby also equivalent to the default sheaf condition.
-/

noncomputable theory

universes w v u

open topological_space Top opposite category_theory category_theory.limits

variables {C : Type u} [category.{v} C] {X : Top.{w}}

namespace Top.presheaf

section

/--
An alternative formulation of the sheaf condition
(which we prove equivalent to the usual one below as
`is_sheaf_iff_is_sheaf_pairwise_intersections`).

A presheaf is a sheaf if `F` sends the cone `(pairwise.cocone U).op` to a limit cone.
(Recall `pairwise.cocone U` has cone point `supr U`, mapping down to the `U i` and the `U i ⊓ U j`.)
-/
def is_sheaf_pairwise_intersections (F : presheaf C X) : Prop :=
∀ ⦃ι : Type w⦄ (U : ι → opens X), nonempty (is_limit (F.map_cone (pairwise.cocone U).op))

/--
An alternative formulation of the sheaf condition
(which we prove equivalent to the usual one below as
`is_sheaf_iff_is_sheaf_preserves_limit_pairwise_intersections`).

A presheaf is a sheaf if `F` preserves the limit of `pairwise.diagram U`.
(Recall `pairwise.diagram U` is the diagram consisting of the pairwise intersections
`U i ⊓ U j` mapping into the open sets `U i`. This diagram has limit `supr U`.)
-/
def is_sheaf_preserves_limit_pairwise_intersections (F : presheaf C X) : Prop :=
∀ ⦃ι : Type w⦄ (U : ι → opens X), nonempty (preserves_limit (pairwise.diagram U).op F)

end

namespace sheaf_condition

variables {ι : Type w} (U : ι → opens X)

open category_theory.pairwise

/--
Implementation detail:
the object level of `pairwise_to_opens_le_cover : pairwise ι ⥤ opens_le_cover U`
-/
@[simp]
def pairwise_to_opens_le_cover_obj : pairwise ι → opens_le_cover U
| (single i) := ⟨U i, ⟨i, le_rfl⟩⟩
| (pair i j) := ⟨U i ⊓ U j, ⟨i, inf_le_left⟩⟩

open category_theory.pairwise.hom

/--
Implementation detail:
the morphism level of `pairwise_to_opens_le_cover : pairwise ι ⥤ opens_le_cover U`
-/
def pairwise_to_opens_le_cover_map :
  Π {V W : pairwise ι},
    (V ⟶ W) → (pairwise_to_opens_le_cover_obj U V ⟶ pairwise_to_opens_le_cover_obj U W)
| _ _ (id_single i) := 𝟙 _
| _ _ (id_pair i j) := 𝟙 _
| _ _ (left i j) := hom_of_le inf_le_left
| _ _ (right i j) := hom_of_le inf_le_right

/--
The category of single and double intersections of the `U i` maps into the category
of open sets below some `U i`.
-/
@[simps]
def pairwise_to_opens_le_cover : pairwise ι ⥤ opens_le_cover U :=
{ obj := pairwise_to_opens_le_cover_obj U,
  map := λ V W i, pairwise_to_opens_le_cover_map U i, }

instance (V : opens_le_cover U) :
  nonempty (structured_arrow V (pairwise_to_opens_le_cover U)) :=
⟨@structured_arrow.mk _ _ _ _ _ (single (V.index)) _ (by exact V.hom_to_index)⟩

/--
The diagram consisting of the `U i` and `U i ⊓ U j` is cofinal in the diagram
of all opens contained in some `U i`.
-/
-- This is a case bash: for each pair of types of objects in `pairwise ι`,
-- we have to explicitly construct a zigzag.
instance : functor.final (pairwise_to_opens_le_cover U) :=
⟨λ V, is_connected_of_zigzag $ λ A B, begin
  rcases A with ⟨⟨⟨⟩⟩, ⟨i⟩|⟨i,j⟩, a⟩;
  rcases B with ⟨⟨⟨⟩⟩, ⟨i'⟩|⟨i',j'⟩, b⟩;
  dsimp at *,
  { refine ⟨[
    { left := ⟨⟨⟩⟩, right := pair i i',
      hom := (le_inf a.le b.le).hom, }, _], _, rfl⟩,
    exact
      list.chain.cons (or.inr ⟨{ left := 𝟙 _, right := left i i', }⟩)
        (list.chain.cons (or.inl ⟨{ left := 𝟙 _, right := right i i', }⟩) list.chain.nil) },
  { refine ⟨[
    { left := ⟨⟨⟩⟩, right := pair i' i,
      hom := (le_inf (b.le.trans inf_le_left) a.le).hom, },
    { left := ⟨⟨⟩⟩, right := single i',
      hom := (b.le.trans inf_le_left).hom, }, _], _, rfl⟩,
    exact
      list.chain.cons (or.inr ⟨{ left := 𝟙 _, right := right i' i, }⟩)
        (list.chain.cons (or.inl ⟨{ left := 𝟙 _, right := left i' i, }⟩)
          (list.chain.cons (or.inr ⟨{ left := 𝟙 _, right := left i' j', }⟩) list.chain.nil)) },
  { refine ⟨[
    { left := ⟨⟨⟩⟩, right := single i,
      hom := (a.le.trans inf_le_left).hom, },
    { left := ⟨⟨⟩⟩, right := pair i i', hom :=
      (le_inf (a.le.trans inf_le_left) b.le).hom, }, _], _, rfl⟩,
    exact
      list.chain.cons (or.inl ⟨{ left := 𝟙 _, right := left i j, }⟩)
        (list.chain.cons (or.inr ⟨{ left := 𝟙 _, right := left i i', }⟩)
          (list.chain.cons (or.inl ⟨{ left := 𝟙 _, right := right i i', }⟩) list.chain.nil)) },
  { refine ⟨[
    { left := ⟨⟨⟩⟩, right := single i,
      hom := (a.le.trans inf_le_left).hom, },
    { left := ⟨⟨⟩⟩, right := pair i i',
      hom := (le_inf (a.le.trans inf_le_left) (b.le.trans inf_le_left)).hom, },
    { left := ⟨⟨⟩⟩, right := single i',
      hom := (b.le.trans inf_le_left).hom, }, _], _, rfl⟩,
    exact
      list.chain.cons (or.inl ⟨{ left := 𝟙 _, right := left i j, }⟩)
      (list.chain.cons (or.inr ⟨{ left := 𝟙 _, right := left i i', }⟩)
      (list.chain.cons (or.inl ⟨{ left := 𝟙 _, right := right i i', }⟩)
      (list.chain.cons (or.inr ⟨{ left := 𝟙 _, right := left i' j', }⟩) list.chain.nil))), },
end⟩

/--
The diagram in `opens X` indexed by pairwise intersections from `U` is isomorphic
(in fact, equal) to the diagram factored through `opens_le_cover U`.
-/
def pairwise_diagram_iso :
  pairwise.diagram U ≅
  pairwise_to_opens_le_cover U ⋙ full_subcategory_inclusion _ :=
{ hom := { app := begin rintro (i|⟨i,j⟩); exact 𝟙 _, end, },
  inv := { app := begin rintro (i|⟨i,j⟩); exact 𝟙 _, end, }, }

/--
The cocone `pairwise.cocone U` with cocone point `supr U` over `pairwise.diagram U` is isomorphic
to the cocone `opens_le_cover_cocone U` (with the same cocone point)
after appropriate whiskering and postcomposition.
-/
def pairwise_cocone_iso :
  (pairwise.cocone U).op ≅
  (cones.postcompose_equivalence (nat_iso.op (pairwise_diagram_iso U : _) : _)).functor.obj
    ((opens_le_cover_cocone U).op.whisker (pairwise_to_opens_le_cover U).op) :=
cones.ext (iso.refl _) (by tidy)

end sheaf_condition

open sheaf_condition

variable (F : presheaf C X)

/--
The sheaf condition
in terms of a limit diagram over all `{ V : opens X // ∃ i, V ≤ U i }`
is equivalent to the reformulation
in terms of a limit diagram over `U i` and `U i ⊓ U j`.
-/
lemma is_sheaf_opens_le_cover_iff_is_sheaf_pairwise_intersections :
  F.is_sheaf_opens_le_cover ↔ F.is_sheaf_pairwise_intersections :=
forall₂_congr $ λ ι U, equiv.nonempty_congr $
  calc is_limit (F.map_cone (opens_le_cover_cocone U).op)
    ≃ is_limit ((F.map_cone (opens_le_cover_cocone U).op).whisker (pairwise_to_opens_le_cover U).op)
        : (functor.initial.is_limit_whisker_equiv (pairwise_to_opens_le_cover U).op _).symm
... ≃ is_limit (F.map_cone ((opens_le_cover_cocone U).op.whisker (pairwise_to_opens_le_cover U).op))
        : is_limit.equiv_iso_limit F.map_cone_whisker.symm
... ≃ is_limit ((cones.postcompose_equivalence _).functor.obj
          (F.map_cone ((opens_le_cover_cocone U).op.whisker (pairwise_to_opens_le_cover U).op)))
        : (is_limit.postcompose_hom_equiv _ _).symm
... ≃ is_limit (F.map_cone ((cones.postcompose_equivalence _).functor.obj
          ((opens_le_cover_cocone U).op.whisker (pairwise_to_opens_le_cover U).op)))
        : is_limit.equiv_iso_limit (functor.map_cone_postcompose_equivalence_functor _).symm
... ≃ is_limit (F.map_cone (pairwise.cocone U).op)
        : is_limit.equiv_iso_limit
            ((cones.functoriality _ _).map_iso (pairwise_cocone_iso U : _).symm)

/--
The sheaf condition in terms of an equalizer diagram is equivalent
to the reformulation in terms of a limit diagram over `U i` and `U i ⊓ U j`.
-/
lemma is_sheaf_iff_is_sheaf_pairwise_intersections :
  F.is_sheaf ↔ F.is_sheaf_pairwise_intersections :=
by rw [is_sheaf_iff_is_sheaf_opens_le_cover,
  is_sheaf_opens_le_cover_iff_is_sheaf_pairwise_intersections]

/--
The sheaf condition in terms of an equalizer diagram is equivalent
to the reformulation in terms of the presheaf preserving the limit of the diagram
consisting of the `U i` and `U i ⊓ U j`.
-/
lemma is_sheaf_iff_is_sheaf_preserves_limit_pairwise_intersections :
  F.is_sheaf ↔ F.is_sheaf_preserves_limit_pairwise_intersections :=
begin
  rw is_sheaf_iff_is_sheaf_pairwise_intersections,
  split,
  { intros h ι U,
    exact ⟨preserves_limit_of_preserves_limit_cone (pairwise.cocone_is_colimit U).op (h U).some⟩ },
  { intros h ι U,
    haveI := (h U).some,
    exact ⟨preserves_limit.preserves (pairwise.cocone_is_colimit U).op⟩ }
end

end Top.presheaf

namespace Top.sheaf

variables (F : X.sheaf C) (U V : opens X)
open category_theory.limits

/-- For a sheaf `F`, `F(U ⊔ V)` is the pullback of `F(U) ⟶ F(U ⊓ V)` and `F(V) ⟶ F(U ⊓ V)`.
This is the pullback cone. -/
def inter_union_pullback_cone : pullback_cone
  (F.1.map (hom_of_le inf_le_left : U ⊓ V ⟶ _).op) (F.1.map (hom_of_le inf_le_right).op) :=
pullback_cone.mk (F.1.map (hom_of_le le_sup_left).op) (F.1.map (hom_of_le le_sup_right).op)
  (by { rw [← F.1.map_comp, ← F.1.map_comp], congr })

@[simp] lemma inter_union_pullback_cone_X :
  (inter_union_pullback_cone F U V).X = F.1.obj (op $ U ⊔ V) := rfl
@[simp] lemma inter_union_pullback_cone_fst :
  (inter_union_pullback_cone F U V).fst = F.1.map (hom_of_le le_sup_left).op := rfl
@[simp] lemma inter_union_pullback_cone_snd :
  (inter_union_pullback_cone F U V).snd = F.1.map (hom_of_le le_sup_right).op := rfl

variable (s : pullback_cone
  (F.1.map (hom_of_le inf_le_left : U ⊓ V ⟶ _).op) (F.1.map (hom_of_le inf_le_right).op))

/-- (Implementation).
Every cone over `F(U) ⟶ F(U ⊓ V)` and `F(V) ⟶ F(U ⊓ V)` factors through `F(U ⊔ V)`.
-/
def inter_union_pullback_cone_lift : s.X ⟶ F.1.obj (op (U ⊔ V)) :=
begin
  let ι : ulift.{w} walking_pair → opens X := λ j, walking_pair.cases_on j.down U V,
  have hι : U ⊔ V = supr ι,
  { ext,
    rw [opens.coe_supr, set.mem_Union],
    split,
    { rintros (h|h),
      exacts [⟨⟨walking_pair.left⟩, h⟩, ⟨⟨walking_pair.right⟩, h⟩] },
    { rintro ⟨⟨_ | _⟩, h⟩,
      exacts [or.inl h, or.inr h] } },
  refine (F.presheaf.is_sheaf_iff_is_sheaf_pairwise_intersections.mp F.2 ι).some.lift
    ⟨s.X, { app := _, naturality' := _ }⟩ ≫ F.1.map (eq_to_hom hι).op,
  { apply opposite.rec,
    rintro ((_|_)|(_|_)),
    exacts [s.fst, s.snd, s.fst ≫ F.1.map (hom_of_le inf_le_left).op,
      s.snd ≫ F.1.map (hom_of_le inf_le_left).op] },
  rintros i j f,
  induction i using opposite.rec,
  induction j using opposite.rec,
  let g : j ⟶ i := f.unop, have : f = g.op := rfl, clear_value g, subst this,
  rcases i with (⟨⟨(_|_)⟩⟩|⟨⟨(_|_)⟩,⟨_⟩⟩); rcases j with (⟨⟨(_|_)⟩⟩|⟨⟨(_|_)⟩,⟨_⟩⟩); rcases g; dsimp;
    simp only [category.id_comp, s.condition, category_theory.functor.map_id, category.comp_id],
  { rw [← cancel_mono (F.1.map (eq_to_hom $ inf_comm : U ⊓ V ⟶ _).op), category.assoc,
      category.assoc],
    erw [← F.1.map_comp, ← F.1.map_comp],
    convert s.condition.symm },
end

lemma inter_union_pullback_cone_lift_left :
  inter_union_pullback_cone_lift F U V s ≫ F.1.map (hom_of_le le_sup_left).op = s.fst :=
begin
  erw [category.assoc, ←F.1.map_comp],
  exact (F.presheaf.is_sheaf_iff_is_sheaf_pairwise_intersections.mp F.2 _).some.fac _
    (op $ pairwise.single (ulift.up walking_pair.left))
end

lemma inter_union_pullback_cone_lift_right :
  inter_union_pullback_cone_lift F U V s ≫ F.1.map (hom_of_le le_sup_right).op = s.snd :=
begin
  erw [category.assoc, ←F.1.map_comp],
  exact (F.presheaf.is_sheaf_iff_is_sheaf_pairwise_intersections.mp F.2 _).some.fac _
    (op $ pairwise.single (ulift.up walking_pair.right))
end

/-- For a sheaf `F`, `F(U ⊔ V)` is the pullback of `F(U) ⟶ F(U ⊓ V)` and `F(V) ⟶ F(U ⊓ V)`. -/
def is_limit_pullback_cone : is_limit (inter_union_pullback_cone F U V) :=
begin
  let ι : ulift.{w} walking_pair → opens X := λ ⟨j⟩, walking_pair.cases_on j U V,
  have hι : U ⊔ V = supr ι,
  { ext,
    rw [opens.coe_supr, set.mem_Union],
    split,
    { rintros (h|h),
      exacts [⟨⟨walking_pair.left⟩, h⟩, ⟨⟨walking_pair.right⟩, h⟩] },
    { rintro ⟨⟨_ | _⟩, h⟩,
      exacts [or.inl h, or.inr h] } },
  apply pullback_cone.is_limit_aux',
  intro s,
  use inter_union_pullback_cone_lift F U V s,
  refine ⟨_,_,_⟩,
  { apply inter_union_pullback_cone_lift_left },
  { apply inter_union_pullback_cone_lift_right },
  { intros m h₁ h₂,
    rw ← cancel_mono (F.1.map (eq_to_hom hι.symm).op),
    apply (F.presheaf.is_sheaf_iff_is_sheaf_pairwise_intersections.mp F.2 ι).some.hom_ext,
    apply opposite.rec,
    rintro ((_|_)|(_|_)); rw [category.assoc, category.assoc],
    { erw ← F.1.map_comp,
      convert h₁,
      apply inter_union_pullback_cone_lift_left },
    { erw ← F.1.map_comp,
      convert h₂,
      apply inter_union_pullback_cone_lift_right },
    all_goals
    { dsimp only [functor.op, pairwise.cocone_ι_app, functor.map_cone_π_app,
        cocone.op, pairwise.cocone_ι_app_2, unop_op, op_comp, nat_trans.op],
      simp_rw [F.1.map_comp, ← category.assoc],
      congr' 1,
      simp_rw [category.assoc, ← F.1.map_comp] },
    { convert h₁,
      apply inter_union_pullback_cone_lift_left },
    { convert h₂,
      apply inter_union_pullback_cone_lift_right } }
end

/-- If `U, V` are disjoint, then `F(U ⊔ V) = F(U) × F(V)`. -/
def is_product_of_disjoint (h : U ⊓ V = ⊥) : is_limit
    (binary_fan.mk (F.1.map (hom_of_le le_sup_left : _ ⟶ U ⊔ V).op)
      (F.1.map (hom_of_le le_sup_right : _ ⟶ U ⊔ V).op)) :=
is_product_of_is_terminal_is_pullback _ _ _ _
  (F.is_terminal_of_eq_empty h) (is_limit_pullback_cone F U V)

/-- `F(U ⊔ V)` is isomorphic to the `eq_locus` of the two maps `F(U) × F(V) ⟶ F(U ⊓ V)`. -/
def obj_sup_iso_prod_eq_locus {X : Top} (F : X.sheaf CommRing)
  (U V : opens X) :
  F.1.obj (op $ U ⊔ V) ≅ CommRing.of (ring_hom.eq_locus _ _) :=
(F.is_limit_pullback_cone U V).cone_point_unique_up_to_iso (CommRing.pullback_cone_is_limit _ _)

lemma obj_sup_iso_prod_eq_locus_hom_snd {X : Top} (F : X.sheaf CommRing)
  (U V : opens X) (x) :
  ((F.obj_sup_iso_prod_eq_locus U V).hom x).1.snd = F.1.map (hom_of_le le_sup_right).op x :=
concrete_category.congr_hom ((F.is_limit_pullback_cone U V).cone_point_unique_up_to_iso_hom_comp
  (CommRing.pullback_cone_is_limit _ _) walking_cospan.right) x

lemma obj_sup_iso_prod_eq_locus_inv_fst {X : Top} (F : X.sheaf CommRing)
  (U V : opens X) (x) :
  F.1.map (hom_of_le le_sup_left).op ((F.obj_sup_iso_prod_eq_locus U V).inv x) = x.1.1 :=
concrete_category.congr_hom ((F.is_limit_pullback_cone U V).cone_point_unique_up_to_iso_inv_comp
  (CommRing.pullback_cone_is_limit _ _) walking_cospan.left) x

lemma obj_sup_iso_prod_eq_locus_inv_snd {X : Top} (F : X.sheaf CommRing)
  (U V : opens X) (x) :
  F.1.map (hom_of_le le_sup_right).op ((F.obj_sup_iso_prod_eq_locus U V).inv x) = x.1.2 :=
concrete_category.congr_hom ((F.is_limit_pullback_cone U V).cone_point_unique_up_to_iso_inv_comp
  (CommRing.pullback_cone_is_limit _ _) walking_cospan.right) x

end Top.sheaf


theorem not_mem_nil (a : Nat) : ¬ a ∈ [] := fun x => nomatch x

theorem forall_prop_of_false {p : Prop} {q : p → Prop} (hn : ¬ p) :
  (∀ h' : p, q h') ↔ True := sorry

example (R : Nat → Prop) : (∀ (a' : Nat), a' ∈ [] → R a') := by
  simp only [forall_prop_of_false (not_mem_nil _)]
  exact fun _ => True.intro

def Not.elim {α : Sort _} (H1 : ¬a) (H2 : a) : α := absurd H2 H1
theorem iff_of_true (ha : a) (hb : b) : a ↔ b := ⟨fun _ => hb, fun _ => ha⟩
theorem iff_true_intro (h : a) : a ↔ True := iff_of_true h ⟨⟩

example {P : Prop} : ∀ (x : Nat) (_ : x ∈ []), P :=
by
  simp only [forall_prop_of_false (not_mem_nil _)]
  exact fun _ => True.intro


example (h : x ∨ y) : y ∨ x := by
  cases h with
  | inl hx => first
    | apply Or.inr; assumption
    | apply Or.inl; assumption
  | inr hy => exact Or.inl hy

example (h : x ∨ y) : y ∨ x := by
  cases h with
  | inl hx => first
    | apply Or.inl; assumption
    | apply Or.inr; assumption
  | inr hy => exact Or.inl hy


example : Nat := ( .zero : Nat)
example : Nat := ( .zero : _)
example : Nat := ( .zero :) -- fail
example : Nat := by have' := .zero; exact this -- fail

def add (x y : Nat) := x + y

example (h₁ : z = x + y) (h₂ : w = z) : w = add x y := have := h₁ ▸ h₂; by exact this
example (h₁ : z = x + y) (h₂ : w = z) : w = add x y := have := h₁ ▸ h₂; this -- fail
example (h₁ : z = x + y) (h₂ : w = z) : w = add x y := h₁ ▸ h₂ -- fail
example (h₁ : z = x + y) (h₂ : w = z) : w = add x y := (h₁ ▸ h₂ :)