/-
Copyright (c) 2022 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Joël Riou

! This file was ported from Lean 3 source module category_theory.limits.shapes.comm_sq
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.CommSq
import Mathlib.CategoryTheory.Limits.Opposites
import Mathlib.CategoryTheory.Limits.Shapes.Biproducts
import Mathlib.CategoryTheory.Limits.Shapes.ZeroMorphisms
import Mathlib.CategoryTheory.Limits.Constructions.BinaryProducts
import Mathlib.CategoryTheory.Limits.Constructions.ZeroObjects

/-!
# Pullback and pushout squares, and bicartesian squares

We provide another API for pullbacks and pushouts.

`IsPullback fst snd f g` is the proposition that
```
  P --fst--> X
  |          |
 snd         f
  |          |
  v          v
  Y ---g---> Z

```
is a pullback square.

(And similarly for `IsPushout`.)

We provide the glue to go back and forth to the usual `IsLimit` API for pullbacks, and prove
`IsPullback (pullback.fst : pullback f g ⟶ X) (pullback.snd : pullback f g ⟶ Y) f g`
for the usual `pullback f g` provided by the `HasLimit` API.

We don't attempt to restate everything we know about pullbacks in this language,
but do restate the pasting lemmas.

We define bicartesian squares, and
show that the pullback and pushout squares for a biproduct are bicartesian.
-/

noncomputable section

open CategoryTheory

open CategoryTheory.Limits

universe v₁ v₂ u₁ u₂

namespace CategoryTheory

variable {C : Type u₁} [Category.{v₁} C]

attribute [simp] CommSq.mk

namespace CommSq

variable {W X Y Z : C} {f : W ⟶ X} {g : W ⟶ Y} {h : X ⟶ Z} {i : Y ⟶ Z}

/-- The (not necessarily limiting) `PullbackCone h i` implicit in the statement
that we have `CommSq f g h i`.
-/
def cone (s : CommSq f g h i) : PullbackCone h i :=
  PullbackCone.mk _ _ s.w
#align category_theory.comm_sq.cone CategoryTheory.CommSq.cone

/-- The (not necessarily limiting) `PushoutCocone f g` implicit in the statement
that we have `CommSq f g h i`.
-/
def cocone (s : CommSq f g h i) : PushoutCocone f g :=
  PushoutCocone.mk _ _ s.w
#align category_theory.comm_sq.cocone CategoryTheory.CommSq.cocone

@[simp]
theorem cone_fst (s : CommSq f g h i) : s.cone.fst = f :=
  rfl
#align category_theory.comm_sq.cone_fst CategoryTheory.CommSq.cone_fst

@[simp]
theorem cone_snd (s : CommSq f g h i) : s.cone.snd = g :=
  rfl
#align category_theory.comm_sq.cone_snd CategoryTheory.CommSq.cone_snd

@[simp]
theorem cocone_inl (s : CommSq f g h i) : s.cocone.inl = h :=
  rfl
#align category_theory.comm_sq.cocone_inl CategoryTheory.CommSq.cocone_inl

@[simp]
theorem cocone_inr (s : CommSq f g h i) : s.cocone.inr = i :=
  rfl
#align category_theory.comm_sq.cocone_inr CategoryTheory.CommSq.cocone_inr

/-- The pushout cocone in the opposite category associated to the cone of
a commutative square identifies to the cocone of the flipped commutative square in
the opposite category -/
def coneOp (p : CommSq f g h i) : p.cone.op ≅ p.flip.op.cocone :=
  PushoutCocone.ext (Iso.refl _) (by aesop_cat) (by aesop_cat)
#align category_theory.comm_sq.cone_op CategoryTheory.CommSq.coneOp

/-- The pullback cone in the opposite category associated to the cocone of
a commutative square identifies to the cone of the flipped commutative square in
the opposite category -/
def coconeOp (p : CommSq f g h i) : p.cocone.op ≅ p.flip.op.cone :=
  PullbackCone.ext (Iso.refl _) (by aesop_cat) (by aesop_cat)
#align category_theory.comm_sq.cocone_op CategoryTheory.CommSq.coconeOp

/-- The pushout cocone obtained from the pullback cone associated to a
commutative square in the opposite category identifies to the cocone associated
to the flipped square. -/
def coneUnop {W X Y Z : Cᵒᵖ} {f : W ⟶ X} {g : W ⟶ Y} {h : X ⟶ Z} {i : Y ⟶ Z} (p : CommSq f g h i) :
    p.cone.unop ≅ p.flip.unop.cocone :=
  PushoutCocone.ext (Iso.refl _) (by aesop_cat) (by aesop_cat)
#align category_theory.comm_sq.cone_unop CategoryTheory.CommSq.coneUnop

/-- The pullback cone obtained from the pushout cone associated to a
commutative square in the opposite category identifies to the cone associated
to the flipped square. -/
def coconeUnop {W X Y Z : Cᵒᵖ} {f : W ⟶ X} {g : W ⟶ Y} {h : X ⟶ Z} {i : Y ⟶ Z}
    (p : CommSq f g h i) : p.cocone.unop ≅ p.flip.unop.cone :=
  PullbackCone.ext (Iso.refl _) (by aesop_cat) (by aesop_cat)
#align category_theory.comm_sq.cocone_unop CategoryTheory.CommSq.coconeUnop

end CommSq

/-- The proposition that a square
```
  P --fst--> X
  |          |
 snd         f
  |          |
  v          v
  Y ---g---> Z

```
is a pullback square. (Also known as a fibered product or cartesian square.)
-/
structure IsPullback {P X Y Z : C} (fst : P ⟶ X) (snd : P ⟶ Y) (f : X ⟶ Z) (g : Y ⟶ Z) extends
  CommSq fst snd f g : Prop where
  /-- the pullback cone is a limit -/
  isLimit' : Nonempty (IsLimit (PullbackCone.mk _ _ w))
#align category_theory.is_pullback CategoryTheory.IsPullback

/-- The proposition that a square
```
  Z ---f---> X
  |          |
  g         inl
  |          |
  v          v
  Y --inr--> P

```
is a pushout square. (Also known as a fiber coproduct or cocartesian square.)
-/
structure IsPushout {Z X Y P : C} (f : Z ⟶ X) (g : Z ⟶ Y) (inl : X ⟶ P) (inr : Y ⟶ P) extends
  CommSq f g inl inr : Prop where
  /-- the pushout cocone is a colimit -/
  isColimit' : Nonempty (IsColimit (PushoutCocone.mk _ _ w))
#align category_theory.is_pushout CategoryTheory.IsPushout

section

/-- A *bicartesian* square is a commutative square
```
  W ---f---> X
  |          |
  g          h
  |          |
  v          v
  Y ---i---> Z

```
that is both a pullback square and a pushout square.
-/
structure BicartesianSq {W X Y Z : C} (f : W ⟶ X) (g : W ⟶ Y) (h : X ⟶ Z) (i : Y ⟶ Z) extends
  IsPullback f g h i, IsPushout f g h i : Prop
#align category_theory.bicartesian_sq CategoryTheory.BicartesianSq

-- Lean should make these parent projections as `lemma`, not `def`.
attribute [nolint defLemma docBlame] BicartesianSq.toIsPullback BicartesianSq.toIsPushout

end

/-!
We begin by providing some glue between `IsPullback` and the `IsLimit` and `HasLimit` APIs.
(And similarly for `IsPushout`.)
-/

namespace IsPullback

variable {P X Y Z : C} {fst : P ⟶ X} {snd : P ⟶ Y} {f : X ⟶ Z} {g : Y ⟶ Z}

/-- The (limiting) `PullbackCone f g` implicit in the statement
that we have a `IsPullback fst snd f g`.
-/
def cone (h : IsPullback fst snd f g) : PullbackCone f g :=
  h.toCommSq.cone
#align category_theory.is_pullback.cone CategoryTheory.IsPullback.cone

@[simp]
theorem cone_fst (h : IsPullback fst snd f g) : h.cone.fst = fst :=
  rfl
#align category_theory.is_pullback.cone_fst CategoryTheory.IsPullback.cone_fst

@[simp]
theorem cone_snd (h : IsPullback fst snd f g) : h.cone.snd = snd :=
  rfl
#align category_theory.is_pullback.cone_snd CategoryTheory.IsPullback.cone_snd

/-- The cone obtained from `IsPullback fst snd f g` is a limit cone.
-/
noncomputable def isLimit (h : IsPullback fst snd f g) : IsLimit h.cone :=
  h.isLimit'.some
#align category_theory.is_pullback.is_limit CategoryTheory.IsPullback.isLimit

/-- If `c` is a limiting pullback cone, then we have a `IsPullback c.fst c.snd f g`. -/
theorem of_isLimit {c : PullbackCone f g} (h : Limits.IsLimit c) : IsPullback c.fst c.snd f g :=
  { w := c.condition
    isLimit' := ⟨IsLimit.ofIsoLimit h (Limits.PullbackCone.ext (Iso.refl _)
      (by aesop_cat) (by aesop_cat))⟩ }
#align category_theory.is_pullback.of_is_limit CategoryTheory.IsPullback.of_isLimit

/-- A variant of `of_isLimit` that is more useful with `apply`. -/
theorem of_isLimit' (w : CommSq fst snd f g) (h : Limits.IsLimit w.cone) :
    IsPullback fst snd f g :=
  of_isLimit h
#align category_theory.is_pullback.of_is_limit' CategoryTheory.IsPullback.of_isLimit'

/-- The pullback provided by `HasPullback f g` fits into a `IsPullback`. -/
theorem of_hasPullback (f : X ⟶ Z) (g : Y ⟶ Z) [HasPullback f g] :
    IsPullback (pullback.fst : pullback f g ⟶ X) (pullback.snd : pullback f g ⟶ Y) f g :=
  of_isLimit (limit.isLimit (cospan f g))
#align category_theory.is_pullback.of_has_pullback CategoryTheory.IsPullback.of_hasPullback

/-- If `c` is a limiting binary product cone, and we have a terminal object,
then we have `IsPullback c.fst c.snd 0 0`
(where each `0` is the unique morphism to the terminal object). -/
theorem of_is_product {c : BinaryFan X Y} (h : Limits.IsLimit c) (t : IsTerminal Z) :
    IsPullback c.fst c.snd (t.from _) (t.from _) :=
  of_isLimit
    (isPullbackOfIsTerminalIsProduct _ _ _ _ t
      (IsLimit.ofIsoLimit h
        (Limits.Cones.ext (Iso.refl c.pt)
          (by
            rintro ⟨⟨⟩⟩ <;>
              · dsimp
                simp))))
#align category_theory.is_pullback.of_is_product CategoryTheory.IsPullback.of_is_product

/-- A variant of `of_is_product` that is more useful with `apply`. -/
theorem of_is_product' (h : Limits.IsLimit (BinaryFan.mk fst snd)) (t : IsTerminal Z) :
    IsPullback fst snd (t.from _) (t.from _) :=
  of_is_product h t
#align category_theory.is_pullback.of_is_product' CategoryTheory.IsPullback.of_is_product'

variable (X Y)

theorem of_hasBinaryProduct' [HasBinaryProduct X Y] [HasTerminal C] :
    IsPullback Limits.prod.fst Limits.prod.snd (terminal.from X) (terminal.from Y) :=
  of_is_product (limit.isLimit _) terminalIsTerminal
#align category_theory.is_pullback.of_has_binary_product' CategoryTheory.IsPullback.of_hasBinaryProduct'

open ZeroObject

theorem of_hasBinaryProduct [HasBinaryProduct X Y] [HasZeroObject C] [HasZeroMorphisms C] :
    IsPullback Limits.prod.fst Limits.prod.snd (0 : X ⟶ 0) (0 : Y ⟶ 0) := by
  convert @of_is_product _ _ X Y 0 _ (limit.isLimit _) HasZeroObject.zeroIsTerminal
#align category_theory.is_pullback.of_has_binary_product CategoryTheory.IsPullback.of_hasBinaryProduct

variable {X Y}

/-- Any object at the top left of a pullback square is
isomorphic to the pullback provided by the `HasLimit` API. -/
noncomputable def isoPullback (h : IsPullback fst snd f g) [HasPullback f g] : P ≅ pullback f g :=
  (limit.isoLimitCone ⟨_, h.isLimit⟩).symm
#align category_theory.is_pullback.iso_pullback CategoryTheory.IsPullback.isoPullback

@[simp]
theorem isoPullback_hom_fst (h : IsPullback fst snd f g) [HasPullback f g] :
    h.isoPullback.hom ≫ pullback.fst = fst := by
  dsimp [isoPullback, cone, CommSq.cone]
  simp
#align category_theory.is_pullback.iso_pullback_hom_fst CategoryTheory.IsPullback.isoPullback_hom_fst

@[simp]
theorem isoPullback_hom_snd (h : IsPullback fst snd f g) [HasPullback f g] :
    h.isoPullback.hom ≫ pullback.snd = snd := by
  dsimp [isoPullback, cone, CommSq.cone]
  simp
#align category_theory.is_pullback.iso_pullback_hom_snd CategoryTheory.IsPullback.isoPullback_hom_snd

@[simp]
theorem isoPullback_inv_fst (h : IsPullback fst snd f g) [HasPullback f g] :
    h.isoPullback.inv ≫ fst = pullback.fst := by simp [Iso.inv_comp_eq]
#align category_theory.is_pullback.iso_pullback_inv_fst CategoryTheory.IsPullback.isoPullback_inv_fst

@[simp]
theorem isoPullback_inv_snd (h : IsPullback fst snd f g) [HasPullback f g] :
    h.isoPullback.inv ≫ snd = pullback.snd := by simp [Iso.inv_comp_eq]
#align category_theory.is_pullback.iso_pullback_inv_snd CategoryTheory.IsPullback.isoPullback_inv_snd

theorem of_iso_pullback (h : CommSq fst snd f g) [HasPullback f g] (i : P ≅ pullback f g)
    (w₁ : i.hom ≫ pullback.fst = fst) (w₂ : i.hom ≫ pullback.snd = snd) : IsPullback fst snd f g :=
  of_isLimit' h
    (Limits.IsLimit.ofIsoLimit (limit.isLimit _)
      (@PullbackCone.ext _ _ _ _ _ _ _ (PullbackCone.mk _ _ _) _ i w₁.symm w₂.symm).symm)
#align category_theory.is_pullback.of_iso_pullback CategoryTheory.IsPullback.of_iso_pullback

theorem of_horiz_isIso [IsIso fst] [IsIso g] (sq : CommSq fst snd f g) : IsPullback fst snd f g :=
  of_isLimit' sq
    (by
      refine'
        PullbackCone.IsLimit.mk _ (fun s => s.fst ≫ inv fst) (by aesop_cat)
          (fun s => _) (by aesop_cat)
      simp only [← cancel_mono g, Category.assoc, ← sq.w, IsIso.inv_hom_id_assoc, s.condition])
#align category_theory.is_pullback.of_horiz_is_iso CategoryTheory.IsPullback.of_horiz_isIso

end IsPullback

namespace IsPushout

variable {Z X Y P : C} {f : Z ⟶ X} {g : Z ⟶ Y} {inl : X ⟶ P} {inr : Y ⟶ P}

/-- The (colimiting) `PushoutCocone f g` implicit in the statement
that we have a `IsPushout f g inl inr`.
-/
def cocone (h : IsPushout f g inl inr) : PushoutCocone f g :=
  h.toCommSq.cocone
#align category_theory.is_pushout.cocone CategoryTheory.IsPushout.cocone

@[simp]
theorem cocone_inl (h : IsPushout f g inl inr) : h.cocone.inl = inl :=
  rfl
#align category_theory.is_pushout.cocone_inl CategoryTheory.IsPushout.cocone_inl

@[simp]
theorem cocone_inr (h : IsPushout f g inl inr) : h.cocone.inr = inr :=
  rfl
#align category_theory.is_pushout.cocone_inr CategoryTheory.IsPushout.cocone_inr

/-- The cocone obtained from `IsPushout f g inl inr` is a colimit cocone.
-/
noncomputable def isColimit (h : IsPushout f g inl inr) : IsColimit h.cocone :=
  h.isColimit'.some
#align category_theory.is_pushout.is_colimit CategoryTheory.IsPushout.isColimit

/-- If `c` is a colimiting pushout cocone, then we have a `IsPushout f g c.inl c.inr`. -/
theorem of_isColimit {c : PushoutCocone f g} (h : Limits.IsColimit c) : IsPushout f g c.inl c.inr :=
  { w := c.condition
    isColimit' :=
      ⟨IsColimit.ofIsoColimit h (Limits.PushoutCocone.ext (Iso.refl _)
        (by aesop_cat) (by aesop_cat))⟩ }
#align category_theory.is_pushout.of_is_colimit CategoryTheory.IsPushout.of_isColimit

/-- A variant of `of_isColimit` that is more useful with `apply`. -/
theorem of_isColimit' (w : CommSq f g inl inr) (h : Limits.IsColimit w.cocone) :
    IsPushout f g inl inr :=
  of_isColimit h
#align category_theory.is_pushout.of_is_colimit' CategoryTheory.IsPushout.of_isColimit'

/-- The pushout provided by `HasPushout f g` fits into a `IsPushout`. -/
theorem of_hasPushout (f : Z ⟶ X) (g : Z ⟶ Y) [HasPushout f g] :
    IsPushout f g (pushout.inl : X ⟶ pushout f g) (pushout.inr : Y ⟶ pushout f g) :=
  of_isColimit (colimit.isColimit (span f g))
#align category_theory.is_pushout.of_has_pushout CategoryTheory.IsPushout.of_hasPushout

/-- If `c` is a colimiting binary coproduct cocone, and we have an initial object,
then we have `IsPushout 0 0 c.inl c.inr`
(where each `0` is the unique morphism from the initial object). -/
theorem of_is_coproduct {c : BinaryCofan X Y} (h : Limits.IsColimit c) (t : IsInitial Z) :
    IsPushout (t.to _) (t.to _) c.inl c.inr :=
  of_isColimit
    (isPushoutOfIsInitialIsCoproduct _ _ _ _ t
      (IsColimit.ofIsoColimit h
        (Limits.Cocones.ext (Iso.refl c.pt)
          (by
            rintro ⟨⟨⟩⟩ <;>
              · dsimp
                simp))))
#align category_theory.is_pushout.of_is_coproduct CategoryTheory.IsPushout.of_is_coproduct

/-- A variant of `of_is_coproduct` that is more useful with `apply`. -/
theorem of_is_coproduct' (h : Limits.IsColimit (BinaryCofan.mk inl inr)) (t : IsInitial Z) :
    IsPushout (t.to _) (t.to _) inl inr :=
  of_is_coproduct h t
#align category_theory.is_pushout.of_is_coproduct' CategoryTheory.IsPushout.of_is_coproduct'

variable (X Y)

theorem of_hasBinaryCoproduct' [HasBinaryCoproduct X Y] [HasInitial C] :
    IsPushout (initial.to _) (initial.to _) (coprod.inl : X ⟶ _) (coprod.inr : Y ⟶ _) :=
  of_is_coproduct (colimit.isColimit _) initialIsInitial
#align category_theory.is_pushout.of_has_binary_coproduct' CategoryTheory.IsPushout.of_hasBinaryCoproduct'

open ZeroObject

theorem of_hasBinaryCoproduct [HasBinaryCoproduct X Y] [HasZeroObject C] [HasZeroMorphisms C] :
    IsPushout (0 : 0 ⟶ X) (0 : 0 ⟶ Y) coprod.inl coprod.inr := by
  convert @of_is_coproduct _ _ 0 X Y _ (colimit.isColimit _) HasZeroObject.zeroIsInitial
#align category_theory.is_pushout.of_has_binary_coproduct CategoryTheory.IsPushout.of_hasBinaryCoproduct

variable {X Y}

/-- Any object at the top left of a pullback square is
isomorphic to the pullback provided by the `HasLimit` API. -/
noncomputable def isoPushout (h : IsPushout f g inl inr) [HasPushout f g] : P ≅ pushout f g :=
  (colimit.isoColimitCocone ⟨_, h.isColimit⟩).symm
#align category_theory.is_pushout.iso_pushout CategoryTheory.IsPushout.isoPushout

@[simp]
theorem inl_isoPushout_inv (h : IsPushout f g inl inr) [HasPushout f g] :
    pushout.inl ≫ h.isoPushout.inv = inl := by
  dsimp [isoPushout, cocone, CommSq.cocone]
  simp
#align category_theory.is_pushout.inl_iso_pushout_inv CategoryTheory.IsPushout.inl_isoPushout_inv

@[simp]
theorem inr_isoPushout_inv (h : IsPushout f g inl inr) [HasPushout f g] :
    pushout.inr ≫ h.isoPushout.inv = inr := by
  dsimp [isoPushout, cocone, CommSq.cocone]
  simp
#align category_theory.is_pushout.inr_iso_pushout_inv CategoryTheory.IsPushout.inr_isoPushout_inv

@[simp]
theorem inl_isoPushout_hom (h : IsPushout f g inl inr) [HasPushout f g] :
    inl ≫ h.isoPushout.hom = pushout.inl := by simp [← Iso.eq_comp_inv]
#align category_theory.is_pushout.inl_iso_pushout_hom CategoryTheory.IsPushout.inl_isoPushout_hom

@[simp]
theorem inr_isoPushout_hom (h : IsPushout f g inl inr) [HasPushout f g] :
    inr ≫ h.isoPushout.hom = pushout.inr := by simp [← Iso.eq_comp_inv]
#align category_theory.is_pushout.inr_iso_pushout_hom CategoryTheory.IsPushout.inr_isoPushout_hom

theorem of_iso_pushout (h : CommSq f g inl inr) [HasPushout f g] (i : P ≅ pushout f g)
    (w₁ : inl ≫ i.hom = pushout.inl) (w₂ : inr ≫ i.hom = pushout.inr) : IsPushout f g inl inr :=
  of_isColimit' h
    (Limits.IsColimit.ofIsoColimit (colimit.isColimit _)
      (@PushoutCocone.ext _ _ _ _ _ _ _ (PushoutCocone.mk _ _ _) _ i w₁ w₂).symm)
#align category_theory.is_pushout.of_iso_pushout CategoryTheory.IsPushout.of_iso_pushout

end IsPushout

namespace IsPullback

variable {P X Y Z : C} {fst : P ⟶ X} {snd : P ⟶ Y} {f : X ⟶ Z} {g : Y ⟶ Z}

theorem flip (h : IsPullback fst snd f g) : IsPullback snd fst g f :=
  of_isLimit (@PullbackCone.flipIsLimit _ _ _ _ _ _ _ _ _ _ h.w.symm h.isLimit)
#align category_theory.is_pullback.flip CategoryTheory.IsPullback.flip

theorem flip_iff : IsPullback fst snd f g ↔ IsPullback snd fst g f :=
  ⟨flip, flip⟩
#align category_theory.is_pullback.flip_iff CategoryTheory.IsPullback.flip_iff

section

variable [HasZeroObject C] [HasZeroMorphisms C]

open ZeroObject

/-- The square with `0 : 0 ⟶ 0` on the left and `𝟙 X` on the right is a pullback square. -/
@[simp]
theorem zero_left (X : C) : IsPullback (0 : 0 ⟶ X) (0 : (0 : C) ⟶ 0) (𝟙 X) (0 : 0 ⟶ X) :=
  { w := by simp
    isLimit' :=
      ⟨{  lift := fun s => 0
          fac := fun s => by
            simpa using
              @PullbackCone.equalizer_ext _ _ _ _ _ _ _ s _ 0 (𝟙 _)
                (by simpa using (PullbackCone.condition s).symm) }⟩ }
#align category_theory.is_pullback.zero_left CategoryTheory.IsPullback.zero_left

/-- The square with `0 : 0 ⟶ 0` on the top and `𝟙 X` on the bottom is a pullback square. -/
@[simp]
theorem zero_top (X : C) : IsPullback (0 : (0 : C) ⟶ 0) (0 : 0 ⟶ X) (0 : 0 ⟶ X) (𝟙 X) :=
  (zero_left X).flip
#align category_theory.is_pullback.zero_top CategoryTheory.IsPullback.zero_top

/-- The square with `0 : 0 ⟶ 0` on the right and `𝟙 X` on the left is a pullback square. -/
@[simp]
theorem zero_right (X : C) : IsPullback (0 : X ⟶ 0) (𝟙 X) (0 : (0 : C) ⟶ 0) (0 : X ⟶ 0) :=
  of_iso_pullback (by simp) ((zeroProdIso X).symm ≪≫ (pullbackZeroZeroIso _ _).symm) (by simp)
    (by simp)
#align category_theory.is_pullback.zero_right CategoryTheory.IsPullback.zero_right

/-- The square with `0 : 0 ⟶ 0` on the bottom and `𝟙 X` on the top is a pullback square. -/
@[simp]
theorem zero_bot (X : C) : IsPullback (𝟙 X) (0 : X ⟶ 0) (0 : X ⟶ 0) (0 : (0 : C) ⟶ 0) :=
  (zero_right X).flip
#align category_theory.is_pullback.zero_bot CategoryTheory.IsPullback.zero_bot

end

-- Objects here are arranged in a 3x2 grid, and indexed by their xy coordinates.
-- Morphisms are named `hᵢⱼ` for a horizontal morphism starting at `(i,j)`,
-- and `vᵢⱼ` for a vertical morphism starting at `(i,j)`.
/-- Paste two pullback squares "vertically" to obtain another pullback square. -/
theorem paste_vert {X₁₁ X₁₂ X₂₁ X₂₂ X₃₁ X₃₂ : C} {h₁₁ : X₁₁ ⟶ X₁₂} {h₂₁ : X₂₁ ⟶ X₂₂}
    {h₃₁ : X₃₁ ⟶ X₃₂} {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₂₁ : X₂₁ ⟶ X₃₁} {v₂₂ : X₂₂ ⟶ X₃₂}
    (s : IsPullback h₁₁ v₁₁ v₁₂ h₂₁) (t : IsPullback h₂₁ v₂₁ v₂₂ h₃₁) :
    IsPullback h₁₁ (v₁₁ ≫ v₂₁) (v₁₂ ≫ v₂₂) h₃₁ :=
  of_isLimit (bigSquareIsPullback _ _ _ _ _ _ _ s.w t.w t.isLimit s.isLimit)
#align category_theory.is_pullback.paste_vert CategoryTheory.IsPullback.paste_vert

/-- Paste two pullback squares "horizontally" to obtain another pullback square. -/
theorem paste_horiz {X₁₁ X₁₂ X₁₃ X₂₁ X₂₂ X₂₃ : C} {h₁₁ : X₁₁ ⟶ X₁₂} {h₁₂ : X₁₂ ⟶ X₁₃}
    {h₂₁ : X₂₁ ⟶ X₂₂} {h₂₂ : X₂₂ ⟶ X₂₃} {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₁₃ : X₁₃ ⟶ X₂₃}
    (s : IsPullback h₁₁ v₁₁ v₁₂ h₂₁) (t : IsPullback h₁₂ v₁₂ v₁₃ h₂₂) :
    IsPullback (h₁₁ ≫ h₁₂) v₁₁ v₁₃ (h₂₁ ≫ h₂₂) :=
  (paste_vert s.flip t.flip).flip
#align category_theory.is_pullback.paste_horiz CategoryTheory.IsPullback.paste_horiz

/-- Given a pullback square assembled from a commuting square on the top and
a pullback square on the bottom, the top square is a pullback square. -/
theorem of_bot {X₁₁ X₁₂ X₂₁ X₂₂ X₃₁ X₃₂ : C} {h₁₁ : X₁₁ ⟶ X₁₂} {h₂₁ : X₂₁ ⟶ X₂₂} {h₃₁ : X₃₁ ⟶ X₃₂}
    {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₂₁ : X₂₁ ⟶ X₃₁} {v₂₂ : X₂₂ ⟶ X₃₂}
    (s : IsPullback h₁₁ (v₁₁ ≫ v₂₁) (v₁₂ ≫ v₂₂) h₃₁) (p : h₁₁ ≫ v₁₂ = v₁₁ ≫ h₂₁)
    (t : IsPullback h₂₁ v₂₁ v₂₂ h₃₁) : IsPullback h₁₁ v₁₁ v₁₂ h₂₁ :=
  of_isLimit (leftSquareIsPullback _ _ _ _ _ _ _ p t.w t.isLimit s.isLimit)
#align category_theory.is_pullback.of_bot CategoryTheory.IsPullback.of_bot

/-- Given a pullback square assembled from a commuting square on the left and
a pullback square on the right, the left square is a pullback square. -/
theorem of_right {X₁₁ X₁₂ X₁₃ X₂₁ X₂₂ X₂₃ : C} {h₁₁ : X₁₁ ⟶ X₁₂} {h₁₂ : X₁₂ ⟶ X₁₃} {h₂₁ : X₂₁ ⟶ X₂₂}
    {h₂₂ : X₂₂ ⟶ X₂₃} {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₁₃ : X₁₃ ⟶ X₂₃}
    (s : IsPullback (h₁₁ ≫ h₁₂) v₁₁ v₁₃ (h₂₁ ≫ h₂₂)) (p : h₁₁ ≫ v₁₂ = v₁₁ ≫ h₂₁)
    (t : IsPullback h₁₂ v₁₂ v₁₃ h₂₂) : IsPullback h₁₁ v₁₁ v₁₂ h₂₁ :=
  (of_bot s.flip p.symm t.flip).flip
#align category_theory.is_pullback.of_right CategoryTheory.IsPullback.of_right

theorem paste_vert_iff {X₁₁ X₁₂ X₂₁ X₂₂ X₃₁ X₃₂ : C} {h₁₁ : X₁₁ ⟶ X₁₂} {h₂₁ : X₂₁ ⟶ X₂₂}
    {h₃₁ : X₃₁ ⟶ X₃₂} {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₂₁ : X₂₁ ⟶ X₃₁} {v₂₂ : X₂₂ ⟶ X₃₂}
    (s : IsPullback h₂₁ v₂₁ v₂₂ h₃₁) (e : h₁₁ ≫ v₁₂ = v₁₁ ≫ h₂₁) :
    IsPullback h₁₁ (v₁₁ ≫ v₂₁) (v₁₂ ≫ v₂₂) h₃₁ ↔ IsPullback h₁₁ v₁₁ v₁₂ h₂₁ :=
  ⟨fun h => h.of_bot e s, fun h => h.paste_vert s⟩
#align category_theory.is_pullback.paste_vert_iff CategoryTheory.IsPullback.paste_vert_iff

theorem paste_horiz_iff {X₁₁ X₁₂ X₁₃ X₂₁ X₂₂ X₂₃ : C} {h₁₁ : X₁₁ ⟶ X₁₂} {h₁₂ : X₁₂ ⟶ X₁₃}
    {h₂₁ : X₂₁ ⟶ X₂₂} {h₂₂ : X₂₂ ⟶ X₂₃} {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₁₃ : X₁₃ ⟶ X₂₃}
    (s : IsPullback h₁₂ v₁₂ v₁₃ h₂₂) (e : h₁₁ ≫ v₁₂ = v₁₁ ≫ h₂₁) :
    IsPullback (h₁₁ ≫ h₁₂) v₁₁ v₁₃ (h₂₁ ≫ h₂₂) ↔ IsPullback h₁₁ v₁₁ v₁₂ h₂₁ :=
  ⟨fun h => h.of_right e s, fun h => h.paste_horiz s⟩
#align category_theory.is_pullback.paste_horiz_iff CategoryTheory.IsPullback.paste_horiz_iff

section

variable [HasZeroObject C] [HasZeroMorphisms C]

open ZeroObject

theorem of_isBilimit {b : BinaryBicone X Y} (h : b.IsBilimit) :
    IsPullback b.fst b.snd (0 : X ⟶ 0) (0 : Y ⟶ 0) := by
  convert IsPullback.of_is_product' h.isLimit HasZeroObject.zeroIsTerminal
#align category_theory.is_pullback.of_is_bilimit CategoryTheory.IsPullback.of_isBilimit

@[simp]
theorem of_has_biproduct (X Y : C) [HasBinaryBiproduct X Y] :
    IsPullback biprod.fst biprod.snd (0 : X ⟶ 0) (0 : Y ⟶ 0) :=
  of_isBilimit (BinaryBiproduct.isBilimit X Y)
#align category_theory.is_pullback.of_has_biproduct CategoryTheory.IsPullback.of_has_biproduct

theorem inl_snd' {b : BinaryBicone X Y} (h : b.IsBilimit) :
    IsPullback b.inl (0 : X ⟶ 0) b.snd (0 : 0 ⟶ Y) := by
  refine' of_right _ (by simp) (of_isBilimit h)
  simp
#align category_theory.is_pullback.inl_snd' CategoryTheory.IsPullback.inl_snd'

/-- The square
```
  X --inl--> X ⊞ Y
  |            |
  0           snd
  |            |
  v            v
  0 ---0-----> Y
```
is a pullback square.
-/
@[simp]
theorem inl_snd (X Y : C) [HasBinaryBiproduct X Y] :
    IsPullback biprod.inl (0 : X ⟶ 0) biprod.snd (0 : 0 ⟶ Y) :=
  inl_snd' (BinaryBiproduct.isBilimit X Y)
#align category_theory.is_pullback.inl_snd CategoryTheory.IsPullback.inl_snd

theorem inr_fst' {b : BinaryBicone X Y} (h : b.IsBilimit) :
    IsPullback b.inr (0 : Y ⟶ 0) b.fst (0 : 0 ⟶ X) := by
  apply flip
  refine' of_bot _ (by simp) (of_isBilimit h)
  simp
#align category_theory.is_pullback.inr_fst' CategoryTheory.IsPullback.inr_fst'

/-- The square
```
  Y --inr--> X ⊞ Y
  |            |
  0           fst
  |            |
  v            v
  0 ---0-----> X
```
is a pullback square.
-/
@[simp]
theorem inr_fst (X Y : C) [HasBinaryBiproduct X Y] :
    IsPullback biprod.inr (0 : Y ⟶ 0) biprod.fst (0 : 0 ⟶ X) :=
  inr_fst' (BinaryBiproduct.isBilimit X Y)
#align category_theory.is_pullback.inr_fst CategoryTheory.IsPullback.inr_fst

theorem of_hasBinaryBiproduct (X Y : C) [HasBinaryBiproduct X Y] :
    IsPullback (0 : 0 ⟶ X) (0 : 0 ⟶ Y) biprod.inl biprod.inr :=
  of_is_bilimit' (BinaryBiproduct.isBilimit X Y)
#align category_theory.is_pullback.of_has_binary_biproduct CategoryTheory.IsPullback.of_hasBinaryBiproduct

instance hasPullback_biprod_fst_biprod_snd [HasBinaryBiproduct X Y] :
    HasPullback (biprod.inl : X ⟶ _) (biprod.inr : Y ⟶ _) :=
  HasLimit.mk ⟨_, (of_hasBinaryBiproduct X Y).isLimit⟩
#align category_theory.is_pullback.has_pullback_biprod_fst_biprod_snd CategoryTheory.IsPullback.hasPullback_biprod_fst_biprod_snd

/-- The pullback of `biprod.inl` and `biprod.inr` is the zero object. -/
def pullbackBiprodInlBiprodInr [HasBinaryBiproduct X Y] :
    pullback (biprod.inl : X ⟶ _) (biprod.inr : Y ⟶ _) ≅ 0 :=
  limit.isoLimitCone ⟨_, (of_hasBinaryBiproduct X Y).isLimit⟩
#align category_theory.is_pullback.pullback_biprod_inl_biprod_inr CategoryTheory.IsPullback.pullbackBiprodInlBiprodInr

end

theorem op (h : IsPullback fst snd f g) : IsPushout g.op f.op snd.op fst.op :=
  IsPushout.of_isColimit
    (IsColimit.ofIsoColimit (Limits.PullbackCone.isLimitEquivIsColimitOp h.flip.cone h.flip.isLimit)
      h.toCommSq.flip.coneOp)
#align category_theory.is_pullback.op CategoryTheory.IsPullback.op

theorem unop {P X Y Z : Cᵒᵖ} {fst : P ⟶ X} {snd : P ⟶ Y} {f : X ⟶ Z} {g : Y ⟶ Z}
    (h : IsPullback fst snd f g) : IsPushout g.unop f.unop snd.unop fst.unop :=
  IsPushout.of_isColimit
    (IsColimit.ofIsoColimit
      (Limits.PullbackCone.isLimitEquivIsColimitUnop h.flip.cone h.flip.isLimit)
      h.toCommSq.flip.coneUnop)
#align category_theory.is_pullback.unop CategoryTheory.IsPullback.unop

theorem of_vert_isIso [IsIso snd] [IsIso f] (sq : CommSq fst snd f g) : IsPullback fst snd f g :=
  IsPullback.flip (of_horiz_isIso sq.flip)
#align category_theory.is_pullback.of_vert_is_iso CategoryTheory.IsPullback.of_vert_isIso

end IsPullback

namespace IsPushout

variable {Z X Y P : C} {f : Z ⟶ X} {g : Z ⟶ Y} {inl : X ⟶ P} {inr : Y ⟶ P}

theorem flip (h : IsPushout f g inl inr) : IsPushout g f inr inl :=
  of_isColimit (@PushoutCocone.flipIsColimit _ _ _ _ _ _ _ _ _ _ h.w.symm h.isColimit)
#align category_theory.is_pushout.flip CategoryTheory.IsPushout.flip

theorem flip_iff : IsPushout f g inl inr ↔ IsPushout g f inr inl :=
  ⟨flip, flip⟩
#align category_theory.is_pushout.flip_iff CategoryTheory.IsPushout.flip_iff

section

variable [HasZeroObject C] [HasZeroMorphisms C]

open ZeroObject

/-- The square with `0 : 0 ⟶ 0` on the right and `𝟙 X` on the left is a pushout square. -/
@[simp]
theorem zero_right (X : C) : IsPushout (0 : X ⟶ 0) (𝟙 X) (0 : (0 : C) ⟶ 0) (0 : X ⟶ 0) :=
  { w := by simp
    isColimit' :=
      ⟨{  desc := fun s => 0
          fac := fun s =>
            by
            have c :=
              @PushoutCocone.coequalizer_ext _ _ _ _ _ _ _ s _ 0 (𝟙 _) (by simp)
                (by simpa using PushoutCocone.condition s)
            dsimp at c
            simpa using c }⟩ }
#align category_theory.is_pushout.zero_right CategoryTheory.IsPushout.zero_right

/-- The square with `0 : 0 ⟶ 0` on the bottom and `𝟙 X` on the top is a pushout square. -/
@[simp]
theorem zero_bot (X : C) : IsPushout (𝟙 X) (0 : X ⟶ 0) (0 : X ⟶ 0) (0 : (0 : C) ⟶ 0) :=
  (zero_right X).flip
#align category_theory.is_pushout.zero_bot CategoryTheory.IsPushout.zero_bot

/-- The square with `0 : 0 ⟶ 0` on the right left `𝟙 X` on the right is a pushout square. -/
@[simp]
theorem zero_left (X : C) : IsPushout (0 : 0 ⟶ X) (0 : (0 : C) ⟶ 0) (𝟙 X) (0 : 0 ⟶ X) :=
  of_iso_pushout (by simp) ((coprodZeroIso X).symm ≪≫ (pushoutZeroZeroIso _ _).symm) (by simp)
    (by simp)
#align category_theory.is_pushout.zero_left CategoryTheory.IsPushout.zero_left

/-- The square with `0 : 0 ⟶ 0` on the top and `𝟙 X` on the bottom is a pushout square. -/
@[simp]
theorem zero_top (X : C) : IsPushout (0 : (0 : C) ⟶ 0) (0 : 0 ⟶ X) (0 : 0 ⟶ X) (𝟙 X) :=
  (zero_left X).flip
#align category_theory.is_pushout.zero_top CategoryTheory.IsPushout.zero_top

end

-- Objects here are arranged in a 3x2 grid, and indexed by their xy coordinates.
-- Morphisms are named `hᵢⱼ` for a horizontal morphism starting at `(i,j)`,
-- and `vᵢⱼ` for a vertical morphism starting at `(i,j)`.
/-- Paste two pushout squares "vertically" to obtain another pushout square. -/
theorem paste_vert {X₁₁ X₁₂ X₂₁ X₂₂ X₃₁ X₃₂ : C} {h₁₁ : X₁₁ ⟶ X₁₂} {h₂₁ : X₂₁ ⟶ X₂₂}
    {h₃₁ : X₃₁ ⟶ X₃₂} {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₂₁ : X₂₁ ⟶ X₃₁} {v₂₂ : X₂₂ ⟶ X₃₂}
    (s : IsPushout h₁₁ v₁₁ v₁₂ h₂₁) (t : IsPushout h₂₁ v₂₁ v₂₂ h₃₁) :
    IsPushout h₁₁ (v₁₁ ≫ v₂₁) (v₁₂ ≫ v₂₂) h₃₁ :=
  of_isColimit (bigSquareIsPushout _ _ _ _ _ _ _ s.w t.w t.isColimit s.isColimit)
#align category_theory.is_pushout.paste_vert CategoryTheory.IsPushout.paste_vert

/-- Paste two pushout squares "horizontally" to obtain another pushout square. -/
theorem paste_horiz {X₁₁ X₁₂ X₁₃ X₂₁ X₂₂ X₂₃ : C} {h₁₁ : X₁₁ ⟶ X₁₂} {h₁₂ : X₁₂ ⟶ X₁₃}
    {h₂₁ : X₂₁ ⟶ X₂₂} {h₂₂ : X₂₂ ⟶ X₂₃} {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₁₃ : X₁₃ ⟶ X₂₃}
    (s : IsPushout h₁₁ v₁₁ v₁₂ h₂₁) (t : IsPushout h₁₂ v₁₂ v₁₃ h₂₂) :
    IsPushout (h₁₁ ≫ h₁₂) v₁₁ v₁₃ (h₂₁ ≫ h₂₂) :=
  (paste_vert s.flip t.flip).flip
#align category_theory.is_pushout.paste_horiz CategoryTheory.IsPushout.paste_horiz

/-- Given a pushout square assembled from a pushout square on the top and
a commuting square on the bottom, the bottom square is a pushout square. -/
theorem of_bot {X₁₁ X₁₂ X₂₁ X₂₂ X₃₁ X₃₂ : C} {h₁₁ : X₁₁ ⟶ X₁₂} {h₂₁ : X₂₁ ⟶ X₂₂} {h₃₁ : X₃₁ ⟶ X₃₂}
    {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₂₁ : X₂₁ ⟶ X₃₁} {v₂₂ : X₂₂ ⟶ X₃₂}
    (s : IsPushout h₁₁ (v₁₁ ≫ v₂₁) (v₁₂ ≫ v₂₂) h₃₁) (p : h₂₁ ≫ v₂₂ = v₂₁ ≫ h₃₁)
    (t : IsPushout h₁₁ v₁₁ v₁₂ h₂₁) : IsPushout h₂₁ v₂₁ v₂₂ h₃₁ :=
  of_isColimit (rightSquareIsPushout _ _ _ _ _ _ _ t.w p t.isColimit s.isColimit)
#align category_theory.is_pushout.of_bot CategoryTheory.IsPushout.of_bot

/-- Given a pushout square assembled from a pushout square on the left and
a commuting square on the right, the right square is a pushout square. -/
theorem of_right {X₁₁ X₁₂ X₁₃ X₂₁ X₂₂ X₂₃ : C} {h₁₁ : X₁₁ ⟶ X₁₂} {h₁₂ : X₁₂ ⟶ X₁₃} {h₂₁ : X₂₁ ⟶ X₂₂}
    {h₂₂ : X₂₂ ⟶ X₂₃} {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₁₃ : X₁₃ ⟶ X₂₃}
    (s : IsPushout (h₁₁ ≫ h₁₂) v₁₁ v₁₃ (h₂₁ ≫ h₂₂)) (p : h₁₂ ≫ v₁₃ = v₁₂ ≫ h₂₂)
    (t : IsPushout h₁₁ v₁₁ v₁₂ h₂₁) : IsPushout h₁₂ v₁₂ v₁₃ h₂₂ :=
  (of_bot s.flip p.symm t.flip).flip
#align category_theory.is_pushout.of_right CategoryTheory.IsPushout.of_right

theorem paste_vert_iff {X₁₁ X₁₂ X₂₁ X₂₂ X₃₁ X₃₂ : C} {h₁₁ : X₁₁ ⟶ X₁₂} {h₂₁ : X₂₁ ⟶ X₂₂}
    {h₃₁ : X₃₁ ⟶ X₃₂} {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₂₁ : X₂₁ ⟶ X₃₁} {v₂₂ : X₂₂ ⟶ X₃₂}
    (s : IsPushout h₁₁ v₁₁ v₁₂ h₂₁) (e : h₂₁ ≫ v₂₂ = v₂₁ ≫ h₃₁) :
    IsPushout h₁₁ (v₁₁ ≫ v₂₁) (v₁₂ ≫ v₂₂) h₃₁ ↔ IsPushout h₂₁ v₂₁ v₂₂ h₃₁ :=
  ⟨fun h => h.of_bot e s, s.paste_vert⟩
#align category_theory.is_pushout.paste_vert_iff CategoryTheory.IsPushout.paste_vert_iff

theorem paste_horiz_iff {X₁₁ X₁₂ X₁₃ X₂₁ X₂₂ X₂₃ : C} {h₁₁ : X₁₁ ⟶ X₁₂} {h₁₂ : X₁₂ ⟶ X₁₃}
    {h₂₁ : X₂₁ ⟶ X₂₂} {h₂₂ : X₂₂ ⟶ X₂₃} {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₁₃ : X₁₃ ⟶ X₂₃}
    (s : IsPushout h₁₁ v₁₁ v₁₂ h₂₁) (e : h₁₂ ≫ v₁₃ = v₁₂ ≫ h₂₂) :
    IsPushout (h₁₁ ≫ h₁₂) v₁₁ v₁₃ (h₂₁ ≫ h₂₂) ↔ IsPushout h₁₂ v₁₂ v₁₃ h₂₂ :=
  ⟨fun h => h.of_right e s, s.paste_horiz⟩
#align category_theory.is_pushout.paste_horiz_iff CategoryTheory.IsPushout.paste_horiz_iff

section

variable [HasZeroObject C] [HasZeroMorphisms C]

open ZeroObject

theorem of_isBilimit {b : BinaryBicone X Y} (h : b.IsBilimit) :
    IsPushout (0 : 0 ⟶ X) (0 : 0 ⟶ Y) b.inl b.inr := by
  convert IsPushout.of_is_coproduct' h.isColimit HasZeroObject.zeroIsInitial
#align category_theory.is_pushout.of_is_bilimit CategoryTheory.IsPushout.of_isBilimit

@[simp]
theorem of_has_biproduct (X Y : C) [HasBinaryBiproduct X Y] :
    IsPushout (0 : 0 ⟶ X) (0 : 0 ⟶ Y) biprod.inl biprod.inr :=
  of_isBilimit (BinaryBiproduct.isBilimit X Y)
#align category_theory.is_pushout.of_has_biproduct CategoryTheory.IsPushout.of_has_biproduct

theorem inl_snd' {b : BinaryBicone X Y} (h : b.IsBilimit) :
    IsPushout b.inl (0 : X ⟶ 0) b.snd (0 : 0 ⟶ Y) := by
  apply flip
  refine' of_right _ (by simp) (of_isBilimit h)
  simp
#align category_theory.is_pushout.inl_snd' CategoryTheory.IsPushout.inl_snd'

/-- The square
```
  X --inl--> X ⊞ Y
  |            |
  0           snd
  |            |
  v            v
  0 ---0-----> Y
```
is a pushout square.
-/
theorem inl_snd (X Y : C) [HasBinaryBiproduct X Y] :
    IsPushout biprod.inl (0 : X ⟶ 0) biprod.snd (0 : 0 ⟶ Y) :=
  inl_snd' (BinaryBiproduct.isBilimit X Y)
#align category_theory.is_pushout.inl_snd CategoryTheory.IsPushout.inl_snd

theorem inr_fst' {b : BinaryBicone X Y} (h : b.IsBilimit) :
    IsPushout b.inr (0 : Y ⟶ 0) b.fst (0 : 0 ⟶ X) := by
  refine' of_bot _ (by simp) (of_isBilimit h)
  simp
#align category_theory.is_pushout.inr_fst' CategoryTheory.IsPushout.inr_fst'

/-- The square
```
  Y --inr--> X ⊞ Y
  |            |
  0           fst
  |            |
  v            v
  0 ---0-----> X
```
is a pushout square.
-/
theorem inr_fst (X Y : C) [HasBinaryBiproduct X Y] :
    IsPushout biprod.inr (0 : Y ⟶ 0) biprod.fst (0 : 0 ⟶ X) :=
  inr_fst' (BinaryBiproduct.isBilimit X Y)
#align category_theory.is_pushout.inr_fst CategoryTheory.IsPushout.inr_fst

theorem of_is_bilimit' {b : BinaryBicone X Y} (h : b.IsBilimit) :
    IsPushout b.fst b.snd (0 : X ⟶ 0) (0 : Y ⟶ 0) := by
  refine' IsPushout.of_right _ (by simp) (IsPushout.inl_snd' h)
  simp
#align category_theory.is_pushout.of_is_bilimit' CategoryTheory.IsPushout.of_is_bilimit'

theorem of_hasBinaryBiproduct (X Y : C) [HasBinaryBiproduct X Y] :
    IsPushout biprod.fst biprod.snd (0 : X ⟶ 0) (0 : Y ⟶ 0) :=
  of_is_bilimit' (BinaryBiproduct.isBilimit X Y)
#align category_theory.is_pushout.of_has_binary_biproduct CategoryTheory.IsPushout.of_hasBinaryBiproduct

instance hasPushout_biprod_fst_biprod_snd [HasBinaryBiproduct X Y] :
    HasPushout (biprod.fst : _ ⟶ X) (biprod.snd : _ ⟶ Y) :=
  HasColimit.mk ⟨_, (of_hasBinaryBiproduct X Y).isColimit⟩
#align category_theory.is_pushout.has_pushout_biprod_fst_biprod_snd CategoryTheory.IsPushout.hasPushout_biprod_fst_biprod_snd

/-- The pushout of `biprod.fst` and `biprod.snd` is the zero object. -/
def pushoutBiprodFstBiprodSnd [HasBinaryBiproduct X Y] :
    pushout (biprod.fst : _ ⟶ X) (biprod.snd : _ ⟶ Y) ≅ 0 :=
  colimit.isoColimitCocone ⟨_, (of_hasBinaryBiproduct X Y).isColimit⟩
#align category_theory.is_pushout.pushout_biprod_fst_biprod_snd CategoryTheory.IsPushout.pushoutBiprodFstBiprodSnd

end

theorem op (h : IsPushout f g inl inr) : IsPullback inr.op inl.op g.op f.op :=
  IsPullback.of_isLimit
    (IsLimit.ofIsoLimit
      (Limits.PushoutCocone.isColimitEquivIsLimitOp h.flip.cocone h.flip.isColimit)
      h.toCommSq.flip.coconeOp)
#align category_theory.is_pushout.op CategoryTheory.IsPushout.op

theorem unop {Z X Y P : Cᵒᵖ} {f : Z ⟶ X} {g : Z ⟶ Y} {inl : X ⟶ P} {inr : Y ⟶ P}
    (h : IsPushout f g inl inr) : IsPullback inr.unop inl.unop g.unop f.unop :=
  IsPullback.of_isLimit
    (IsLimit.ofIsoLimit
      (Limits.PushoutCocone.isColimitEquivIsLimitUnop h.flip.cocone h.flip.isColimit)
      h.toCommSq.flip.coconeUnop)
#align category_theory.is_pushout.unop CategoryTheory.IsPushout.unop

theorem of_horiz_isIso [IsIso f] [IsIso inr] (sq : CommSq f g inl inr) : IsPushout f g inl inr :=
  of_isColimit' sq
    (by
      refine'
        PushoutCocone.IsColimit.mk _ (fun s => inv inr ≫ s.inr) (fun s => _)
          (by aesop_cat) (by aesop_cat)
      simp only [← cancel_epi f, s.condition, sq.w_assoc, IsIso.hom_inv_id_assoc])
#align category_theory.is_pushout.of_horiz_is_iso CategoryTheory.IsPushout.of_horiz_isIso

theorem of_vert_isIso [IsIso g] [IsIso inl] (sq : CommSq f g inl inr) : IsPushout f g inl inr :=
  (of_horiz_isIso sq.flip).flip
#align category_theory.is_pushout.of_vert_is_iso CategoryTheory.IsPushout.of_vert_isIso

end IsPushout

section Equalizer

variable {X Y Z : C} {f f' : X ⟶ Y} {g g' : Y ⟶ Z}

/-- If `f : X ⟶ Y`, `g g' : Y ⟶ Z` forms a pullback square, then `f` is the equalizer of
`g` and `g'`. -/
noncomputable def IsPullback.isLimitFork (H : IsPullback f f g g') : IsLimit (Fork.ofι f H.w) := by
  fapply Fork.IsLimit.mk
  · exact fun s => H.isLimit.lift (PullbackCone.mk s.ι s.ι s.condition)
  · exact fun s => H.isLimit.fac _ WalkingCospan.left
  · intro s m e
    apply PullbackCone.IsLimit.hom_ext H.isLimit <;> refine' e.trans _ <;> symm <;>
      exact H.isLimit.fac _ _
#align category_theory.is_pullback.is_limit_fork CategoryTheory.IsPullback.isLimitFork

/-- If `f f' : X ⟶ Y`, `g : Y ⟶ Z` forms a pushout square, then `g` is the coequalizer of
`f` and `f'`. -/
noncomputable def IsPushout.isLimitFork (H : IsPushout f f' g g) : IsColimit (Cofork.ofπ g H.w) :=
  by
  fapply Cofork.IsColimit.mk
  · exact fun s => H.isColimit.desc (PushoutCocone.mk s.π s.π s.condition)
  · exact fun s => H.isColimit.fac _ WalkingSpan.left
  · intro s m e
    apply PushoutCocone.IsColimit.hom_ext H.isColimit <;> refine' e.trans _ <;> symm <;>
      exact H.isColimit.fac _ _
#align category_theory.is_pushout.is_limit_fork CategoryTheory.IsPushout.isLimitFork

end Equalizer

namespace BicartesianSq

variable {W X Y Z : C} {f : W ⟶ X} {g : W ⟶ Y} {h : X ⟶ Z} {i : Y ⟶ Z}

theorem of_isPullback_isPushout (p₁ : IsPullback f g h i) (p₂ : IsPushout f g h i) :
    BicartesianSq f g h i :=
  BicartesianSq.mk p₁ p₂.isColimit'

#align category_theory.bicartesian_sq.of_is_pullback_is_pushout CategoryTheory.BicartesianSq.of_isPullback_isPushout

theorem flip (p : BicartesianSq f g h i) : BicartesianSq g f i h :=
  of_isPullback_isPushout p.toIsPullback.flip p.toIsPushout.flip
#align category_theory.bicartesian_sq.flip CategoryTheory.BicartesianSq.flip

variable [HasZeroObject C] [HasZeroMorphisms C]

open ZeroObject

/-- ```
 X ⊞ Y --fst--> X
   |            |
  snd           0
   |            |
   v            v
   Y -----0---> 0
```
is a bicartesian square.
-/
theorem of_is_biproduct₁ {b : BinaryBicone X Y} (h : b.IsBilimit) :
    BicartesianSq b.fst b.snd (0 : X ⟶ 0) (0 : Y ⟶ 0) :=
  of_isPullback_isPushout (IsPullback.of_isBilimit h) (IsPushout.of_is_bilimit' h)
#align category_theory.bicartesian_sq.of_is_biproduct₁ CategoryTheory.BicartesianSq.of_is_biproduct₁

/-- ```
   0 -----0---> X
   |            |
   0           inl
   |            |
   v            v
   Y --inr--> X ⊞ Y
```
is a bicartesian square.
-/
theorem of_is_biproduct₂ {b : BinaryBicone X Y} (h : b.IsBilimit) :
    BicartesianSq (0 : 0 ⟶ X) (0 : 0 ⟶ Y) b.inl b.inr :=
  of_isPullback_isPushout (IsPullback.of_is_bilimit' h) (IsPushout.of_isBilimit h)
#align category_theory.bicartesian_sq.of_is_biproduct₂ CategoryTheory.BicartesianSq.of_is_biproduct₂

/-- ```
 X ⊞ Y --fst--> X
   |            |
  snd           0
   |            |
   v            v
   Y -----0---> 0
```
is a bicartesian square.
-/
@[simp]
theorem of_has_biproduct₁ [HasBinaryBiproduct X Y] :
    BicartesianSq biprod.fst biprod.snd (0 : X ⟶ 0) (0 : Y ⟶ 0) := by
  convert of_is_biproduct₁ (BinaryBiproduct.isBilimit X Y)
#align category_theory.bicartesian_sq.of_has_biproduct₁ CategoryTheory.BicartesianSq.of_has_biproduct₁

/-- ```
   0 -----0---> X
   |            |
   0           inl
   |            |
   v            v
   Y --inr--> X ⊞ Y
```
is a bicartesian square.
-/
@[simp]
theorem of_has_biproduct₂ [HasBinaryBiproduct X Y] :
    BicartesianSq (0 : 0 ⟶ X) (0 : 0 ⟶ Y) biprod.inl biprod.inr := by
  convert of_is_biproduct₂ (BinaryBiproduct.isBilimit X Y)
#align category_theory.bicartesian_sq.of_has_biproduct₂ CategoryTheory.BicartesianSq.of_has_biproduct₂

end BicartesianSq

section Functor

variable {D : Type u₂} [Category.{v₂} D]

variable (F : C ⥤ D) {W X Y Z : C} {f : W ⟶ X} {g : W ⟶ Y} {h : X ⟶ Z} {i : Y ⟶ Z}

theorem Functor.map_isPullback [PreservesLimit (cospan h i) F] (s : IsPullback f g h i) :
    IsPullback (F.map f) (F.map g) (F.map h) (F.map i) := by
  -- This is made slightly awkward because `C` and `D` have different universes,
  -- and so the relevant `WalkingCospan` diagrams live in different universes too!
  refine'
    IsPullback.of_isLimit' (F.map_commSq s.toCommSq)
      (IsLimit.equivOfNatIsoOfIso (cospanCompIso F h i) _ _ (WalkingCospan.ext _ _ _)
        (isLimitOfPreserves F s.isLimit))
  · rfl
  · simp
  . simp
#align category_theory.functor.map_is_pullback CategoryTheory.Functor.map_isPullback

theorem Functor.map_isPushout [PreservesColimit (span f g) F] (s : IsPushout f g h i) :
    IsPushout (F.map f) (F.map g) (F.map h) (F.map i) := by
  refine'
    IsPushout.of_isColimit' (F.map_commSq s.toCommSq)
      (IsColimit.equivOfNatIsoOfIso (spanCompIso F f g) _ _ (WalkingSpan.ext _ _ _)
        (isColimitOfPreserves F s.isColimit))
  · rfl
  · simp
  · simp
#align category_theory.functor.map_is_pushout CategoryTheory.Functor.map_isPushout

alias Functor.map_isPullback ← IsPullback.map
#align category_theory.is_pullback.map CategoryTheory.IsPullback.map

alias Functor.map_isPushout ← IsPushout.map
#align category_theory.is_pushout.map CategoryTheory.IsPushout.map

theorem IsPullback.of_map [ReflectsLimit (cospan h i) F] (e : f ≫ h = g ≫ i)
    (H : IsPullback (F.map f) (F.map g) (F.map h) (F.map i)) : IsPullback f g h i := by
  refine' ⟨⟨e⟩, ⟨isLimitOfReflects F <| _⟩⟩
  refine'
    (IsLimit.equivOfNatIsoOfIso (cospanCompIso F h i) _ _ (WalkingCospan.ext _ _ _)).symm
      H.isLimit
  exacts [Iso.refl _, (Category.comp_id _).trans (Category.id_comp _).symm,
    (Category.comp_id _).trans (Category.id_comp _).symm]
#align category_theory.is_pullback.of_map CategoryTheory.IsPullback.of_map

theorem IsPullback.of_map_of_faithful [ReflectsLimit (cospan h i) F] [Faithful F]
    (H : IsPullback (F.map f) (F.map g) (F.map h) (F.map i)) : IsPullback f g h i :=
  H.of_map F (F.map_injective <| by simpa only [F.map_comp] using H.w)
#align category_theory.is_pullback.of_map_of_faithful CategoryTheory.IsPullback.of_map_of_faithful

theorem IsPullback.map_iff {D : Type _} [Category D] (F : C ⥤ D) [PreservesLimit (cospan h i) F]
    [ReflectsLimit (cospan h i) F] (e : f ≫ h = g ≫ i) :
    IsPullback (F.map f) (F.map g) (F.map h) (F.map i) ↔ IsPullback f g h i :=
  ⟨fun h => h.of_map F e, fun h => h.map F⟩
#align category_theory.is_pullback.map_iff CategoryTheory.IsPullback.map_iff

theorem IsPushout.of_map [ReflectsColimit (span f g) F] (e : f ≫ h = g ≫ i)
    (H : IsPushout (F.map f) (F.map g) (F.map h) (F.map i)) : IsPushout f g h i := by
  refine' ⟨⟨e⟩, ⟨isColimitOfReflects F <| _⟩⟩
  refine'
    (IsColimit.equivOfNatIsoOfIso (spanCompIso F f g) _ _ (WalkingSpan.ext _ _ _)).symm
      H.isColimit
  exacts [Iso.refl _, (Category.comp_id _).trans (Category.id_comp _),
    (Category.comp_id _).trans (Category.id_comp _)]
#align category_theory.is_pushout.of_map CategoryTheory.IsPushout.of_map

theorem IsPushout.of_map_of_faithful [ReflectsColimit (span f g) F] [Faithful F]
    (H : IsPushout (F.map f) (F.map g) (F.map h) (F.map i)) : IsPushout f g h i :=
  H.of_map F (F.map_injective <| by simpa only [F.map_comp] using H.w)
#align category_theory.is_pushout.of_map_of_faithful CategoryTheory.IsPushout.of_map_of_faithful

theorem IsPushout.map_iff {D : Type _} [Category D] (F : C ⥤ D) [PreservesColimit (span f g) F]
    [ReflectsColimit (span f g) F] (e : f ≫ h = g ≫ i) :
    IsPushout (F.map f) (F.map g) (F.map h) (F.map i) ↔ IsPushout f g h i :=
  ⟨fun h => h.of_map F e, fun h => h.map F⟩
#align category_theory.is_pushout.map_iff CategoryTheory.IsPushout.map_iff

end Functor

end CategoryTheory


def f (x : Nat) : IO Unit := do
  match x with
  | 0 | 1 => IO.println "0 or 1"
  | _ => IO.println "greater than 1"

#eval f 0
#eval f 1
#eval f 2

def g (x : Nat) : IO Unit :=
  match x with
  | 0 | 1 => IO.println "0 or 1"
  | _ => IO.println "greater than 1"

#eval g 0
#eval g 1
#eval g 2

def h (x : Nat) : Nat :=
  match x with
  | 0 | 1 => 1
  | x + 2 => x + 1

example : h x > 0 := by
  match x with
  | 0 | 1 => decide
  | x + 2 => simp [h, Nat.add_succ]; simp_arith

inductive StrOrNum where
  | S (s : String)
  | I (i : Int)

def StrOrNum.asString (x : StrOrNum) :=
  match x with
  | I a | S a => toString a


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import topology.sheaves.presheaf
import category_theory.adjunction.fully_faithful

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

universes w v u

open category_theory
open Top
open topological_space
open opposite
open category_theory.category category_theory.functor

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

local attribute [tidy] tactic.op_induction'

namespace algebraic_geometry

/-- A `PresheafedSpace C` is a topological space equipped with a presheaf of `C`s. -/
structure PresheafedSpace :=
(carrier : Top.{w})
(presheaf : carrier.presheaf C)

variables {C}

namespace PresheafedSpace

attribute [protected] presheaf

instance coe_carrier : has_coe (PresheafedSpace.{w v u} C) Top.{w} :=
{ coe := λ X, X.carrier }

@[simp] lemma as_coe (X : PresheafedSpace.{w v u} C) : X.carrier = (X : Top.{w}) := rfl
@[simp] lemma mk_coe (carrier) (presheaf) : (({ carrier := carrier, presheaf := presheaf } :
  PresheafedSpace.{v} C) : Top.{v}) = carrier := rfl

instance (X : PresheafedSpace.{v} C) : topological_space X := X.carrier.str

/-- The constant presheaf on `X` with value `Z`. -/
def const (X : Top) (Z : C) : PresheafedSpace C :=
{ carrier := X,
  presheaf :=
  { obj := λ U, Z,
    map := λ U V f, 𝟙 Z, } }

instance [inhabited C] : inhabited (PresheafedSpace C) := ⟨const (Top.of pempty) 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 (X Y : PresheafedSpace.{w v u} C) :=
(base : (X : Top.{w}) ⟶ (Y : Top.{w}))
(c : Y.presheaf ⟶ base _* X.presheaf)

@[ext] lemma ext {X Y : PresheafedSpace C} (α β : hom X Y)
  (w : α.base = β.base)
  (h : α.c ≫ (whisker_right (eq_to_hom (by rw w)) _) = β.c) :
  α = β :=
begin
  cases α, cases β,
  dsimp [presheaf.pushforward_obj] at *,
  tidy, -- TODO including `injections` would make tidy work earlier.
end

lemma hext {X Y : PresheafedSpace C} (α β : hom X Y)
  (w : α.base = β.base)
  (h : α.c == β.c) :
  α = β :=
by { cases α, cases β, congr, exacts [w,h] }

.

/-- The identity morphism of a `PresheafedSpace`. -/
def id (X : PresheafedSpace.{w v u} C) : hom X X :=
{ base := 𝟙 (X : Top.{w}),
  c := eq_to_hom (presheaf.pushforward.id_eq X.presheaf).symm }

instance hom_inhabited (X : PresheafedSpace C) : inhabited (hom X X) := ⟨id X⟩

/-- Composition of morphisms of `PresheafedSpace`s. -/
def comp {X Y Z : PresheafedSpace C} (α : hom X Y) (β : hom Y Z) : hom X Z :=
{ base := α.base ≫ β.base,
  c := β.c ≫ (presheaf.pushforward _ β.base).map α.c }

lemma comp_c {X Y Z : PresheafedSpace C} (α : hom X Y) (β : hom Y Z) :
  (comp α β).c = β.c ≫ (presheaf.pushforward _ β.base).map α.c := rfl

variables (C)

section
local attribute [simp] id comp

/- 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. -/
instance category_of_PresheafedSpaces : category (PresheafedSpace.{v v u} C) :=
{ hom := hom,
  id := id,
  comp := λ X Y Z f g, comp f g,
  id_comp' := λ X Y f, begin
    ext1,
    { rw comp_c,
      erw eq_to_hom_map,
      simp only [eq_to_hom_refl, assoc, whisker_right_id'],
      erw [comp_id, comp_id] },
    apply id_comp
  end,
  comp_id' := λ X Y f, begin
    ext1,
    { rw comp_c,
      erw congr_hom (presheaf.id_pushforward _) f.c,
      simp only [comp_id, functor.id_map, eq_to_hom_refl, assoc, whisker_right_id'],
      erw eq_to_hom_trans_assoc,
      simp only [id_comp, eq_to_hom_refl],
      erw comp_id },
    apply comp_id
  end,
  assoc' := λ W X Y Z f g h, begin
    ext1,
    repeat {rw comp_c},
    simp only [eq_to_hom_refl, assoc, functor.map_comp, whisker_right_id'],
    erw comp_id,
    congr,
    refl
  end }

end

variables {C}
local attribute [simp] eq_to_hom_map

@[simp] lemma id_base (X : PresheafedSpace.{v v u} C) :
  ((𝟙 X) : X ⟶ X).base = 𝟙 (X : Top.{v}) := rfl

lemma id_c (X : PresheafedSpace.{v v u} C) :
  ((𝟙 X) : X ⟶ X).c = eq_to_hom (presheaf.pushforward.id_eq X.presheaf).symm := rfl

@[simp] lemma id_c_app (X : PresheafedSpace.{v v u} C) (U) :
  ((𝟙 X) : X ⟶ X).c.app U = X.presheaf.map
    (eq_to_hom (by { induction U using opposite.rec, cases U, refl })) :=
by { induction U using opposite.rec, cases U, simp only [id_c], dsimp, simp, }

@[simp] lemma comp_base {X Y Z : PresheafedSpace.{v v u} C} (f : X ⟶ Y) (g : Y ⟶ Z) :
  (f ≫ g).base = f.base ≫ g.base := rfl

instance (X Y : PresheafedSpace.{v v u} C) : has_coe_to_fun (X ⟶ Y) (λ _, X → Y) :=
⟨λ f, f.base⟩

lemma coe_to_fun_eq {X Y : PresheafedSpace.{v v u} C} (f : X ⟶ Y) : (f : X → Y) = f.base := rfl

-- The `reassoc` attribute was added despite the LHS not being a composition of two homs,
-- for the reasons explained in the docstring.
/-- Sometimes rewriting with `comp_c_app` doesn't work because of dependent type issues.
In that case, `erw comp_c_app_assoc` might make progress.
The lemma `comp_c_app_assoc` is also better suited for rewrites in the opposite direction. -/
@[reassoc, simp] lemma comp_c_app {X Y Z : PresheafedSpace.{v v u} C} (α : X ⟶ Y) (β : Y ⟶ Z) (U) :
  (α ≫ β).c.app U = (β.c).app U ≫ (α.c).app (op ((opens.map (β.base)).obj (unop U))) := rfl

lemma congr_app {X Y : PresheafedSpace.{v v u} C} {α β : X ⟶ Y} (h : α = β) (U) :
  α.c.app U = β.c.app U ≫ X.presheaf.map (eq_to_hom (by subst h)) :=
by { subst h, dsimp, simp, }

section
variables (C)

/-- The forgetful functor from `PresheafedSpace` to `Top`. -/
@[simps]
def forget : PresheafedSpace.{v v u} C ⥤ Top :=
{ obj := λ X, (X : Top.{v}),
  map := λ X Y f, f.base }

end

section iso

variables {X Y : PresheafedSpace.{v v u} C}

/--
An isomorphism of PresheafedSpaces is a homeomorphism of the underlying space, and a
natural transformation between the sheaves.
-/
@[simps hom inv]
def iso_of_components (H : X.1 ≅ Y.1) (α : H.hom _* X.2 ≅ Y.2) : X ≅ Y :=
{ hom := { base := H.hom, c := α.inv },
  inv := { base := H.inv,
    c := presheaf.to_pushforward_of_iso H α.hom },
  hom_inv_id' := by { ext, { simp, erw category.id_comp, simpa }, simp },
  inv_hom_id' :=
  begin
    ext x,
    induction x using opposite.rec,
    simp only [comp_c_app, whisker_right_app, presheaf.to_pushforward_of_iso_app,
      nat_trans.comp_app, eq_to_hom_app, id_c_app, category.assoc],
    erw [← α.hom.naturality],
    have := nat_trans.congr_app (α.inv_hom_id) (op x),
    cases x,
    rw nat_trans.comp_app at this,
    convert this,
    { dsimp, simp },
    { simp },
    { simp }
  end }

/-- Isomorphic PresheafedSpaces have natural isomorphic presheaves. -/
@[simps]
def sheaf_iso_of_iso (H : X ≅ Y) : Y.2 ≅ H.hom.base _* X.2 :=
{ hom := H.hom.c,
  inv := presheaf.pushforward_to_of_iso ((forget _).map_iso H).symm H.inv.c,
  hom_inv_id' :=
  begin
    ext U,
    have := congr_app H.inv_hom_id U,
    simp only [comp_c_app, id_c_app,
      eq_to_hom_map, eq_to_hom_trans] at this,
    generalize_proofs h at this,
    simpa using congr_arg (λ f, f ≫ eq_to_hom h.symm) this,
  end,
  inv_hom_id' :=
  begin
    ext U,
    simp only [presheaf.pushforward_to_of_iso_app, nat_trans.comp_app, category.assoc,
      nat_trans.id_app, H.hom.c.naturality],
    have := congr_app H.hom_inv_id ((opens.map H.hom.base).op.obj U),
    generalize_proofs h at this,
    simpa using congr_arg (λ f, f ≫ X.presheaf.map (eq_to_hom h.symm)) this
  end }

instance base_is_iso_of_iso (f : X ⟶ Y) [is_iso f] : is_iso f.base :=
is_iso.of_iso ((forget _).map_iso (as_iso f))

instance c_is_iso_of_iso (f : X ⟶ Y) [is_iso f] : is_iso f.c :=
is_iso.of_iso (sheaf_iso_of_iso (as_iso f))

/-- This could be used in conjunction with `category_theory.nat_iso.is_iso_of_is_iso_app`. -/
lemma is_iso_of_components (f : X ⟶ Y) [is_iso f.base] [is_iso f.c] : is_iso f :=
begin
  convert is_iso.of_iso (iso_of_components (as_iso f.base) (as_iso f.c).symm),
  ext, { simpa }, { simp },
end

end iso

section restrict

/--
The restriction of a presheafed space along an open embedding into the space.
-/
@[simps]
def restrict {U : Top} (X : PresheafedSpace.{v v u} C)
  {f : U ⟶ (X : Top.{v})} (h : open_embedding f) : PresheafedSpace C :=
{ carrier := U,
  presheaf := h.is_open_map.functor.op ⋙ X.presheaf }

/--
The map from the restriction of a presheafed space.
-/
@[simps]
def of_restrict {U : Top} (X : PresheafedSpace.{v v u} C)
  {f : U ⟶ (X : Top.{v})} (h : open_embedding f) :
  X.restrict h ⟶ X :=
{ base := f,
  c := { app := λ V, X.presheaf.map (h.is_open_map.adjunction.counit.app V.unop).op,
    naturality' := λ U V f, show _ = _ ≫ X.presheaf.map _,
      by { rw [← map_comp, ← map_comp], refl } } }

instance of_restrict_mono {U : Top} (X : PresheafedSpace C) (f : U ⟶ X.1)
   (hf : open_embedding f) : mono (X.of_restrict hf) :=
 begin
   haveI : mono f := (Top.mono_iff_injective _).mpr hf.inj,
   constructor,
   intros Z g₁ g₂ eq,
   ext V,
   { induction V using opposite.rec,
     have hV : (opens.map (X.of_restrict hf).base).obj (hf.is_open_map.functor.obj V) = V,
     { cases V, simp[opens.map, set.preimage_image_eq _ hf.inj] },
     haveI : is_iso (hf.is_open_map.adjunction.counit.app
               (unop (op (hf.is_open_map.functor.obj V)))) :=
       (nat_iso.is_iso_app_of_is_iso (whisker_left
         hf.is_open_map.functor hf.is_open_map.adjunction.counit) V : _),
     have := PresheafedSpace.congr_app eq (op (hf.is_open_map.functor.obj V)),
     simp only [PresheafedSpace.comp_c_app, PresheafedSpace.of_restrict_c_app, category.assoc,
       cancel_epi] at this,
     have h : _ ≫ _ = _ ≫ _ ≫ _ :=
       congr_arg (λ f, (X.restrict hf).presheaf.map (eq_to_hom hV).op ≫ f) this,
     erw [g₁.c.naturality, g₂.c.naturality_assoc] at h,
     simp only [presheaf.pushforward_obj_map, eq_to_hom_op,
       category.assoc, eq_to_hom_map, eq_to_hom_trans] at h,
     rw ←is_iso.comp_inv_eq at h,
     simpa using h },
   { have := congr_arg PresheafedSpace.hom.base eq,
     simp only [PresheafedSpace.comp_base, PresheafedSpace.of_restrict_base] at this,
     rw cancel_mono at this,
     exact this }
 end

lemma restrict_top_presheaf (X : PresheafedSpace C) :
  (X.restrict (opens.open_embedding ⊤)).presheaf =
  (opens.inclusion_top_iso X.carrier).inv _* X.presheaf :=
by { dsimp, rw opens.inclusion_top_functor X.carrier, refl }

lemma of_restrict_top_c (X : PresheafedSpace C) :
  (X.of_restrict (opens.open_embedding ⊤)).c = eq_to_hom
    (by { rw [restrict_top_presheaf, ←presheaf.pushforward.comp_eq],
          erw iso.inv_hom_id, rw presheaf.pushforward.id_eq }) :=
  /- another approach would be to prove the left hand side
     is a natural isoomorphism, but I encountered a universe
     issue when `apply nat_iso.is_iso_of_is_iso_app`. -/
begin
  ext U, change X.presheaf.map _ = _, convert eq_to_hom_map _ _ using 1,
  congr, simpa,
  { induction U using opposite.rec, dsimp, congr, ext,
    exact ⟨ λ h, ⟨⟨x,trivial⟩,h,rfl⟩, λ ⟨⟨_,_⟩,h,rfl⟩, h ⟩ },
  /- or `rw [opens.inclusion_top_functor, ←comp_obj, ←opens.map_comp_eq],
         erw iso.inv_hom_id, cases U, refl` after `dsimp` -/
end

/--
The map to the restriction of a presheafed space along the canonical inclusion from the top
subspace.
-/
@[simps]
def to_restrict_top (X : PresheafedSpace C) :
  X ⟶ X.restrict (opens.open_embedding ⊤) :=
{ base := (opens.inclusion_top_iso X.carrier).inv,
  c := eq_to_hom (restrict_top_presheaf X) }

/--
The isomorphism from the restriction to the top subspace.
-/
@[simps]
def restrict_top_iso (X : PresheafedSpace C) :
  X.restrict (opens.open_embedding ⊤) ≅ X :=
{ hom := X.of_restrict _,
  inv := X.to_restrict_top,
  hom_inv_id' := ext _ _ (concrete_category.hom_ext _ _ $ λ ⟨x, _⟩, rfl) $
    by { erw comp_c, rw X.of_restrict_top_c, ext, simp },
  inv_hom_id' := ext _ _ rfl $
    by { erw comp_c, rw X.of_restrict_top_c, ext, simpa [-eq_to_hom_refl] } }

end restrict

/--
The global sections, notated Gamma.
-/
@[simps]
def Γ : (PresheafedSpace.{v v u} C)ᵒᵖ ⥤ C :=
{ obj := λ X, (unop X).presheaf.obj (op ⊤),
  map := λ X Y f, f.unop.c.app (op ⊤) }

lemma Γ_obj_op (X : PresheafedSpace C) : Γ.obj (op X) = X.presheaf.obj (op ⊤) := rfl

lemma Γ_map_op {X Y : PresheafedSpace.{v v u} C} (f : X ⟶ Y) :
  Γ.map f.op = f.c.app (op ⊤) := rfl

end PresheafedSpace

end algebraic_geometry

open algebraic_geometry algebraic_geometry.PresheafedSpace

variables {C}

namespace category_theory

variables {D : Type u} [category.{v} D]

local attribute [simp] presheaf.pushforward_obj

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 (F : C ⥤ D) : PresheafedSpace.{v v u} C ⥤ PresheafedSpace.{v v u} D :=
{ obj := λ X, { carrier := X.carrier, presheaf := X.presheaf ⋙ F },
  map := λ X Y f, { base := f.base, c := whisker_right f.c F }, }

@[simp] lemma map_presheaf_obj_X (F : C ⥤ D) (X : PresheafedSpace C) :
  ((F.map_presheaf.obj X) : Top.{v}) = (X : Top.{v}) := rfl
@[simp] lemma map_presheaf_obj_presheaf (F : C ⥤ D) (X : PresheafedSpace C) :
  (F.map_presheaf.obj X).presheaf = X.presheaf ⋙ F := rfl
@[simp] lemma map_presheaf_map_f (F : C ⥤ D) {X Y : PresheafedSpace.{v v u} C} (f : X ⟶ Y) :
  (F.map_presheaf.map f).base = f.base := rfl
@[simp] lemma map_presheaf_map_c (F : C ⥤ D) {X Y : PresheafedSpace.{v v u} C} (f : X ⟶ Y) :
  (F.map_presheaf.map f).c = whisker_right f.c F := rfl

end functor

namespace nat_trans

/--
A natural transformation induces a natural transformation between the `map_presheaf` functors.
-/
def on_presheaf {F G : C ⥤ D} (α : F ⟶ G) : G.map_presheaf ⟶ F.map_presheaf :=
{ app := λ X,
  { base := 𝟙 _,
    c := whisker_left X.presheaf α ≫ eq_to_hom (presheaf.pushforward.id_eq _).symm } }

-- TODO Assemble the last two constructions into a functor
--   `(C ⥤ D) ⥤ (PresheafedSpace C ⥤ PresheafedSpace D)`
end nat_trans

end category_theory


import pq_to_group
import automorphism
import group_theory.semidirect_product

universes u1 u2

section semidirect_union

variables {Q1 : Type u1} {Q2 : Type u2} [power_quandle Q1] [power_quandle Q2]

variables (φ : Q2 → automorphism Q1) (hφ : is_pq_morphism φ)

inductive semidirect_union (Q1 : Type u1) (Q2 : Type u2) [power_quandle Q1] [power_quandle Q2] (φ : Q2 → automorphism Q1) (hφ : is_pq_morphism φ) : Type (max u1 u2)
| inl (x : Q1) : semidirect_union
| inr (x : Q2) : semidirect_union

open semidirect_union

def semidirect_union_rhd : semidirect_union Q1 Q2 φ hφ → semidirect_union Q1 Q2 φ hφ → semidirect_union Q1 Q2 φ hφ
| (inl x) (inl y) := inl (x ▷ y)
| (inl x) (inr y) := inr y
| (inr x) (inr y) := inr (x ▷ y)
| (inr x) (inl y) := inl ((φ x).f y)

instance semidirect_union_has_rhd : has_triangle_right (semidirect_union Q1 Q2 φ hφ) := ⟨semidirect_union_rhd φ hφ⟩

def semidirect_union_pow : semidirect_union Q1 Q2 φ hφ → ℤ → semidirect_union Q1 Q2 φ hφ
| (inl x) n := inl (x ^ n)
| (inr x) n := inr (x ^ n)

instance semidirect_union_has_pow : has_pow (semidirect_union Q1 Q2 φ hφ) ℤ := ⟨semidirect_union_pow φ hφ⟩

def semidirect_union_lhd : semidirect_union Q1 Q2 φ hφ → semidirect_union Q1 Q2 φ hφ → semidirect_union Q1 Q2 φ hφ := λ x y, (x ^ (-1 : ℤ)) ▷ y

instance semidirect_union_has_lhd : has_triangle_left (semidirect_union Q1 Q2 φ hφ) := ⟨semidirect_union_lhd φ hφ⟩

@[simp] lemma rhd_def_semidirect_union_ll (a b : Q1) : (inl a : semidirect_union Q1 Q2 φ hφ) ▷ (inl b) = inl (a ▷ b) := rfl
@[simp] lemma rhd_def_semidirect_union_rr (a b : Q2) : (inr a : semidirect_union Q1 Q2 φ hφ) ▷ (inr b) = inr (a ▷ b) := rfl
@[simp] lemma rhd_def_semidirect_union_lr (a : Q1) (b : Q2) : (inl a : semidirect_union Q1 Q2 φ hφ) ▷ (inr b) = inr (b) := rfl
@[simp] lemma rhd_def_semidirect_union_rl (a : Q2) (b : Q1) : (inr a : semidirect_union Q1 Q2 φ hφ) ▷ (inl b) = inl ((φ a).f b) := rfl

instance semidirect_union_pq : power_quandle (semidirect_union Q1 Q2 φ hφ) := {
  right_dist := sorry,
  left_dist := sorry,
  right_inv := sorry,
  left_inv := sorry,
  self_idem_right := sorry,
  self_idem_left := sorry,
  pow_1 := sorry,
  pow_comp := sorry,
  q_pow0 := sorry,
  q_pown_right := sorry,
  q_powneg_left := sorry,
  q_powadd := sorry ,
  ..semidirect_union_has_rhd,
  ..semidirect_union_has_lhd,
  ..semidirect_union_has_pow,}

end semidirect_union

section pq_group_semidirect_union

variables {Q1 : Type u1} {Q2 : Type u2} [power_quandle Q1] [power_quandle Q2]

variables (φ : Q2 → automorphism (Q1)) (hφ : is_pq_morphism φ)

def L_of_action (φ : Q2 → automorphism (Q1)) (hφ : is_pq_morphism φ) : pq_group Q2 →* mul_aut (pq_group Q1) :=
begin
  fapply pq_morph_to_L_morph_adj,
  {
    intro x,
    let φx := φ x,
    let φx' : Q1 ≃ Q1 := {
      to_fun := φx.f,
      inv_fun := φx.finv,
      left_inv := begin
        apply congr_fun,
        exact φx.hfinvf,
      end,
      right_inv := begin
        apply congr_fun,
        exact φx.hffinv,
      end,
    },
    refine L_of_morph_iso φx' _,
    exact φx.hf,
  },
  {
    simp only,
    split,
    {
      intros a b,
      simp only,
      rw rhd_def,
      --ext1,
      --simp only [mul_aut.mul_apply],
      rw hφ.1,
      rw rhd_def,
      simp_rw automorphism_f_of_comp,
      simp_rw automorphism_f_of_inverse,
      simp_rw automorphism_finv_of_comp,
      simp_rw automorphism_finv_of_inverse,
      sorry,

    },
    {
      sorry,
    },
  },
end

def pq_group_oplus_to_prod : pq_group (semidirect_union Q1 Q2 φ hφ) →* pq_group Q1 ⋊[L_of_action φ hφ] pq_group Q2 :=
begin
  fapply pq_morph_to_L_morph_adj,
  {
    intro x,
    cases x,
    {
      exact ⟨of x, 1⟩,
    },
    {
      exact ⟨1, of x⟩,
    },
  },
  {
    split,
    {
      intros a b,
      cases a;
      cases b,
      {
        rw rhd_def_semidirect_union_ll,
        simp only,
        rw ←rhd_of_eq_of_rhd,
        rw rhd_def,
        rw rhd_def,
        simp only [semidirect_product.mk_eq_inl_mul_inr, mul_one, monoid_hom.map_mul, eq_self_iff_true, monoid_hom.map_mul_inv,
  mul_left_inj, semidirect_product.inl_inj, monoid_hom.map_one],
      },
      {
        rw rhd_def_semidirect_union_lr,
        simp only,
        rw rhd_def,
        simp only [semidirect_product.mk_eq_inl_mul_inr, mul_one, one_mul, monoid_hom.map_one],

      },
      {
        rw rhd_def_union_rl,
        simp only,
        rw rhd_def,
        simp only [one_inv, mul_one, one_mul, prod.inv_mk, mul_right_inv, prod.mk_mul_mk],
      },
      {
        rw rhd_def_union_rr,
        simp only,
        rw ←rhd_of_eq_of_rhd,
        rw rhd_def,
        rw rhd_def,
        simp only [one_inv, mul_one, prod.inv_mk, prod.mk_mul_mk],
      },
    },
    {
      intros a n,
      cases a,
      {
        rw pow_def_union_l,
        simp only,
        rw of_pow_eq_pow_of,
        rw group_prod_pow,
        simp only [one_gpow],
      },
      {
        rw pow_def_union_r,
        simp only,
        rw of_pow_eq_pow_of,
        rw group_prod_pow,
        simp only [one_gpow],
      },
    }
  }
end

def pq_group_semidirect_union : pq_group (semidirect_union Q1 Q2 φ hφ) ≃* pq_group Q1 ⋊[L_of_action φ hφ] pq_group Q2 := {
  to_fun := sorry,
  inv_fun := sorry,
  left_inv := sorry,
  right_inv := sorry,
  map_mul' := sorry }

end pq_group_semidirect_union


import Fine.Semantics.Model
import Fine.Semantics.Satisfaction
import Fine.Hilbert.SystemB
import Fine.PropositionalLanguage

def formalTheory (Γ : Ctx) : Prop := ∀{f : Form}, f ∈ Γ ↔ Γ ⊢ f

abbrev Th := { Γ : Ctx // formalTheory Γ }

def generatedTheory (Γ : Ctx) : Ctx := BProvable Γ

prefix:512 "▲" => generatedTheory

theorem generatedFormal : ∀Γ : Ctx, formalTheory (▲Γ) := by
   unfold formalTheory
   intros Γ f
   apply Iff.intro
   · intros h₁
     exact Nonempty.intro $ BProof.ax h₁
   · intros h₁; cases h₁; rename_i w; induction w
     case intro.ax => assumption
     case intro.mp _ _ _ h₂ ih =>
       have ⟨prf⟩ := ih
       exact ⟨BProof.mp prf h₂⟩
     case intro.adj ih₁ ih₂ =>
       have ⟨prf₁⟩ := ih₁
       have ⟨prf₂⟩ := ih₂
       exact ⟨BProof.adj prf₁ prf₂⟩

def DisjunctionClosed (Γ : Ctx) := ∀{f g : Form}, f ∈ Γ ∧ g ∈ Γ → f ¦ g ∈ Γ

def PrimeTheory (Γ : Ctx) := ∀{f g : Form}, f ¦ g ∈ Γ → f ∈ Γ ∨ g ∈ Γ

abbrev Pr := { Γ : Th // PrimeTheory Γ }

def FormalDual (Γ : Ctx) : Ctx :=
  λf : Form => ¬(~f ∈ Γ)

lemma generatedDisjunction {f g h: Form} : f ∈ ▲{g} ∧ f ∈ ▲{h} → f ∈ ▲{g ¦ h} := by
  intros h₁
  have ⟨⟨prf₁⟩,⟨prf₂⟩⟩ := h₁
  have l₁ := BTheorem.fromProof prf₁
  have l₂ := BTheorem.fromProof prf₂
  have l₃ := (BTheorem.mp (BTheorem.adj l₁ l₂) BTheorem.orE)
  exact ⟨BTheorem.toProof l₃⟩

lemma formalFixed {Γ : Ctx} : formalTheory Γ → ▲Γ = Γ := by
  intros h₁
  funext
  case h x =>
    ext
    apply Iff.intro
    · intros a
      exact h₁.mpr a
    · intros a
      exact h₁.mp a

lemma BisFormal : formalTheory BTheory := by
  unfold formalTheory
  intros f
  apply Iff.intro
  · intro a
    exact ⟨BProof.ax a⟩
  · intro h₁
    have ⟨prf₁⟩ := h₁
    induction prf₁
    . assumption
    case mp P Q prf₁ thm₁ ih =>
      have l₁ := ih ⟨prf₁⟩
      have ⟨thm₂⟩ := l₁
      exact ⟨BTheorem.mp thm₂ thm₁⟩
    case adj P Q prf₁ prf₂ ih₁ ih₂ =>
      have ⟨l₁⟩ := ih₁ ⟨prf₁⟩
      have ⟨l₂⟩ := ih₂ ⟨prf₂⟩
      exact ⟨BTheorem.adj l₁ l₂⟩

def FormalApplication (Γ : Ctx) (Δ : Ctx) : Ctx := λf : Form => ∃g : Form, g ∈ Δ ∧ (g ⊃ f) ∈ Γ

def formalApplicationFunction : Th → Th → Th
  | ⟨Δ, h₁⟩, ⟨Γ, h₂⟩ => by
    unfold Th; unfold formalTheory
    apply Subtype.mk
    case val => exact FormalApplication Δ Γ
    case property =>
      intros f
      apply Iff.intro
      intros h₁
      case mp => exact ⟨BProof.ax h₁⟩
      case mpr =>
        intros h₂
        have ⟨prf⟩ := h₂
        induction prf
        case ax => assumption
        case mp _ P Q prf thm ih₁ =>
          have ⟨R, l₁⟩ := ih₁ ⟨prf⟩
          have prf₂ := BProof.ax l₁.2
          have l₃ := BProof.mp prf₂ (BTheorem.transitivityRight thm)
          have l₄ := h₁.mpr ⟨l₃⟩
          exact ⟨R, l₁.1, l₄⟩
        case adj h₃ P Q prf₁ prf₂ ih₁ ih₂ =>
          unfold FormalApplication
          have ⟨R, l₁⟩ := ih₁ ⟨prf₁⟩
          have prf₃ := BProof.ax l₁.2
          have ⟨S, l₂⟩ := ih₂ ⟨prf₂⟩
          have prf₄ := BProof.ax l₂.2
          have l₃ : BProof Δ (R & S ⊃ P) := BProof.mp prf₃ (BTheorem.transitivityLeft BTheorem.andE₁)
          have l₄ : BProof Δ (R & S ⊃ Q) := BProof.mp prf₄ (BTheorem.transitivityLeft BTheorem.andE₂)
          have l₅ : BProof Δ (R & S ⊃ P & Q) := BProof.mp (BProof.adj l₃ l₄) BTheorem.andI
          have l₆ : BProof Γ (R & S) := BProof.adj (BProof.ax l₁.1) (BProof.ax l₂.1)
          exact ⟨R&S, h₃.mpr ⟨l₆⟩, h₁.mpr ⟨l₅⟩⟩

example {Γ : Th} {Δ : Th} : FormalApplication Γ Δ = formalApplicationFunction Γ Δ := rfl

theorem formalStarFormal (Γ : Ctx) (h₁: formalTheory Γ) (h₂ : PrimeTheory Γ) : formalTheory (FormalDual Γ) := by
  unfold formalTheory
  intros F
  apply Iff.intro <;> intros h₃ <;> unfold FormalDual
  case mp => exact ⟨BProof.ax h₃⟩
  case mpr =>
    have ⟨prf₁⟩ := h₃
    induction prf₁
    case ax => assumption
    case mp P Q prf₂ thm₁ ih₁ =>
      intros h₄
      have l₁ := ih₁ ⟨prf₂⟩
      unfold FormalDual at l₁
      have thm₂ : BTheorem (~Q ⊃ ~P) := BTheorem.cp $ BTheorem.transitivity thm₁ (BTheorem.cp BTheorem.taut)
      have prf₂ := BProof.mp (BProof.ax h₄) thm₂
      exact l₁ (h₁.mpr ⟨prf₂⟩)
    case adj P Q prf₁ prf₂ ih₁ ih₂ =>
      intros h₄
      have l₁ := ih₁ ⟨prf₁⟩
      have l₂ := ih₂ ⟨prf₂⟩
      have prf₃ := BProof.mp (BProof.ax h₄) BTheorem.demorgansLaw3
      have l₃ := h₂ (h₁.mpr ⟨prf₃⟩)
      cases l₃
      case inl left => exact l₁ left
      case inr right => exact l₂ right

section

open Classical

def primeStarFunction (Γ : Pr) : Pr := by
    unfold Pr
    apply Subtype.mk
    case val => exact ⟨FormalDual Γ, formalStarFormal Γ.1.1 Γ.1.2 Γ.2⟩
    case property =>
      unfold PrimeTheory
      intros P Q h₃
      apply byContradiction
      intros h₄
      have l₁ : P¦Q ∈ FormalDual Γ := h₃
      have l₂ : ¬(P ∈ FormalDual Γ ∨ Q ∈ FormalDual Γ) := h₄
      have l₃ : ~P ∈ Γ.1.1 := byContradiction $ λh => l₂ $ Or.inl h
      have l₄ : ~Q ∈ Γ.1.1 := byContradiction $ λh => l₂ $ Or.inr h
      have l₅ : ~(P ¦ Q) ∈ Γ.1.1 := Γ.1.2.mpr $ ⟨BProof.mp (BProof.adj (BProof.ax l₃) (BProof.ax l₄)) BTheorem.demorgansLaw4⟩
      exact l₁ l₅

example {Γ : Pr} : FormalDual Γ = primeStarFunction Γ := rfl

end


import QL.FOL.semantics QL.FOL.pnf QL.FOL.language

universe u

namespace fol
variables (L : language.{u})
open_locale logic_symbol
open subformula logic logic.Theory

namespace language

@[reducible] def skolem : language :=
{ fn := λ m, pnf L m 1, pr := λ _, pempty }

instance : inhabited ((L + L.skolem).fn 0) := ⟨sum.inr default⟩

def skolem' := skolem L + L

namespace skolem

instance [∀ n, has_to_string (L.fn n)] [∀ n, has_to_string (L.pr n)] (n) : has_to_string (L.skolem.fn n) :=
pnf.has_to_string

instance [∀ n, has_to_string (L.fn n)] [∀ n, has_to_string (L.pr n)] (n) : has_to_string (L.skolem.pr n) :=
⟨by rintros ⟨⟩⟩

end skolem

end language

variables {L}

namespace pnf
variables {m n : ℕ}

def skolem_term (φ : pnf L m 1) : subterm L.skolem m 0 := subterm.function φ subterm.metavar

@[simp] def skolemize : Π {m}, pnf L m 0 → pnf (L + L.skolem) m 0
| n (openformula p hp) := openformula p.left (by simpa[left] using hp)
| n (fal φ)            := ∀'pnf.pull (push φ).skolemize
| n (ex φ)             := pnf.msubst (skolem_term φ).right (push φ).skolemize
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.2.rank)⟩]}

@[simp] lemma forall_pnf_skolemize : ∀ {m} (φ : pnf L m 0), φ.skolemize.forall_pnf
| m (openformula p hp) := by simp
| m (fal φ)            := by simp; exact forall_pnf_skolemize (push φ)
| m (ex φ)             := by simp; exact forall_pnf_skolemize (push φ)
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.2.rank)⟩]}

end pnf

namespace subformula
variables {m n : ℕ} (Sₛₖ : Structure (L + L.skolem)) (T : preTheory L m)

def to_snf (p : formula L m) : formula (L + L.skolem) m := p.to_pnf.skolemize.to_formula

end subformula

namespace skolem
open language pnf
variables {m n : ℕ} (Sₛₖ : Structure (L + L.skolem)) (T : preTheory L m)

lemma val_open_formula (me) (p : formula L m) : Sₛₖ ⊧[me] p.left ↔ Sₛₖ.restrict add_left ⊧[me] p :=
(Structure.of_lfin.formula_val_iff Sₛₖ add_left me p).symm

lemma restrict_val : ∀ {m} (me) (φ : pnf L m 0),
  Sₛₖ ⊧[me] φ.skolemize.to_formula → Sₛₖ.restrict add_left ⊧[me] φ.to_formula
| m me (openformula p hp) := by simpa using (val_open_formula Sₛₖ me p).mp
| m me (fal φ)            :=
    begin
      simp, intros h x,
      have IH : Sₛₖ ⊧[x *> me] φ.push.skolemize.to_formula → formula.val (Sₛₖ.restrict add_left) (x *> me) φ.push.to_formula,
      from restrict_val (x *> me) φ.push,
      simpa[formula.val] using IH (h x)
    end
| m me (ex φ)            :=
    begin
      simp, intros h,
      let z := subterm.val Sₛₖ me fin.nil φ.skolem_term.right,
      have h : Sₛₖ ⊧[z *> me] φ.push.skolemize.to_formula, by simpa using h,
      refine ⟨z, by simpa using restrict_val (z *> me) φ.push h⟩
    end
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.2.2.rank)⟩]}

variables {Sₛₖ}

lemma restrict_models (p : formula L m) :
  Sₛₖ ⊧ p.to_snf → Sₛₖ.restrict add_left ⊧ p := λ h me,
begin
  have iff : ∀ me, Sₛₖ.restrict add_left ⊧[me] p.normalize ↔ Sₛₖ.restrict add_left ⊧[me] p,
  by simpa[models_def] using logic.sound.tautology_of_tautology (Sₛₖ.restrict add_left) (p.normalize ⟷ p) (equiv_normalize ∅ p),
  have : Sₛₖ.restrict add_left ⊧[me] p.normalize, from restrict_val Sₛₖ me p.to_pnf (h me),
  exact (iff me).mp this
end

variables (S : Structure L)

@[reducible] noncomputable def Skolemize : Structure (L + L.skolem) :=
{ dom := S,
  dom_inhabited := S.dom_inhabited,
  fn := λ m f, sum.cases_on f S.fn (λ φ me, classical.epsilon (λ z, val S me (fin.nil <* z) φ.to_formula)),
  pr := λ n r, sum.cases_on r S.pr (by rintros ⟨⟩) }

def to_Skolemize : S →ₛ[add_left] Skolemize S :=
{ to_fun := id,
  injective := function.injective_id,
  map_fn' := by intros; refl,
  map_pr' := by intros; refl }

variables {S}

lemma Str_sk_val_open_formula (me) (p : formula L m) : S ⊧[me] p ↔ Skolemize S ⊧[me] p.left :=
by simpa using Structure.hom.val_iff_of_surjective (to_Skolemize S) function.surjective_id me fin.nil p

noncomputable def sk_value (me) (φ : pnf L m 1) := subterm.val (Skolemize S) me fin.nil φ.skolem_term.right

lemma sk_value_spec (me) (φ : pnf L m 1) (z) (h : val S me (fin.nil <* z) φ.to_formula) :
  val S me (fin.nil <* sk_value me φ) φ.to_formula:=
classical.epsilon_spec ⟨z, h⟩

variables (S)

lemma Skolemize_val : ∀ {m} (me) (φ : pnf L m 0),
  S ⊧[me] φ.to_formula → Skolemize S ⊧[me] φ.skolemize.to_formula
| m me (openformula p hp) := by simpa using (Str_sk_val_open_formula me p).mp
| m me (fal φ)            :=
    begin
      simp, intros h x,
      have : val S me ((fin.nil : fin 0 → S) <* x) φ.to_formula → Skolemize S ⊧[x *> me] φ.push.skolemize.to_formula,
      by simpa using Skolemize_val (x *> me) φ.push,
      exact this (h x)
    end
| m me (ex φ)            :=
    begin
      simp, intros z h,
      show Skolemize S ⊧[sk_value me φ *> me] φ.push.skolemize.to_formula,
      have : val S me (fin.nil <* sk_value me φ) φ.to_formula → Skolemize S ⊧[sk_value me φ *> me] φ.push.skolemize.to_formula,
        by simpa using Skolemize_val (sk_value me φ *> me) φ.push,
      exact this (sk_value_spec me φ z h)
    end
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ x, x.2.2.rank)⟩]}

variables {S}

lemma Skolemize_models (p : formula L m) :
  S ⊧ p → Skolemize S ⊧ p.to_snf := λ h me,
begin
  have iff : ∀ me, S ⊧[me] p.normalize ↔ S ⊧[me] p,
  by simpa[models_def] using logic.sound.tautology_of_tautology S (p.normalize ⟷ p) (equiv_normalize ∅ p),
  exact Skolemize_val S me p.to_pnf ((iff me).mpr (h me))
end

lemma satisfiability (p : formula L m) : satisfiable p.to_snf ↔ satisfiable p :=
⟨by { rintros ⟨Sₛₖ, hSₛₖ⟩, refine ⟨Sₛₖ.restrict add_left, restrict_models p hSₛₖ⟩ },
 by { rintros ⟨S, hS⟩, refine ⟨Skolemize S, Skolemize_models p hS⟩ }⟩

lemma Satisfiability {T : preTheory L m} : Satisfiable (subformula.to_snf '' T) ↔ Satisfiable T :=
⟨by { rintros ⟨Sₛₖ, hSₛₖ⟩,
      refine ⟨Sₛₖ.restrict add_left,
        by { simp[logic.semantics.Models_def], intros p hp,
             have : Sₛₖ ⊧ p.to_snf, from hSₛₖ (by simp; refine ⟨p, by simp[hp]⟩),
             exact restrict_models p this }⟩ },
 by { rintros ⟨S, hS⟩,
      refine ⟨Skolemize S, by { simp[logic.semantics.Models_def], intros p hp, exact Skolemize_models p (hS hp) }⟩ }⟩

end skolem

private def s : subformula language.empty 0 0 := ∀' ∃' ∀' ∃'((#0 =' #1) ⟶ (#2 =' #3))

#eval to_string s
#eval to_string s.to_pnf
#eval to_string s.to_snf

end fol


example (A B C D E F G H I J K L : Type)
(f1 : A → B) (f2 : B → E) (f3 : E → D) (f4 : D → A) (f5 : E → F)
(f6 : F → C) (f7 : B → C) (f8 : F → G) (f9 : G → J) (f10 : I → J)
(f11 : J → I) (f12 : I → H) (f13 : E → H) (f14 : H → K) (f15 : I → L)
 : A → L :=
begin
intro a,
exact f15(f11(f9(f8(f5(f2(f1(a))))))),
end


import tactic data.equiv.basic
open function

lemma setoid.r.symm {V : Type} {S : setoid V} : symmetric S.r :=
λ x y, setoid.symm

def setoid.comp {V : Type} (s : setoid V) (t : setoid (quotient s)) : setoid V :=
let f : V → quotient s := quotient.mk,
    g : quotient s → quotient t := quotient.mk
in setoid.ker (g ∘ f)

def setoid.comp.iso {V : Type} (s : setoid V) (t : setoid (quotient s)) :
    quotient (s.comp t) ≃ quotient t :=
by {
    let f : V -> quotient s := quotient.mk',
    let g : quotient s -> quotient t := quotient.mk',
    let h : V -> quotient (s.comp t) := quotient.mk',

    have p₁ : ∀ {a b}, f a = f b <-> s.rel a b := λ a b, quotient.eq',
    have p₂ : ∀ {a b}, g a = g b <-> t.rel a b := λ a b, quotient.eq',
    have p₃ : ∀ {a b}, h a = h b <-> g (f a) = g (f b) := λ a b, quotient.eq',
    have p₄ : ∀ a b, s.rel a b -> h a = h b := λ a b, by { rw [p₃,<-p₁], exact congr_arg g },

    let ζ : quotient s -> quotient (s.comp t) := λ y, y.lift_on' h p₄,

    have p₅ : ∀ a b, t.rel a b -> ζ a = ζ b := λ a b, by {
        refine a.induction_on' (λ x, _), refine b.induction_on' (λ y, _), rw [<-p₂], exact p₃.mpr
    },

    exact {
        to_fun := λ x, x.lift_on' (g ∘ f) (λ _ _, id),
        inv_fun := λ y, y.lift_on' (λ y, y.lift_on' h p₄) p₅,
        left_inv := λ x, quotient.induction_on' x (λ _, rfl),
        right_inv := λ y, quotient.induction_on' y (λ b, quotient.induction_on' b (λ _, rfl)),
    }
}

lemma setoid.comp.eq {V : Type} (s : setoid V) (t : setoid (quotient s)) :
    quotient.mk' ∘ quotient.mk' = setoid.comp.iso s t ∘ quotient.mk' := by refl

namespace quotient.quotient
    variables {V : Type*} (s : setoid V) (t : setoid (quotient s))

    def setoid.comp (s : setoid V) (t : setoid (quotient s)) : setoid V :=
        let f : V → quotient s := quotient.mk,
            g : quotient s → quotient t := quotient.mk
        in setoid.ker (g ∘ f)

    noncomputable def setoid.comp.iso : quotient (setoid.comp s t) ≃ quotient t :=
        let f : V → quotient s := quotient.mk,
            g : quotient s → quotient t := quotient.mk
        in setoid.quotient_ker_equiv_of_surjective (g ∘ f)
            ((surjective_quotient_mk (quotient s)).comp (surjective_quotient_mk V))

    noncomputable def setoid.comp.iso' : quotient (setoid.comp s t) ≃ quotient t :=
        let gof : V -> quotient t := quotient.mk ∘ quotient.mk
        in setoid.quotient_ker_equiv_of_surjective gof
            ((surjective_quotient_mk (quotient s)).comp (surjective_quotient_mk V))
end quotient.quotient

namespace v1 -- start with predicate on quotient
    variables {V : Type} {S : setoid V} {P : quotient S -> Prop}

    def lift_pred (P : quotient S -> Prop) : V -> Prop
        := P ∘ quotient.mk

    def subsetoid (P : quotient S -> Prop) : setoid (subtype (lift_pred P))
        := subtype.setoid (lift_pred P)

    def iso (S : setoid V) (P : quotient S -> Prop) : subtype P ≃ quotient (subsetoid P)
        := equiv.subtype_quotient_equiv_quotient_subtype (lift_pred P) P (λ a, iff.rfl) (λ a b, iff.rfl)
end v1

noncomputable def toto {V : Type} : V ≃ quotient (⊥ : setoid V)
:= {
        to_fun := @quotient.mk V ⊥,
        inv_fun := @quotient.out V ⊥,
        left_inv := λ y, by { letI : setoid V := ⊥, exact quotient.eq.mp (quotient.out_eq ⟦y⟧) },
        right_inv := @quotient.out_eq V ⊥,
    }

namespace tactic
    meta def take_pi_args : nat → expr → list name
    | (n+1) (expr.pi h _ _ e) := h :: take_pi_args n e
    | _ _ := []

    namespace interactive
        setup_tactic_parser

        meta def doneif (h : parse ident?) (t : parse (tk ":" *> texpr))
                        (revert : parse ( (tk "generalizing" *> ((none <$ tk "*") <|> some <$> ident*)) <|> pure (some []))) :
        tactic unit := do
            let h := h.get_or_else `this,
            t ← i_to_expr ``(%%t : Sort*),
            (num_generalized, goal) ← retrieve (do
                assert_core h t, swap,
                num_generalized ← match revert with
                | none := revert_all
                | some revert := revert.mmap tactic.get_local >>= revert_lst
                end,
                goal ← target,
                return (num_generalized, goal)),
            tactic.assert h goal,
            goal ← target,
            (take_pi_args num_generalized goal).reverse.mmap' $ λ h,
                try (tactic.get_local h >>= tactic.clear),
            intron (num_generalized + 1)

        meta def wlog' (h : parse ident?) (t : parse (tk ":" *> texpr)) : tactic unit :=
        doneif h t none >> swap
    end interactive
end tactic

example (n : ℤ) (h : ∃ p q : ℤ, n = p * q) : n*n ≥ 0 :=
begin
    rcases h with ⟨p,q,h⟩, wlog' : p ≥ 0,
end

noncomputable def minimum (f : ℕ → ℕ) : ℕ :=
begin
    classical,
    exact @nat.find (λ y, ∃ x, f x = y) _ ⟨f 0, 0, rfl⟩,
end

example {f : ℕ → ℕ} : ∃ x, f x = minimum f :=
begin
    apply @nat.find_spec (λ y, ∃ x, f x = y)
end

noncomputable def minimum' (f : ℕ → ℕ) : ℕ :=
well_founded.min nat.lt_wf (set.range f) (set.range_nonempty _)

example {f : ℕ → ℕ} : ∃ x, f x = minimum' f :=
set.mem_range.mp (well_founded.min_mem _ _ _)