import data.list.alist
import o_minimal.sheaf.basic

/-
Tactics for proving goals of the form
  ⊢ definable S e
notably including the case where `e` is a function.

First we implement some ordinary `tactic.interactive` tactics
with names of the form `defin_foo`.
Then we wrap them in a special `defin` tactic mode.
-/

namespace tactic

namespace o_minimal

/-- Return the local constant (hopefully) representing the definable context. -/
meta def guess_ctx_ty : tactic expr :=
do `(o_minimal.definable_sheaf.definable (λ (_ : ↥%%var), _)) ← target,
   return var

/-- Return a list of the "definable" variables in the local context. -/
meta def guess_defin_vars (ctx_ty : expr) : tactic (list expr) :=
do l ← local_context,
   -- some kind of moption_map?
   l ← l.mmap (λ var,
     (do `(o_minimal.definable_sheaf.sect %%ctx_ty %%ty) ← infer_type var,
         return $ some var) <|> return none),
   return (l.filter_map id)

end o_minimal

namespace interactive
setup_tactic_parser

open tactic.o_minimal

/- TODO:
* more Lean-like argument parsing, e.g., `intros p q`
* probably `app` should automatically try calling `var`, say
* what to do about constants? need database of some kind
* more tactics?
-/

meta def defin_start : tactic unit :=
`[refine o_minimal.definable.mk (λ Γ, _)]

/-- Goal should look like
  ⊢ definable_sheaf.definable (λ i, λ x, e)
We want to "intro" `x` as a definable variable, and leave
  ⊢ definable_sheaf.definable (λ i, e)
as the new goal.

Strategy:
By `definable_fun_iff` it's enough to check the new goal
for an arbitrary context extension `π : Γ' ⟶ Γ` and section `x : sect Γ' α`.
However, we also have to move any existing definable variables from `Γ` to `Γ'`.
So, we proceed as follows:
* Identify the variables `i` (`i_var`) and `Γ` (`ctx_var`) in the goal
  `definable_sheaf.definable (λ (i : Γ), body)`.
  Here `body` is expected to be a function whose argument `x`
  we want to intro.
* Use `definable_fun_iff` but then intro only `Γ'` and `π`.
* For each existing definable variable `p`, we add a let binding
  `p' := p.precomp π`.
* Now intro the new variable `x` (`new_var`) as well, and build a new function
  `λ (i' : Γ'), body' (x.to_fun γ')`, by making the following replacements:
  - each old `p` becomes `p'`;
  - `i` becomes `i'`;
  - `Γ` becomes `Γ'`.
  The claim is that the new expression is well-typed and definitionally equal
  (in the context of the let-bound variables `p'`, ...) to the current goal.
  Moreover, it only mentions the new `Γ'` and `p'`.
* Now we cover our tracks:
  - clear the bodies of the let bindings `p'`, so that we can:
  - clear the old definable variables, `π`, and the old `Γ`.

The tactic reuses the same user-visible names for the new `Γ` and `γ`.
This is nice for interactive use, but not so nice for debugging the tactic.
In the latter case, add `name.append_after _ 1` when generating names.
-/
meta def defin_intro (var : parse ident_) : tactic unit :=
let trace : Π {α : Type} [has_to_tactic_format α] (a : α), tactic unit :=
  λ _ _ _, tactic.skip in       -- comment this for debugging
do `(o_minimal.definable_sheaf.definable %%f) ← target,
   ([i_var], body) ← open_n_lambdas f 1,
   -- `body` might not be a lambda yet, e.g., `function.curry`.
   -- Reduce it to whnf in hopes of making it a lambda.
   -- This won't do anything if it was a lambda already.
   -- It might not always succeed, e.g., in the case of `and`.
   body ← whnf body,
   ctx_var ← guess_ctx_ty,
   trace i_var,
   trace body,
   `[refine o_minimal.definable_sheaf.definable_fun_iff.mpr _],
   new_ctx_var ← tactic.intro ctx_var.local_pp_name,
   proj_var ← tactic.intro `π,
   defin_vars ← guess_defin_vars ctx_var,
   -- do something to them:
   -- * for each old variable `p`, create a new variable `p'`
   --   which is let-bound to `p.precomp π`
   defin_var_list ← defin_vars.mmap (λ dvar, do
     -- "let p' := p.precomp π,"
     new_body ← to_expr ``((%%dvar).precomp %%proj_var),
     new_dvar ← tactic.pose dvar.local_pp_name none new_body,
     return (sigma.mk dvar new_dvar)),
   new_i_type ← to_expr ``(↥%%new_ctx_var),
   new_i_var ← mk_local' i_var.local_pp_name f.binding_info new_i_type,
   -- * replace variables `p` → `p'` in `body`, and also the γ and Γ vars
   let var_map :=
     (defin_var_list.to_alist.insert i_var new_i_var).insert ctx_var new_ctx_var,
   let body' := body.replace (λ e _, do
     -- for "efficiency", first check whether we have a variable at all
     guard (e.is_local_constant),
     -- then, look up the whole expression in our map
     var_map.lookup e),
   -- do the actual intro
   new_var ← tactic.intro var,
   new_var' ← to_expr ``((%%new_var).to_fun %%new_i_var),
   new_f ← tactic.lambdas [new_i_var] (body'.subst new_var'),
   trace new_f,
   new_target ← to_expr ``(o_minimal.definable_sheaf.definable %%new_f),
   tactic.change new_target,
   -- for each defin var:
   -- * forget its let binding (so that we can do the `clear`s below)
   --   (using `clear_value` from mathlib's `tactic.core`)
   -- * clear the original variable
   tactic.clear_value (defin_var_list.map sigma.snd),
   defin_var_list.mmap (λ ⟨dvar, new_dvar⟩, do tactic.clear dvar),
   tactic.clear proj_var,
   tactic.clear ctx_var,
   return ()

/-- Goal should look like
 ⊢ definable_sheaf.definable (λ i, f x)
and we want to produce
 ⊢ definable_sheaf.definable (λ i, f)
 ⊢ definable_sheaf.definable (λ i, x)
This is just `apply definable_sheaf.definable_app`,
but Lean needs help with the unification problem.
-/
meta def defin_app : tactic unit :=
do `(o_minimal.definable_sheaf.definable %%e) ← target,
   ([i_var], body) ← open_n_lambdas e 1,
   (expr.app f x) ← pure body,
   f' ← tactic.lambdas [i_var] f,
   x' ← tactic.lambdas [i_var] x,
   `[refine o_minimal.definable_sheaf.definable_app %%f' %%x'],
   return ()

/-- Goal should look like
 ⊢ definable_sheaf.definable (λ i, p.to_fun i)
where p : Γ ⊢ α. Just apply `sect.definable`.
-/
meta def defin_var : tactic unit :=
`[refine o_minimal.definable_sheaf.sect.definable _]

end interactive

end tactic

meta def defin := tactic

meta instance : monad defin :=
show monad tactic, by apply_instance

meta instance : interactive.executor defin :=
{ config_type := unit,
  inhabited := by apply_instance,
  execute_with := λ _ tac, tactic.interactive.defin_start >> tac }

namespace defin

-- TODO:
-- * tactic display not quite done (need `compact`)

meta def step := @tactic.step
meta def istep := @tactic.istep
meta def solve1 : defin unit → defin unit := tactic.solve1

-- Tactic state display borrows liberally from
-- https://github.com/unitb/temporal-logic
-- file temporal_logic.tactic

/-- Replace any occurrences of `p.to_fun γ` with simply `p`.
This is rather crude, but these aren't expected to appear
outside the execution of a defin tactic. (More sophisticated
would be to process only those variables which are sections
over the context variable that appears in the goal.)
The resulting expression is intended to be used for display purposes. -/
meta def shorten (E : expr) : expr :=
E.replace $ λ e _, match e with
  | `(o_minimal.definable_sheaf.sect.to_fun %%p _) := some p
  | _ := none
end

section display

open tactic

meta structure hyp_data : Type :=
(crisp : bool)
(var : expr)
(ty : expr)
(val : option expr)

/-- Return information about a local hypothesis `l`. -/
meta def get_hyp_data (l : expr) : defin hyp_data :=
do ty ← infer_type l,
   val ← try_core (shorten <$> local_def_value l),
   match ty with
   | `(o_minimal.definable_sheaf.sect %%Γ %%ty') := return ⟨ff, l, shorten ty', val⟩
   | _ := return ⟨tt, l, shorten ty, val⟩
   end

meta def decl_to_fmt (s : tactic_state) (crisp : bool) (vs : list expr)
  (ty : expr) (val : option expr) : format :=
let vs' := format.join $ (vs.map s.format_expr).intersperse " ",
    t := s.format_expr ty,
    sep := if crisp then "::" else ":" in
match val with
| (some val) := format! "{vs'} {sep} {t} := {s.format_expr val}"
| none := format! "{vs'} {sep} {t}"
end

meta def goal_to_fmt (g : expr) : defin (thunk format) :=
do set_goals [g],
   s ← read,
   `(o_minimal.definable_sheaf.definable (λ (_ : ↥%%Γ), %%body)) ← target
     | pure (λ _, to_fmt s),
   lc ← local_context,
   ctx_var ← tactic.o_minimal.guess_ctx_ty,
   dat ← (lc.filter (λ l, l ≠ ctx_var)).mmap get_hyp_data,
   return $ λ _, format.intercalate format.line
     [format.intercalate ("," ++ format.line) $ dat.map $ λ d,
        decl_to_fmt s d.crisp [d.var] d.ty d.val,
      format! "⊢ {s.format_expr (shorten body)} def"]

meta def save_info (p : pos) : defin unit :=
do gs ← get_goals,
   fmt ← gs.mmap goal_to_fmt,
   set_goals gs,
   tactic.save_info_thunk p (λ _,
     let header := if fmt.length > 1 then format! "{fmt.length} goals\n" else "",
         eval : thunk format → format := λ f, f () in
     if fmt.empty
       then "no goals"
       else format.join ((fmt.map eval).intersperse (format.line ++ format.line)))

end display

namespace interactive

meta def swap := tactic.interactive.swap
meta def exact := tactic.interactive.exact
meta def solve1 : defin unit → defin unit := tactic.interactive.solve1

meta def intro := tactic.interactive.defin_intro
meta def app := tactic.interactive.defin_app
meta def var := tactic.interactive.defin_var

/-- Display the actual, underlying tactic state. -/
meta def trace_state : defin unit :=
do s ← tactic.read,
   tactic.trace s.to_format

end interactive

end defin

namespace o_minimal

variables {R : Type*} [S : struc R]
variables {X Y Z : Type*} [definable_sheaf S X] [definable_sheaf S Y] [definable_sheaf S Z]

example : definable S (@function.curry X Y Z) :=
begin [defin]
  intro f,
  intro x,
  intro y,
  app,
  { var },
  { exact ⟨x.definable, y.definable⟩ }
end

end o_minimal


import for_mathlib.category_theory.localization.derived_functor_shift
import for_mathlib.category_theory.triangulated.is_triangulated_subcategory

open category_theory category_theory.category category_theory.limits

noncomputable theory

namespace category_theory

namespace right_derivability_structure

variables {C₀ C H D : Type*} [category C₀] [category C] [category D] [category H]
  {W₀ : morphism_property C₀} {W : morphism_property C} {Φ : localizor_morphism W₀ W}
  [localizor_morphism.is_localization_equivalence Φ]
  [morphism_property.multiplicative W₀] [morphism_property.multiplicative W]
  (β : right_derivability_structure.basic Φ)
  (F : C ⥤ D) (L : C ⥤ H)
  (hF : W₀.is_inverted_by (Φ.functor ⋙ F))
  [has_shift C₀ ℤ] [has_shift C ℤ] [has_shift H ℤ] [has_shift D ℤ]
  [F.has_comm_shift ℤ] [L.has_comm_shift ℤ] [Φ.functor.has_comm_shift ℤ]
  [preadditive C₀] [preadditive C] [preadditive H] [preadditive D]
  [has_zero_object C₀] [has_zero_object C] [has_zero_object H] [has_zero_object D]
  [∀ (n : ℤ ), (shift_functor C₀ n).additive]
  [∀ (n : ℤ ), (shift_functor C n).additive]
  [∀ (n : ℤ ), (shift_functor H n).additive]
  [∀ (n : ℤ ), (shift_functor D n).additive]
  [L.is_localization W]
  [pretriangulated C₀] [pretriangulated C] [pretriangulated H] [pretriangulated D]
  [functor.is_triangulated F] [functor.is_triangulated Φ.functor]

namespace basic

include β

lemma Φ_functor_comp_L_ess_surj_on_dist_triang [L.ess_surj_on_dist_triang] [L.is_triangulated]:
  (Φ.functor ⋙ L).ess_surj_on_dist_triang :=
⟨λ T hT, begin
  obtain ⟨T', hT', ⟨e⟩⟩ := functor.ess_surj_on_dist_triang.condition L T hT,
  obtain ⟨X₁, X₂, f', fac⟩ := β.nonempty_arrow_right_resolution T'.mor₁,
  obtain ⟨X₃, g, h, mem⟩ := pretriangulated.distinguished_cocone_triangle _ _ f',
  haveI : is_iso (L.map X₁.hom.f) := localization.inverts L W _ X₁.hom.hf,
  haveI : is_iso (L.map X₂.hom.f) := localization.inverts L W _ X₂.hom.hf,
  refine ⟨_, mem, ⟨iso.symm _ ≪≫ e⟩⟩,
  refine pretriangulated.iso_triangle_of_distinguished_of_is_iso₁₂ _ _
    (L.map_distinguished _ hT') ((Φ.functor ⋙ L).map_distinguished _ mem)
      (as_iso (L.map X₁.hom.f)) (as_iso (L.map X₂.hom.f))
      (by { dsimp, simp only [← L.map_comp, fac]}),
end⟩

variable [functor.ess_surj_on_dist_triang (Φ.functor ⋙ L)]

include hF

lemma derived_functor_is_triangulated' [F.has_right_derived_functor W] :
  (F.right_derived_functor L W).is_triangulated :=
⟨λ T hT, begin
  obtain ⟨T', hT', ⟨e⟩⟩ := functor.ess_surj_on_dist_triang.condition (Φ.functor ⋙ L) T hT,
  have E' := (functor.map_triangle_comp (Φ.functor ⋙ L) (F.right_derived_functor L W)).symm.app T',
  let τ : Φ.functor ⋙ F ⟶ (Φ.functor ⋙ L) ⋙ F.right_derived_functor L W :=
    whisker_left Φ.functor (F.right_derived_functor_α L W) ≫ (functor.associator _ _ _).inv,
  haveI : ∀ (X₀ : C₀), is_iso (τ.app X₀) := λ X₀, begin
    dsimp [τ],
    rw [comp_id],
    apply β.is_iso_app L F hF,
  end,
  haveI := nat_iso.is_iso_of_is_iso_app τ,
  haveI : (as_iso τ).hom.respects_comm_shift ℤ := by { dsimp [as_iso], apply_instance, },
  exact pretriangulated.isomorphic_distinguished _ (functor.map_distinguished _ _ hT') _
    ((F.right_derived_functor L W).map_triangle.map_iso e.symm ≪≫
    (functor.map_triangle_comp (Φ.functor ⋙ L) (F.right_derived_functor L W)).symm.app T' ≪≫
    (functor.map_triangle_nat_iso (as_iso τ)).symm.app T'),
end⟩

lemma derived_functor_is_triangulated (RF : H ⥤ D) (α : F ⟶ L ⋙ RF)
  [RF.is_right_derived_functor α] [RF.has_comm_shift ℤ] [α.respects_comm_shift ℤ] :
  RF.is_triangulated :=
begin
  haveI := functor.is_right_derived_functor.has_right_derived_functor F RF L α W,
  haveI := β.derived_functor_is_triangulated' F L hF,
  let e := nat_iso.right_derived (iso.refl F) (F.right_derived_functor_α L W) α,
  haveI : e.hom.respects_comm_shift ℤ,
  { refine ⟨λ n, _⟩,
    apply functor.is_right_derived_functor_to_ext
      (shift_functor H n ⋙ F.right_derived_functor L W)
      (functor.has_comm_shift.right_derived_shift_α F L W n),
    ext X,
    simp only [nat_trans.comp_app, whisker_left_app, whisker_right_app],
    erw functor.has_comm_shift.right_derived_comm_shift_comm_assoc,
    simp only [nat_iso.right_derived_hom, iso.refl_hom,
      functor.has_comm_shift.right_derived_α_shift_app, ← functor.map_comp,
      nat_trans.right_derived_app (𝟙 F) (F.right_derived_functor_α L W) α X,
      nat_trans.id_app, id_comp,
      functor.has_comm_shift.right_derived_shift_α_app,
      assoc, nat_trans.naturality_assoc, nat_trans.right_derived_app_assoc,
      nat_trans.respects_comm_shift.comm_app α n X,
      functor.has_comm_shift.comp_hom_app], },
  exact functor.is_triangulated.of_iso e,
end

end basic

end right_derivability_structure

end category_theory


/-
Copyright (c) 2022 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.linear.linear_functor
import category_theory.monoidal.preadditive

/-!
# Linear monoidal categories

A monoidal category is `monoidal_linear R` if it is monoidal preadditive and
tensor product of morphisms is `R`-linear in both factors.
-/

namespace category_theory

open category_theory.limits
open category_theory.monoidal_category

variables (R : Type*) [semiring R]
variables (C : Type*) [category C] [preadditive C] [linear R C]
variables [monoidal_category C] [monoidal_preadditive C]

/--
A category is `monoidal_linear R` if tensoring is `R`-linear in both factors.
-/
class monoidal_linear : Prop :=
(tensor_smul' : ∀ {W X Y Z : C} (f : W ⟶ X) (r : R) (g : Y ⟶ Z),
  f ⊗ (r • g) = r • (f ⊗ g) . obviously)
(smul_tensor' : ∀ {W X Y Z : C} (r : R) (f : W ⟶ X) (g : Y ⟶ Z),
  (r • f) ⊗ g = r • (f ⊗ g) . obviously)

restate_axiom monoidal_linear.tensor_smul'
restate_axiom monoidal_linear.smul_tensor'
attribute [simp] monoidal_linear.tensor_smul monoidal_linear.smul_tensor

variables {C} [monoidal_linear R C]

instance tensor_left_linear (X : C) : (tensor_left X).linear R := {}
instance tensor_right_linear (X : C) : (tensor_right X).linear R := {}
instance tensoring_left_linear (X : C) : ((tensoring_left C).obj X).linear R := {}
instance tensoring_right_linear (X : C) : ((tensoring_right C).obj X).linear R := {}

/-- A faithful linear monoidal functor to a linear monoidal category
ensures that the domain is linear monoidal. -/
lemma monoidal_linear_of_faithful
  {D : Type*} [category D] [preadditive D] [linear R D]
  [monoidal_category D] [monoidal_preadditive D]
  (F : monoidal_functor D C) [faithful F.to_functor]
  [F.to_functor.additive] [F.to_functor.linear R] :
  monoidal_linear R D :=
{ tensor_smul' := begin
    intros,
    apply F.to_functor.map_injective,
    simp only [F.to_functor.map_smul r (f ⊗ g), F.to_functor.map_smul r g, F.map_tensor,
      monoidal_linear.tensor_smul, linear.smul_comp, linear.comp_smul],
  end,
  smul_tensor' := begin
    intros,
    apply F.to_functor.map_injective,
    simp only [F.to_functor.map_smul r (f ⊗ g), F.to_functor.map_smul r f, F.map_tensor,
      monoidal_linear.smul_tensor, linear.smul_comp, linear.comp_smul],
  end, }

end category_theory


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adam Topaz, Scott Morrison
-/
import category_theory.punit
import category_theory.comma
import category_theory.limits.shapes.terminal

/-!
# The category of "structured arrows"

For `T : C ⥤ D`, a `T`-structured arrow with source `S : D`
is just a morphism `S ⟶ T.obj Y`, for some `Y : C`.

These form a category with morphisms `g : Y ⟶ Y'` making the obvious diagram commute.

We prove that `𝟙 (T.obj Y)` is the initial object in `T`-structured objects with source `T.obj Y`.
-/

namespace category_theory

-- morphism levels before object levels. See note [category_theory universes].
universes v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄
variables {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₂} D]

/--
The category of `T`-structured arrows with domain `S : D` (here `T : C ⥤ D`),
has as its objects `D`-morphisms of the form `S ⟶ T Y`, for some `Y : C`,
and morphisms `C`-morphisms `Y ⟶ Y'` making the obvious triangle commute.
-/
@[derive category, nolint has_inhabited_instance]
def structured_arrow (S : D) (T : C ⥤ D) := comma (functor.from_punit S) T

namespace structured_arrow

/-- The obvious projection functor from structured arrows. -/
@[simps]
def proj (S : D) (T : C ⥤ D) : structured_arrow S T ⥤ C := comma.snd _ _

variables {S S' S'' : D} {Y Y' : C} {T : C ⥤ D}

/-- Construct a structured arrow from a morphism. -/
def mk (f : S ⟶ T.obj Y) : structured_arrow S T := ⟨⟨⟨⟩⟩, Y, f⟩

@[simp] lemma mk_left (f : S ⟶ T.obj Y) : (mk f).left = ⟨⟨⟩⟩ := rfl
@[simp] lemma mk_right (f : S ⟶ T.obj Y) : (mk f).right = Y := rfl
@[simp] lemma mk_hom_eq_self (f : S ⟶ T.obj Y) : (mk f).hom = f := rfl

@[simp, reassoc] lemma w {A B : structured_arrow S T} (f : A ⟶ B) : A.hom ≫ T.map f.right = B.hom :=
by { have := f.w; tidy }

lemma eq_mk (f : structured_arrow S T) : f = mk f.hom :=
by { cases f, congr, ext, }

/--
To construct a morphism of structured arrows,
we need a morphism of the objects underlying the target,
and to check that the triangle commutes.
-/
@[simps]
def hom_mk {f f' : structured_arrow S T} (g : f.right ⟶ f'.right) (w : f.hom ≫ T.map g = f'.hom) :
  f ⟶ f' :=
{ left := eq_to_hom (by ext),
  right := g,
  w' := by { dsimp, simpa using w.symm, }, }

/--
Given a structured arrow `X ⟶ F(U)`, and an arrow `U ⟶ Y`, we can construct a morphism of
structured arrow given by `(X ⟶ F(U)) ⟶ (X ⟶ F(U) ⟶ F(Y))`.
-/
def hom_mk' {F : C ⥤ D} {X : D} {Y : C}
(U : structured_arrow X F) (f : U.right ⟶ Y) :
U ⟶ mk (U.hom ≫ F.map f) := { right := f }

/--
To construct an isomorphism of structured arrows,
we need an isomorphism of the objects underlying the target,
and to check that the triangle commutes.
-/
@[simps]
def iso_mk {f f' : structured_arrow S T} (g : f.right ≅ f'.right)
  (w : f.hom ≫ T.map g.hom = f'.hom) : f ≅ f' :=
comma.iso_mk (eq_to_iso (by ext)) g (by simpa [eq_to_hom_map] using w.symm)

/--
A morphism between source objects `S ⟶ S'`
contravariantly induces a functor between structured arrows,
`structured_arrow S' T ⥤ structured_arrow S T`.

Ideally this would be described as a 2-functor from `D`
(promoted to a 2-category with equations as 2-morphisms)
to `Cat`.
-/
@[simps]
def map (f : S ⟶ S') : structured_arrow S' T ⥤ structured_arrow S T :=
comma.map_left _ ((functor.const _).map f)

@[simp]

@[simp] lemma map_id {f : structured_arrow S T} : (map (𝟙 S)).obj f = f :=
by { rw eq_mk f, simp, }

@[simp] lemma map_comp {f : S ⟶ S'} {f' : S' ⟶ S''} {h : structured_arrow S'' T} :
  (map (f ≫ f')).obj h = (map f).obj ((map f').obj h) :=
by { rw eq_mk h, simp, }

instance proj_reflects_iso : reflects_isomorphisms (proj S T) :=
{ reflects := λ Y Z f t, by exactI
  ⟨⟨structured_arrow.hom_mk (inv ((proj S T).map f)) (by simp), by tidy⟩⟩ }

open category_theory.limits

local attribute [tidy] tactic.discrete_cases

/-- The identity structured arrow is initial. -/
def mk_id_initial [full T] [faithful T] : is_initial (mk (𝟙 (T.obj Y))) :=
{ desc := λ c, hom_mk (T.preimage c.X.hom) (by { dsimp, simp, }),
  uniq' := λ c m _, begin
    ext,
    apply T.map_injective,
    simpa only [hom_mk_right, T.image_preimage, ←w m] using (category.id_comp _).symm,
  end }

variables {A : Type u₃} [category.{v₃} A] {B : Type u₄} [category.{v₄} B]

/-- The functor `(S, F ⋙ G) ⥤ (S, G)`. -/
@[simps]
def pre (S : D) (F : B ⥤ C) (G : C ⥤ D) : structured_arrow S (F ⋙ G) ⥤ structured_arrow S G :=
comma.pre_right _ F G

/-- The functor `(S, F) ⥤ (G(S), F ⋙ G)`. -/
@[simps] def post (S : C) (F : B ⥤ C) (G : C ⥤ D) :
  structured_arrow S F ⥤ structured_arrow (G.obj S) (F ⋙ G) :=
{ obj := λ X, { right := X.right, hom := G.map X.hom },
  map := λ X Y f, { right := f.right, w' :=
    by { simp [functor.comp_map, ←G.map_comp, ← f.w] } } }

end structured_arrow

/--
The category of `S`-costructured arrows with target `T : D` (here `S : C ⥤ D`),
has as its objects `D`-morphisms of the form `S Y ⟶ T`, for some `Y : C`,
and morphisms `C`-morphisms `Y ⟶ Y'` making the obvious triangle commute.
-/
@[derive category, nolint has_inhabited_instance]
def costructured_arrow (S : C ⥤ D) (T : D) := comma S (functor.from_punit T)

namespace costructured_arrow

/-- The obvious projection functor from costructured arrows. -/
@[simps]
def proj (S : C ⥤ D) (T : D) : costructured_arrow S T ⥤ C := comma.fst _ _

variables {T T' T'' : D} {Y Y' : C} {S : C ⥤ D}

/-- Construct a costructured arrow from a morphism. -/
def mk (f : S.obj Y ⟶ T) : costructured_arrow S T := ⟨Y, ⟨⟨⟩⟩, f⟩

@[simp] lemma mk_left (f : S.obj Y ⟶ T) : (mk f).left = Y := rfl
@[simp] lemma mk_right (f : S.obj Y ⟶ T) : (mk f).right = ⟨⟨⟩⟩ := rfl
@[simp] lemma mk_hom_eq_self (f : S.obj Y ⟶ T) : (mk f).hom = f := rfl

@[simp, reassoc] lemma w {A B : costructured_arrow S T} (f : A ⟶ B) :
  S.map f.left ≫ B.hom = A.hom :=
by tidy

lemma eq_mk (f : costructured_arrow S T) : f = mk f.hom :=
by { cases f, congr, ext, }

/--
To construct a morphism of costructured arrows,
we need a morphism of the objects underlying the source,
and to check that the triangle commutes.
-/
@[simps]
def hom_mk {f f' : costructured_arrow S T} (g : f.left ⟶ f'.left) (w : S.map g ≫ f'.hom = f.hom) :
  f ⟶ f' :=
{ left := g,
  right := eq_to_hom (by ext),
  w' := by simpa [eq_to_hom_map] using w, }

/--
To construct an isomorphism of costructured arrows,
we need an isomorphism of the objects underlying the source,
and to check that the triangle commutes.
-/
@[simps]
def iso_mk {f f' : costructured_arrow S T} (g : f.left ≅ f'.left)
  (w : S.map g.hom ≫ f'.hom = f.hom) : f ≅ f' :=
comma.iso_mk g (eq_to_iso (by ext)) (by simpa [eq_to_hom_map] using w)

/--
A morphism between target objects `T ⟶ T'`
covariantly induces a functor between costructured arrows,
`costructured_arrow S T ⥤ costructured_arrow S T'`.

Ideally this would be described as a 2-functor from `D`
(promoted to a 2-category with equations as 2-morphisms)
to `Cat`.
-/
@[simps]
def map (f : T ⟶ T') : costructured_arrow S T ⥤ costructured_arrow S T' :=
comma.map_right _ ((functor.const _).map f)

@[simp] lemma map_mk {f : S.obj Y ⟶ T} (g : T ⟶ T') :
  (map g).obj (mk f) = mk (f ≫ g) := rfl

@[simp] lemma map_id {f : costructured_arrow S T} : (map (𝟙 T)).obj f = f :=
by { rw eq_mk f, simp, }

@[simp] lemma map_comp {f : T ⟶ T'} {f' : T' ⟶ T''} {h : costructured_arrow S T} :
  (map (f ≫ f')).obj h = (map f').obj ((map f).obj h) :=
by { rw eq_mk h, simp, }

instance proj_reflects_iso : reflects_isomorphisms (proj S T) :=
{ reflects := λ Y Z f t, by exactI
  ⟨⟨costructured_arrow.hom_mk (inv ((proj S T).map f)) (by simp), by tidy⟩⟩ }

open category_theory.limits

local attribute [tidy] tactic.discrete_cases

/-- The identity costructured arrow is terminal. -/
def mk_id_terminal [full S] [faithful S] : is_terminal (mk (𝟙 (S.obj Y))) :=
{ lift := λ c, hom_mk (S.preimage c.X.hom) (by { dsimp, simp, }),
  uniq' := begin
    rintros c m -,
    ext,
    apply S.map_injective,
    simpa only [hom_mk_left, S.image_preimage, ←w m] using (category.comp_id _).symm,
  end }

variables {A : Type u₃} [category.{v₃} A] {B : Type u₄} [category.{v₄} B]

/-- The functor `(F ⋙ G, S) ⥤ (G, S)`. -/
@[simps]
def pre (F : B ⥤ C) (G : C ⥤ D) (S : D) : costructured_arrow (F ⋙ G) S ⥤ costructured_arrow G S :=
comma.pre_left F G _

/-- The functor `(F, S) ⥤ (F ⋙ G, G(S))`. -/
@[simps] def post (F : B ⥤ C) (G : C ⥤ D) (S : C) :
  costructured_arrow F S ⥤ costructured_arrow (F ⋙ G) (G.obj S) :=
{ obj := λ X, { left := X.left, hom := G.map X.hom },
  map := λ X Y f, { left := f.left, w' :=
    by { simp [functor.comp_map, ←G.map_comp, ← f.w] } } }

end costructured_arrow

open opposite

namespace structured_arrow

/--
For a functor `F : C ⥤ D` and an object `d : D`, we obtain a contravariant functor from the
category of structured arrows `d ⟶ F.obj c` to the category of costructured arrows
`F.op.obj c ⟶ (op d)`.
-/
@[simps]
def to_costructured_arrow (F : C ⥤ D) (d : D) :
  (structured_arrow d F)ᵒᵖ ⥤ costructured_arrow F.op (op d) :=
{ obj := λ X, @costructured_arrow.mk _ _ _ _ _ (op X.unop.right) F.op X.unop.hom.op,
  map := λ X Y f, costructured_arrow.hom_mk (f.unop.right.op)
  begin
    dsimp,
    rw [← op_comp, ← f.unop.w, functor.const.obj_map],
    erw category.id_comp,
  end }

/--
For a functor `F : C ⥤ D` and an object `d : D`, we obtain a contravariant functor from the
category of structured arrows `op d ⟶ F.op.obj c` to the category of costructured arrows
`F.obj c ⟶ d`.
-/
@[simps]
def to_costructured_arrow' (F : C ⥤ D) (d : D) :
  (structured_arrow (op d) F.op)ᵒᵖ ⥤ costructured_arrow F d :=
{ obj := λ X, @costructured_arrow.mk _ _ _ _ _ (unop X.unop.right) F X.unop.hom.unop,
  map := λ X Y f, costructured_arrow.hom_mk f.unop.right.unop
  begin
    dsimp,
    rw [← quiver.hom.unop_op (F.map (quiver.hom.unop f.unop.right)), ← unop_comp, ← F.op_map,
      ← f.unop.w, functor.const.obj_map],
    erw category.id_comp,
  end }

end structured_arrow

namespace costructured_arrow

/--
For a functor `F : C ⥤ D` and an object `d : D`, we obtain a contravariant functor from the
category of costructured arrows `F.obj c ⟶ d` to the category of structured arrows
`op d ⟶ F.op.obj c`.
-/
@[simps]
def to_structured_arrow (F : C ⥤ D) (d : D) :
  (costructured_arrow F d)ᵒᵖ ⥤ structured_arrow (op d) F.op :=
{ obj := λ X, @structured_arrow.mk _ _ _ _ _ (op X.unop.left) F.op X.unop.hom.op,
  map := λ X Y f, structured_arrow.hom_mk f.unop.left.op
  begin
    dsimp,
    rw [← op_comp, f.unop.w, functor.const.obj_map],
    erw category.comp_id,
  end }

/--
For a functor `F : C ⥤ D` and an object `d : D`, we obtain a contravariant functor from the
category of costructured arrows `F.op.obj c ⟶ op d` to the category of structured arrows
`d ⟶ F.obj c`.
-/
@[simps]
def to_structured_arrow' (F : C ⥤ D) (d : D) :
  (costructured_arrow F.op (op d))ᵒᵖ ⥤ structured_arrow d F :=
{ obj := λ X, @structured_arrow.mk _ _ _ _ _ (unop X.unop.left) F X.unop.hom.unop,
  map := λ X Y f, structured_arrow.hom_mk (f.unop.left.unop)
  begin
    dsimp,
    rw [← quiver.hom.unop_op (F.map f.unop.left.unop), ← unop_comp, ← F.op_map,
      f.unop.w, functor.const.obj_map],
    erw category.comp_id,
  end }

end costructured_arrow

/--
For a functor `F : C ⥤ D` and an object `d : D`, the category of structured arrows `d ⟶ F.obj c`
is contravariantly equivalent to the category of costructured arrows `F.op.obj c ⟶ op d`.
-/
def structured_arrow_op_equivalence (F : C ⥤ D) (d : D) :
  (structured_arrow d F)ᵒᵖ ≌ costructured_arrow F.op (op d) :=
equivalence.mk (structured_arrow.to_costructured_arrow F d)
  (costructured_arrow.to_structured_arrow' F d).right_op
  (nat_iso.of_components (λ X, (@structured_arrow.iso_mk _ _ _ _ _ _
    (structured_arrow.mk (unop X).hom) (unop X) (iso.refl _) (by tidy)).op)
    (λ X Y f, quiver.hom.unop_inj $ begin ext, dsimp, simp end))
  (nat_iso.of_components (λ X, @costructured_arrow.iso_mk _ _ _ _ _ _
    (costructured_arrow.mk X.hom) X (iso.refl _) (by tidy))
    (λ X Y f, begin ext, dsimp, simp end))

/--
For a functor `F : C ⥤ D` and an object `d : D`, the category of costructured arrows
`F.obj c ⟶ d` is contravariantly equivalent to the category of structured arrows
`op d ⟶ F.op.obj c`.
-/
def costructured_arrow_op_equivalence (F : C ⥤ D) (d : D) :
  (costructured_arrow F d)ᵒᵖ ≌ structured_arrow (op d) F.op :=
equivalence.mk (costructured_arrow.to_structured_arrow F d)
  (structured_arrow.to_costructured_arrow' F d).right_op
  (nat_iso.of_components (λ X, (@costructured_arrow.iso_mk _ _ _ _ _ _
    (costructured_arrow.mk (unop X).hom) (unop X) (iso.refl _) (by tidy)).op)
    (λ X Y f, quiver.hom.unop_inj $ begin ext, dsimp, simp end))
  (nat_iso.of_components (λ X, @structured_arrow.iso_mk _ _ _ _ _ _
    (structured_arrow.mk X.hom) X (iso.refl _) (by tidy))
    (λ X Y f, begin ext, dsimp, simp end))

end category_theory


macro "ext_tactic" t:tactic "=>" newT:tactic : command => `(macro_rules | `(tactic| $t) => `(tactic| $newT))

syntax "trivial'" : tactic

ext_tactic trivial' => apply Eq.refl

theorem tst1 (x : Nat) : x = x :=
by trivial'

-- theorem tst2 (x y : Nat) (h : x = y) : x = y :=
-- by trivial' -- fail as expected

ext_tactic trivial' => assumption

theorem tst1b (x : Nat) : x = x :=
by trivial' -- still works

theorem tst2 (x y : Nat) (h : x = y) : x = y :=
by trivial' -- works too


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.field_theory.finite.basic
import Mathlib.field_theory.mv_polynomial
import Mathlib.data.mv_polynomial.expand
import Mathlib.linear_algebra.basic
import Mathlib.PostPort

universes u_1 u_2 u

namespace Mathlib

/-!
## Polynomials over finite fields
-/

namespace mv_polynomial

/-- A polynomial over the integers is divisible by `n : ℕ`
if and only if it is zero over `zmod n`. -/
theorem C_dvd_iff_zmod {σ : Type u_1} (n : ℕ) (φ : mv_polynomial σ ℤ) :
    coe_fn C ↑n ∣ φ ↔ coe_fn (map (int.cast_ring_hom (zmod n))) φ = 0 :=
  C_dvd_iff_map_hom_eq_zero (int.cast_ring_hom (zmod n)) (↑n)
    (char_p.int_cast_eq_zero_iff (zmod n) n) φ

theorem frobenius_zmod {σ : Type u_1} {p : ℕ} [fact (nat.prime p)] (f : mv_polynomial σ (zmod p)) :
    coe_fn (frobenius (mv_polynomial σ (zmod p)) p) f = coe_fn (expand p) f :=
  sorry

theorem expand_zmod {σ : Type u_1} {p : ℕ} [fact (nat.prime p)] (f : mv_polynomial σ (zmod p)) :
    coe_fn (expand p) f = f ^ p :=
  Eq.symm (frobenius_zmod f)

end mv_polynomial

namespace mv_polynomial

def indicator {K : Type u_1} {σ : Type u_2} [field K] [fintype K] [fintype σ] (a : σ → K) :
    mv_polynomial σ K :=
  finset.prod finset.univ fun (n : σ) => 1 - (X n - coe_fn C (a n)) ^ (fintype.card K - 1)

theorem eval_indicator_apply_eq_one {K : Type u_1} {σ : Type u_2} [field K] [fintype K] [fintype σ]
    (a : σ → K) : coe_fn (eval a) (indicator a) = 1 :=
  sorry

theorem eval_indicator_apply_eq_zero {K : Type u_1} {σ : Type u_2} [field K] [fintype K] [fintype σ]
    (a : σ → K) (b : σ → K) (h : a ≠ b) : coe_fn (eval a) (indicator b) = 0 :=
  sorry

theorem degrees_indicator {K : Type u_1} {σ : Type u_2} [field K] [fintype K] [fintype σ]
    (c : σ → K) :
    degrees (indicator c) ≤
        finset.sum finset.univ fun (s : σ) => (fintype.card K - 1) •ℕ singleton s :=
  sorry

theorem indicator_mem_restrict_degree {K : Type u_1} {σ : Type u_2} [field K] [fintype K]
    [fintype σ] (c : σ → K) : indicator c ∈ restrict_degree σ K (fintype.card K - 1) :=
  sorry

def evalₗ (K : Type u_1) (σ : Type u_2) [field K] [fintype K] [fintype σ] :
    linear_map K (mv_polynomial σ K) ((σ → K) → K) :=
  linear_map.mk (fun (p : mv_polynomial σ K) (e : σ → K) => coe_fn (eval e) p) sorry sorry

theorem evalₗ_apply {K : Type u_1} {σ : Type u_2} [field K] [fintype K] [fintype σ]
    (p : mv_polynomial σ K) (e : σ → K) : coe_fn (evalₗ K σ) p e = coe_fn (eval e) p :=
  rfl

theorem map_restrict_dom_evalₗ {K : Type u_1} {σ : Type u_2} [field K] [fintype K] [fintype σ] :
    submodule.map (evalₗ K σ) (restrict_degree σ K (fintype.card K - 1)) = ⊤ :=
  sorry

end mv_polynomial

namespace mv_polynomial

def R (σ : Type u) (K : Type u) [fintype σ] [field K] [fintype K] :=
  ↥(restrict_degree σ K (fintype.card K - 1))

protected instance decidable_restrict_degree (σ : Type u) [fintype σ] (m : ℕ) :
    decidable_pred fun (n : σ →₀ ℕ) => n ∈ set_of fun (n : σ →₀ ℕ) => ∀ (i : σ), coe_fn n i ≤ m :=
  eq.mpr sorry fun (a : σ →₀ ℕ) => fintype.decidable_forall_fintype

theorem dim_R (σ : Type u) (K : Type u) [fintype σ] [field K] [fintype K] :
    vector_space.dim K (R σ K) = ↑(fintype.card (σ → K)) :=
  sorry

def evalᵢ (σ : Type u) (K : Type u) [fintype σ] [field K] [fintype K] :
    linear_map K (R σ K) ((σ → K) → K) :=
  linear_map.comp (evalₗ K σ) (submodule.subtype (restrict_degree σ K (fintype.card K - 1)))

theorem range_evalᵢ (σ : Type u) (K : Type u) [fintype σ] [field K] [fintype K] :
    linear_map.range (evalᵢ σ K) = ⊤ :=
  sorry

theorem ker_evalₗ (σ : Type u) (K : Type u) [fintype σ] [field K] [fintype K] :
    linear_map.ker (evalᵢ σ K) = ⊥ :=
  sorry

theorem eq_zero_of_eval_eq_zero (σ : Type u) (K : Type u) [fintype σ] [field K] [fintype K]
    (p : mv_polynomial σ K) (h : ∀ (v : σ → K), coe_fn (eval v) p = 0)
    (hp : p ∈ restrict_degree σ K (fintype.card K - 1)) : p = 0 :=
  sorry

end Mathlib


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

! This file was ported from Lean 3 source module algebra.order.field.pi
! leanprover-community/mathlib commit 327c3c0d9232d80e250dc8f65e7835b82b266ea5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Order.Field.Basic
import Mathbin.Data.Fintype.Lattice

/-!
# Lemmas about (finite domain) functions into fields.

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

We split this from `algebra.order.field.basic` to avoid importing the finiteness hierarchy there.
-/

variable {α ι : Type _} [LinearOrderedSemifield α]

/- warning: pi.exists_forall_pos_add_lt -> Pi.exists_forall_pos_add_lt is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {ι : Type.{u2}} [_inst_1 : LinearOrderedSemifield.{u1} α] [_inst_2 : ExistsAddOfLE.{u1} α (Distrib.toHasAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1)))))))) (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedCancelAddCommMonoid.toPartialOrder.{u1} α (StrictOrderedSemiring.toOrderedCancelAddCommMonoid.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1)))))))] [_inst_3 : Finite.{succ u2} ι] {x : ι -> α} {y : ι -> α}, (forall (i : ι), LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedCancelAddCommMonoid.toPartialOrder.{u1} α (StrictOrderedSemiring.toOrderedCancelAddCommMonoid.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))) (x i) (y i)) -> (Exists.{succ u1} α (fun (ε : α) => And (LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedCancelAddCommMonoid.toPartialOrder.{u1} α (StrictOrderedSemiring.toOrderedCancelAddCommMonoid.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))) ε) (forall (i : ι), LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedCancelAddCommMonoid.toPartialOrder.{u1} α (StrictOrderedSemiring.toOrderedCancelAddCommMonoid.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))) (HAdd.hAdd.{u1, u1, u1} α α α (instHAdd.{u1} α (Distrib.toHasAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))) (x i) ε) (y i))))
but is expected to have type
  forall {α : Type.{u2}} {ι : Type.{u1}} [_inst_1 : LinearOrderedSemifield.{u2} α] [_inst_2 : ExistsAddOfLE.{u2} α (Distrib.toAdd.{u2} α (NonUnitalNonAssocSemiring.toDistrib.{u2} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} α (Semiring.toNonAssocSemiring.{u2} α (StrictOrderedSemiring.toSemiring.{u2} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u2} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u2} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u2} α _inst_1)))))))) (Preorder.toLE.{u2} α (PartialOrder.toPreorder.{u2} α (StrictOrderedSemiring.toPartialOrder.{u2} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u2} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u2} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u2} α _inst_1))))))] [_inst_3 : Finite.{succ u1} ι] {x : ι -> α} {y : ι -> α}, (forall (i : ι), LT.lt.{u2} α (Preorder.toLT.{u2} α (PartialOrder.toPreorder.{u2} α (StrictOrderedSemiring.toPartialOrder.{u2} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u2} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u2} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u2} α _inst_1)))))) (x i) (y i)) -> (Exists.{succ u2} α (fun (ε : α) => And (LT.lt.{u2} α (Preorder.toLT.{u2} α (PartialOrder.toPreorder.{u2} α (StrictOrderedSemiring.toPartialOrder.{u2} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u2} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u2} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u2} α _inst_1)))))) (OfNat.ofNat.{u2} α 0 (Zero.toOfNat0.{u2} α (CommMonoidWithZero.toZero.{u2} α (CommGroupWithZero.toCommMonoidWithZero.{u2} α (Semifield.toCommGroupWithZero.{u2} α (LinearOrderedSemifield.toSemifield.{u2} α _inst_1)))))) ε) (forall (i : ι), LT.lt.{u2} α (Preorder.toLT.{u2} α (PartialOrder.toPreorder.{u2} α (StrictOrderedSemiring.toPartialOrder.{u2} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u2} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u2} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u2} α _inst_1)))))) (HAdd.hAdd.{u2, u2, u2} α α α (instHAdd.{u2} α (Distrib.toAdd.{u2} α (NonUnitalNonAssocSemiring.toDistrib.{u2} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} α (Semiring.toNonAssocSemiring.{u2} α (StrictOrderedSemiring.toSemiring.{u2} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u2} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u2} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u2} α _inst_1))))))))) (x i) ε) (y i))))
Case conversion may be inaccurate. Consider using '#align pi.exists_forall_pos_add_lt Pi.exists_forall_pos_add_ltₓ'. -/
theorem Pi.exists_forall_pos_add_lt [ExistsAddOfLE α] [Finite ι] {x y : ι → α}
    (h : ∀ i, x i < y i) : ∃ ε, 0 < ε ∧ ∀ i, x i + ε < y i :=
  by
  cases nonempty_fintype ι
  cases isEmpty_or_nonempty ι
  · exact ⟨1, zero_lt_one, isEmptyElim⟩
  choose ε hε hxε using fun i => exists_pos_add_of_lt' (h i)
  obtain rfl : x + ε = y := funext hxε
  have hε : 0 < finset.univ.inf' Finset.univ_nonempty ε := (Finset.lt_inf'_iff _).2 fun i _ => hε _
  exact
    ⟨_, half_pos hε, fun i =>
      add_lt_add_left ((half_lt_self hε).trans_le <| Finset.inf'_le _ <| Finset.mem_univ _) _⟩
#align pi.exists_forall_pos_add_lt Pi.exists_forall_pos_add_lt


/- Author: E.W.Ayers
   Show that the open covers for a topological space form a basis for a grothendieck topology.
 -/
import topology.category.Top.opens
import category_theory.limits.lattice
import category_theory.limits.limits
import category_theory.limits.shapes.pullbacks
import .grothendieck

universes u
open category_theory
open topological_space
open category_theory.limits

namespace topological_space.opens

/- [TODO] this is probably in mathlib somewhere. -/
/-- `covers X U ℱ` means that ℱ is an open cover of U. -/
def covers (X : Top) : arrow_set (opens X) :=
λ U ℱ, ∀ (x : X) (xU : x ∈ U), ∃ (V : over U), V ∈ ℱ ∧ x ∈ V.left

variables {X : Top}

instance opens_has_limits : @has_limits (opens X) (opens.opens_category) :=
limits.has_limits_of_complete_lattice

instance opens_has_pullbacks : @has_pullbacks (opens X) (opens.opens_category) :=
⟨@has_limits.has_limits_of_shape _ _ opens.opens_has_limits _ _⟩

instance opens_has_cospan_limits {U V W : opens X} {f : U ⟶ W} {g : V ⟶ W} : has_limit (cospan f g) :=
@has_limits_of_shape.has_limit _ _ _ _ (@has_limits.has_limits_of_shape _ _ opens.opens_has_limits _ _) _

variables {U V W : opens X}

/- [todo] this can be moved to category_theory/limits/lattice -/
lemma eq_of_iso (e : U ≅ W) : U = W :=
begin
    rcases e with ⟨⟨⟨_⟩⟩,⟨⟨_⟩⟩,_,_⟩,
    apply partial_order.le_antisymm,
    assumption,
    assumption
end

lemma over_eq_of_left_eq : Π {f g : over U}, f.left = g.left → f = g
| ⟨_,⟨⟩,⟨⟨_⟩⟩⟩ ⟨_,⟨⟩,⟨⟨_⟩⟩⟩ rfl := rfl

open lattice
/- [todo] this can be moved to category_theory/limits/lattice -/
lemma pullback_is_inter {f : U ⟶ W} {g : V ⟶ W} : pullback f g = U ⊓ V :=
begin
    apply eq_of_iso,
    rcases (pullback.fst : pullback f g ⟶ U) with ⟨⟨π1⟩⟩,
    rcases (pullback.snd : pullback f g ⟶ V) with ⟨⟨π2⟩⟩,
    refine ⟨⟨⟨le_inf π1 π2⟩⟩,pullback.lift ⟨⟨inf_le_left⟩⟩ ⟨⟨inf_le_right⟩⟩ rfl,rfl,rfl⟩,
end

instance : grothendieck.basis (covers X) :=
{ has_isos :=
    begin
        -- all isos in opens U are equality.
        intros U V e x xU,
        refine ⟨over.mk e.hom, _,_⟩,
        simp,
        have : U = V, apply eq_of_iso e,
        simpa [this],
    end,
  has_pullbacks :=
    begin
        -- idea: ℱ is covering for U
        -- ⇒ {V ∩ W | W ∈ ℱ} is a covering for V
        intros U V ℱ h₁ g,
        intros x xV,
        rcases g with ⟨⟨g⟩⟩,
        rcases h₁ x (g xV) with ⟨f,fF,xf⟩,
        refine ⟨over.mk ⟨⟨inf_le_right⟩⟩,⟨f,fF,_⟩,⟨xf,xV⟩⟩,
        apply over_eq_of_left_eq,
            simp [over.pullback],
            rw pullback_is_inter,
            rw inf_comm, refl,
    end,
  trans :=
    begin
        -- idea: ℱ covers U and 𝒢 U covers V for each V ∈ ℱ
        -- ⇒ ⋃ 𝒢 covers U
        intros U,
        rintros _ FcU _ GcF x xU,
        rcases FcU x xU with ⟨V,VF,xV⟩,
        rcases GcF VF x xV with ⟨W,WG,xW⟩,
        refine ⟨over.mk (W.hom ≫ V.hom),⟨_,VF,⟨W,WG,rfl⟩⟩,xW⟩,
    end
}

def covering_sieve (X : Top):= sieve_set.generate (covers X)

instance : grothendieck (covering_sieve X) :=
grothendieck.of_basis

end topological_space.opens


/-
Copyright (c) 2022 Ian Wood. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ian Wood

! This file was ported from Lean 3 source module tactic.expand_exists
! leanprover-community/mathlib commit f9153b8a79eb28d07341706ddb18c02593eeb72a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Meta.Expr

/-!
# `expand_exists`

`expand_exists` is an attribute which takes a proof that something exists with some property, and
outputs a value using `classical.some`, and a proof that it has that property using
`classical.some_spec`. For example:

```lean
@[expand_exists it it_spec]
lemma it_exists (n : ℕ) : ∃ m : ℕ, n < m := sorry
```

produces

```
def it (n : ℕ) : ℕ := classical.some (it_exists n)

lemma it_spec (n : ℕ) : n < it n := classical.some_spec (it_exists n)
```
-/

namespace Tactic

open Expr

namespace ExpandExists

/-- Data known when parsing pi expressions.

`decl`'s arguments are: is_theorem, name, type, value.
-/
unsafe structure parse_ctx where
  original_decl : declaration
  decl : Bool → Name → expr → pexpr → tactic Unit
  names : List Name
  pis_depth : ℕ := 0
#align tactic.expand_exists.parse_ctx tactic.expand_exists.parse_ctx

/-- Data known when parsing exists expressions (after parsing pi expressions).

* `with_args` applies pi arguments to a term (eg `id` -> `id #2 #1 #0`).
* `spec_chain` takes the form of `classical.some_spec^n (it_exists ...)`,
with `n` the depth of `∃` parsed.
* `exists_decls` is a list of declarations containing the value(s) of witnesses.
-/
unsafe structure parse_ctx_exists extends parse_ctx where
  with_args : expr → expr
  spec_chain : pexpr
  exists_decls : List Name := []
#align tactic.expand_exists.parse_ctx_exists tactic.expand_exists.parse_ctx_exists

/-- Data known when parsing the proposition (after parsing exists and pi expressions).

`project_proof` projects a proof of the full proposition (eg `A ∧ B ∧ C`) to a specific proof (eg
`B`).
-/
unsafe structure parse_ctx_props extends parse_ctx_exists where
  project_proof : pexpr → pexpr := id
#align tactic.expand_exists.parse_ctx_props tactic.expand_exists.parse_ctx_props

/-- Replaces free variables with their exists declaration. For example, if:

```lean
def n_value : ℕ := ... -- generated by `expand_exists`
```

then this function converts `#0` in `#0 = #0` from `∃ n : ℕ, n = n` to `n_value = n_value`.
-/
unsafe def instantiate_exists_decls (ctx : parse_ctx_exists) (p : expr) : expr :=
  p.instantiate_vars <|
    ctx.exists_decls.reverse.map fun name =>
      ctx.with_args (const Name ctx.original_decl.univ_levels)
#align tactic.expand_exists.instantiate_exists_decls tactic.expand_exists.instantiate_exists_decls

/-- Parses a proposition and creates the associated specification proof. Does not break down the
proposition further.
-/
unsafe def parse_one_prop (ctx : parse_ctx_props) (p : expr) : tactic Unit := do
  let p : expr := instantiate_exists_decls { ctx with } p
  let val : pexpr := ctx.project_proof ctx.spec_chain
  let n ←
    match ctx.names with
      | [n] => return n
      | [] => fail "missing name for proposition"
      | _ => fail "too many names for propositions (are you missing an and?)"
  ctx True n p val
#align tactic.expand_exists.parse_one_prop tactic.expand_exists.parse_one_prop

/--
Parses a proposition and decides if it should be broken down (eg `P ∧ Q` -> `P` and `Q`) depending
on how many `names` are left. Then creates the associated specification proof(s).
-/
unsafe def parse_props : parse_ctx_props → expr → tactic Unit
  | ctx, app (app (const "and" []) p) q => do
    match ctx with
      | [n] => parse_one_prop ctx (app (app (const `and []) p) q)
      | n :: tail =>
        parse_one_prop
            { ctx with
              names := [n]
              project_proof := (fun p => (const `and.left []) p) ∘ ctx }
            p >>
          parse_props
            { ctx with
              names := tail
              project_proof := (fun p => (const `and.right []) p) ∘ ctx }
            q
      | [] => fail "missing name for proposition"
  | ctx, p => parse_one_prop ctx p
#align tactic.expand_exists.parse_props tactic.expand_exists.parse_props

/--
Parses an `∃ a : α, p a`, and creates an associated definition with a value of `α`. When `p α` is
not an exists statement, it will call `parse_props`.
-/
unsafe def parse_exists : parse_ctx_exists → expr → tactic Unit
  | ctx, app (app (const "Exists" [lvl]) type) (lam var_name bi var_type body) => do
    -- TODO: Is this needed, and/or does this create issues?
        if type = var_type then tactic.skip
      else tactic.fail "exists types should be equal"
    let ⟨n, names⟩ ←
      match ctx.names with
        | n :: tail => return (n, tail)
        | [] => fail "missing name for exists"
    let-- Type may be dependant on earlier arguments.
    type := instantiate_exists_decls ctx type
    let value : pexpr := (const `classical.some [lvl]) ctx.spec_chain
    ctx False n type value
    let exists_decls := ctx.exists_decls.concat n
    let some_spec : pexpr := (const `classical.some_spec [lvl]) ctx.spec_chain
    let ctx : parse_ctx_exists :=
      { ctx with
        names
        spec_chain := some_spec
        exists_decls }
    parse_exists ctx body
  | ctx, e => parse_props { ctx with } e
#align tactic.expand_exists.parse_exists tactic.expand_exists.parse_exists

/-- Parses a `∀ (a : α), p a`. If `p` is not a pi expression, it will call `parse_exists`
-/
unsafe def parse_pis : parse_ctx → expr → tactic Unit
  | ctx,
    pi n bi ty body =>-- When making a declaration, wrap in an equivalent pi expression.
    let decl is_theorem name type val :=
      ctx.decl is_theorem Name (pi n bi ty type) (lam n bi (to_pexpr ty) val)
    parse_pis
      { ctx with
        decl
        pis_depth := ctx.pis_depth + 1 }
      body
  | ctx, app (app (const "Exists" [lvl]) type) p =>
    let with_args := fun e : expr =>
      (List.range ctx.pis_depth).foldr (fun n (e : expr) => e (var n)) e
    parse_exists
      { ctx with
        with_args
        spec_chain :=
          to_pexpr (with_args <| const ctx.original_decl.to_name ctx.original_decl.univ_levels) }
      (app (app (const "Exists" [lvl]) type) p)
  | ctx, e => fail ("unexpected expression " ++ toString e)
#align tactic.expand_exists.parse_pis tactic.expand_exists.parse_pis

end ExpandExists

/-- From a proof that (a) value(s) exist(s) with certain properties, constructs (an) instance(s)
satisfying those properties. For instance:

```lean
@[expand_exists nat_greater nat_greater_spec]
lemma nat_greater_exists (n : ℕ) : ∃ m : ℕ, n < m := ...

#check nat_greater      -- nat_greater : ℕ → ℕ
#check nat_greater_spec -- nat_greater_spec : ∀ (n : ℕ), n < nat_greater n
```

It supports multiple witnesses:

```lean
@[expand_exists nat_greater_m nat_greater_l nat_greater_spec]
lemma nat_greater_exists (n : ℕ) : ∃ (m l : ℕ), n < m ∧ m < l := ...

#check nat_greater_m      -- nat_greater : ℕ → ℕ
#check nat_greater_l      -- nat_greater : ℕ → ℕ
#check nat_greater_spec-- nat_greater_spec : ∀ (n : ℕ),
  n < nat_greater_m n ∧ nat_greater_m n < nat_greater_l n
```

It also supports logical conjunctions:
```lean
@[expand_exists nat_greater nat_greater_lt nat_greater_nonzero]
lemma nat_greater_exists (n : ℕ) : ∃ m : ℕ, n < m ∧ m ≠ 0 := ...

#check nat_greater         -- nat_greater : ℕ → ℕ
#check nat_greater_lt      -- nat_greater_lt : ∀ (n : ℕ), n < nat_greater n
#check nat_greater_nonzero -- nat_greater_nonzero : ∀ (n : ℕ), nat_greater n ≠ 0
```
Note that without the last argument `nat_greater_nonzero`, `nat_greater_lt` would be:
```lean
#check nat_greater_lt -- nat_greater_lt : ∀ (n : ℕ), n < nat_greater n ∧ nat_greater n ≠ 0
```
-/
@[user_attribute]
unsafe def expand_exists_attr : user_attribute Unit (List Name)
    where
  Name := "expand_exists"
  descr :=
    "From a proof that (a) value(s) exist(s) with certain properties, " ++
      "constructs (an) instance(s) satisfying those properties."
  parser := lean.parser.many lean.parser.ident
  after_set :=
    some fun decl prio persistent => do
      let d ← get_decl decl
      let names ← expand_exists_attr.get_param decl
      expand_exists.parse_pis
          { original_decl := d
            decl := fun is_t n ty val =>
              tactic.to_expr val >>= fun val =>
                tactic.add_decl
                  (if is_t then declaration.thm n d ty (pure val)
                  else declaration.defn n d ty val default tt)
            names } d
#align tactic.expand_exists_attr tactic.expand_exists_attr

add_tactic_doc
  { Name := "expand_exists"
    category := DocCategory.attr
    declNames := [`tactic.expand_exists_attr]
    tags := ["lemma derivation", "environment"] }

end Tactic


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

/-!
# Preserving (co)kernels

Constructions to relate the notions of preserving (co)kernels and reflecting (co)kernels
to concrete (co)forks.

In particular, we show that `kernel_comparison f g G` is an isomorphism iff `G` preserves
the limit of the parallel pair `f,0`, as well as the dual result.
-/

noncomputable theory

universes v u₁ u₂

open category_theory category_theory.category category_theory.limits

variables {C : Type u₁} [category.{v} C] [has_zero_morphisms C]
variables {D : Type u₂} [category.{v} D] [has_zero_morphisms D]
variables (G : C ⥤ D) [functor.preserves_zero_morphisms G]

namespace category_theory.limits

section kernels
variables {X Y Z : C} {f : X ⟶ Y} {h : Z ⟶ X} (w : h ≫ f = 0)

/--
The map of a kernel fork is a limit iff
the kernel fork consisting of the mapped morphisms is a limit.
This essentially lets us commute `kernel_fork.of_ι` with `functor.map_cone`.

This is a variant of `is_limit_map_cone_fork_equiv` for equalizers,
which we can't use directly between `G.map 0 = 0` does not hold definitionally.
-/
def is_limit_map_cone_fork_equiv' :
  is_limit (G.map_cone (kernel_fork.of_ι h w)) ≃
  is_limit (kernel_fork.of_ι (G.map h) (by simp only [←G.map_comp, w, functor.map_zero])
    : fork (G.map f) 0) :=
begin
  refine (is_limit.postcompose_hom_equiv _ _).symm.trans (is_limit.equiv_iso_limit _),
  refine parallel_pair.ext (iso.refl _) (iso.refl _) _ _; simp,
  refine fork.ext (iso.refl _) _,
  simp [fork.ι]
end

/--
The property of preserving kernels expressed in terms of kernel forks.

This is a variant of `is_limit_fork_map_of_is_limit` for equalizers,
which we can't use directly between `G.map 0 = 0` does not hold definitionally.
-/
def is_limit_fork_map_of_is_limit' [preserves_limit (parallel_pair f 0) G]
  (l : is_limit (kernel_fork.of_ι h w)) :
  is_limit (kernel_fork.of_ι (G.map h) (by simp only [←G.map_comp, w, functor.map_zero]) :
    fork (G.map f) 0) :=
is_limit_map_cone_fork_equiv' G w (preserves_limit.preserves l)

variables (f) [has_kernel f]

/--
If `G` preserves kernels and `C` has them, then the fork constructed of the mapped morphisms of
a kernel fork is a limit.
-/
def is_limit_of_has_kernel_of_preserves_limit [preserves_limit (parallel_pair f 0) G] :
  is_limit (fork.of_ι (G.map (kernel.ι f))
    (by simp only [←G.map_comp, equalizer.condition, comp_zero, functor.map_zero])
      : fork (G.map f) 0) :=
is_limit_fork_map_of_is_limit' G (kernel.condition f) (kernel_is_kernel f)

instance [preserves_limit (parallel_pair f 0) G] : has_kernel (G.map f) :=
{ exists_limit := ⟨⟨_, is_limit_of_has_kernel_of_preserves_limit G f⟩⟩, }

variables [has_kernel (G.map f)]

/--
If the kernel comparison map for `G` at `f` is an isomorphism, then `G` preserves the
kernel of `f`.
-/
def preserves_kernel.of_iso_comparison [i : is_iso (kernel_comparison f G)] :
  preserves_limit (parallel_pair f 0) G :=
begin
  apply preserves_limit_of_preserves_limit_cone (kernel_is_kernel f),
  apply (is_limit_map_cone_fork_equiv' G (kernel.condition f)).symm _,
  apply is_limit.of_point_iso (limit.is_limit (parallel_pair (G.map f) 0)),
  apply i,
end

variables [preserves_limit (parallel_pair f 0) G]
/--
If `G` preserves the kernel of `f`, then the kernel comparison map for `G` at `f` is
an isomorphism.
-/
def preserves_kernel.iso :
  G.obj (kernel f) ≅ kernel (G.map f) :=
is_limit.cone_point_unique_up_to_iso
  (is_limit_of_has_kernel_of_preserves_limit G f)
  (limit.is_limit _)

@[simp]
lemma preserves_kernel.iso_hom :
  (preserves_kernel.iso G f).hom = kernel_comparison f G :=
rfl

instance : is_iso (kernel_comparison f G) :=
begin
  rw ← preserves_kernel.iso_hom,
  apply_instance
end

end kernels

section cokernels

variables {X Y Z : C} {f : X ⟶ Y} {h : Y ⟶ Z} (w : f ≫ h = 0)

/--
The map of a cokernel cofork is a colimit iff
the cokernel cofork consisting of the mapped morphisms is a colimit.
This essentially lets us commute `cokernel_cofork.of_π` with `functor.map_cocone`.

This is a variant of `is_colimit_map_cocone_cofork_equiv` for equalizers,
which we can't use directly between `G.map 0 = 0` does not hold definitionally.
-/
def is_colimit_map_cocone_cofork_equiv' :
  is_colimit (G.map_cocone (cokernel_cofork.of_π h w)) ≃
  is_colimit (cokernel_cofork.of_π (G.map h) (by simp only [←G.map_comp, w, functor.map_zero])
    : cofork (G.map f) 0) :=
begin
  refine (is_colimit.precompose_hom_equiv _ _).symm.trans (is_colimit.equiv_iso_colimit _),
  refine parallel_pair.ext (iso.refl _) (iso.refl _) _ _; simp,
  refine cofork.ext (iso.refl _) _,
  simp only [cofork.π, iso.refl_hom, id_comp, cocones.precompose_obj_ι,
    nat_trans.comp_app, parallel_pair.ext_hom_app, functor.map_cocone_ι_app,
    cofork.of_π_ι_app],
  apply category.comp_id
end

/--
The property of preserving cokernels expressed in terms of cokernel coforks.

This is a variant of `is_colimit_cofork_map_of_is_colimit` for equalizers,
which we can't use directly between `G.map 0 = 0` does not hold definitionally.
-/
def is_colimit_cofork_map_of_is_colimit' [preserves_colimit (parallel_pair f 0) G]
  (l : is_colimit (cokernel_cofork.of_π h w)) :
  is_colimit (cokernel_cofork.of_π (G.map h) (by simp only [←G.map_comp, w, functor.map_zero]) :
    cofork (G.map f) 0) :=
is_colimit_map_cocone_cofork_equiv' G w (preserves_colimit.preserves l)

variables (f) [has_cokernel f]

/--
If `G` preserves cokernels and `C` has them, then the cofork constructed of the mapped morphisms of
a cokernel cofork is a colimit.
-/
def is_colimit_of_has_cokernel_of_preserves_colimit [preserves_colimit (parallel_pair f 0) G] :
  is_colimit (cofork.of_π (G.map (cokernel.π f))
    (by simp only [←G.map_comp, coequalizer.condition, zero_comp, functor.map_zero])
      : cofork (G.map f) 0) :=
is_colimit_cofork_map_of_is_colimit' G (cokernel.condition f) (cokernel_is_cokernel f)

instance [preserves_colimit (parallel_pair f 0) G] : has_cokernel (G.map f) :=
{ exists_colimit := ⟨⟨_, is_colimit_of_has_cokernel_of_preserves_colimit G f⟩⟩, }

variables [has_cokernel (G.map f)]

/--
If the cokernel comparison map for `G` at `f` is an isomorphism, then `G` preserves the
cokernel of `f`.
-/
def preserves_cokernel.of_iso_comparison [i : is_iso (cokernel_comparison f G)] :
  preserves_colimit (parallel_pair f 0) G :=
begin
  apply preserves_colimit_of_preserves_colimit_cocone (cokernel_is_cokernel f),
  apply (is_colimit_map_cocone_cofork_equiv' G (cokernel.condition f)).symm _,
  apply is_colimit.of_point_iso (colimit.is_colimit (parallel_pair (G.map f) 0)),
  apply i,
end

variables [preserves_colimit (parallel_pair f 0) G]
/--
If `G` preserves the cokernel of `f`, then the cokernel comparison map for `G` at `f` is
an isomorphism.
-/
def preserves_cokernel.iso :
  G.obj (cokernel f) ≅ cokernel (G.map f) :=
is_colimit.cocone_point_unique_up_to_iso
  (is_colimit_of_has_cokernel_of_preserves_colimit G f)
  (colimit.is_colimit _)

@[simp]
lemma preserves_cokernel.iso_inv :
  (preserves_cokernel.iso G f).inv = cokernel_comparison f G :=
rfl

instance : is_iso (cokernel_comparison f G) :=
begin
  rw ← preserves_cokernel.iso_inv,
  apply_instance
end

end cokernels

end category_theory.limits


import tactic.lint

def f : ℕ → ℕ := default _
def c : ℕ := default _
def d : ℕ := default _

@[simp] lemma c_eq_d : c = d := rfl

-- The following lemma never applies when using simp, because c is first rewritten to d
@[simp] lemma f_c : f c = 0 := rfl

example : f c = 0 :=
begin
  simp,
  guard_target f d = 0, -- does not apply f_c
  refl
end

open tactic
run_cmd do
decl ← get_decl ``f_c,
res ← linter.simp_nf.test decl,
-- linter complains
guard $ res.is_some

-- also works with `coe_to_fun`

structure morphism :=
(f : ℕ → ℕ)

instance : has_coe_to_fun morphism :=
⟨_, morphism.f⟩

def h : morphism := ⟨default _⟩

-- Also never applies
@[simp] lemma h_c : h c = 0 := rfl

example : h c = 0 :=
begin
  simp,
  guard_target h d = 0, -- does not apply h_c
  refl
end

open tactic
run_cmd do
decl ← get_decl ``h_c,
res ← linter.simp_nf.test decl,
-- linter complains
guard $ res.is_some


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.basic
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4 u_5 u_6

namespace Mathlib

/-!
# Extra facts about `prod`

This file defines `prod.swap : α × β → β × α` and proves various simple lemmas about `prod`.
-/

@[simp] theorem prod_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} (f : α → γ)
    (g : β → δ) (p : α × β) : prod.map f g p = (f (prod.fst p), g (prod.snd p)) :=
  rfl

namespace prod

@[simp] theorem forall {α : Type u_1} {β : Type u_2} {p : α × β → Prop} :
    (∀ (x : α × β), p x) ↔ ∀ (a : α) (b : β), p (a, b) :=
  sorry

@[simp] theorem exists {α : Type u_1} {β : Type u_2} {p : α × β → Prop} :
    (∃ (x : α × β), p x) ↔ ∃ (a : α), ∃ (b : β), p (a, b) :=
  sorry

theorem forall' {α : Type u_1} {β : Type u_2} {p : α → β → Prop} :
    (∀ (x : α × β), p (fst x) (snd x)) ↔ ∀ (a : α) (b : β), p a b :=
  forall

theorem exists' {α : Type u_1} {β : Type u_2} {p : α → β → Prop} :
    (∃ (x : α × β), p (fst x) (snd x)) ↔ ∃ (a : α), ∃ (b : β), p a b :=
  exists

@[simp] theorem map_mk {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} (f : α → γ)
    (g : β → δ) (a : α) (b : β) : map f g (a, b) = (f a, g b) :=
  rfl

theorem map_fst {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} (f : α → γ) (g : β → δ)
    (p : α × β) : fst (map f g p) = f (fst p) :=
  rfl

theorem map_snd {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} (f : α → γ) (g : β → δ)
    (p : α × β) : snd (map f g p) = g (snd p) :=
  rfl

theorem map_fst' {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} (f : α → γ)
    (g : β → δ) : fst ∘ map f g = f ∘ fst :=
  funext (map_fst f g)

theorem map_snd' {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} (f : α → γ)
    (g : β → δ) : snd ∘ map f g = g ∘ snd :=
  funext (map_snd f g)

/--
Composing a `prod.map` with another `prod.map` is equal to
a single `prod.map` of composed functions.
-/
theorem map_comp_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} {ε : Type u_5}
    {ζ : Type u_6} (f : α → β) (f' : γ → δ) (g : β → ε) (g' : δ → ζ) :
    map g g' ∘ map f f' = map (g ∘ f) (g' ∘ f') :=
  rfl

/--
Composing a `prod.map` with another `prod.map` is equal to
a single `prod.map` of composed functions, fully applied.
-/
theorem map_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} {ε : Type u_5}
    {ζ : Type u_6} (f : α → β) (f' : γ → δ) (g : β → ε) (g' : δ → ζ) (x : α × γ) :
    map g g' (map f f' x) = map (g ∘ f) (g' ∘ f') x :=
  rfl

@[simp] theorem mk.inj_iff {α : Type u_1} {β : Type u_2} {a₁ : α} {a₂ : α} {b₁ : β} {b₂ : β} :
    (a₁, b₁) = (a₂, b₂) ↔ a₁ = a₂ ∧ b₁ = b₂ :=
  sorry

theorem mk.inj_left {α : Type u_1} {β : Type u_2} (a : α) : function.injective (Prod.mk a) := sorry

theorem mk.inj_right {α : Type u_1} {β : Type u_2} (b : β) :
    function.injective fun (a : α) => (a, b) :=
  sorry

theorem ext_iff {α : Type u_1} {β : Type u_2} {p : α × β} {q : α × β} :
    p = q ↔ fst p = fst q ∧ snd p = snd q :=
  sorry

theorem ext {α : Type u_1} {β : Type u_2} {p : α × β} {q : α × β} (h₁ : fst p = fst q)
    (h₂ : snd p = snd q) : p = q :=
  iff.mpr ext_iff { left := h₁, right := h₂ }

theorem map_def {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} {f : α → γ}
    {g : β → δ} : map f g = fun (p : α × β) => (f (fst p), g (snd p)) :=
  funext fun (p : α × β) => ext (map_fst f g p) (map_snd f g p)

theorem id_prod {α : Type u_1} : (fun (p : α × α) => (fst p, snd p)) = id := sorry

theorem fst_surjective {α : Type u_1} {β : Type u_2} [h : Nonempty β] : function.surjective fst :=
  fun (x : α) => nonempty.elim h fun (y : β) => Exists.intro (x, y) rfl

theorem snd_surjective {α : Type u_1} {β : Type u_2} [h : Nonempty α] : function.surjective snd :=
  fun (y : β) => nonempty.elim h fun (x : α) => Exists.intro (x, y) rfl

theorem fst_injective {α : Type u_1} {β : Type u_2} [subsingleton β] : function.injective fst :=
  fun (x y : α × β) (h : fst x = fst y) => ext h (subsingleton.elim (snd x) (snd y))

theorem snd_injective {α : Type u_1} {β : Type u_2} [subsingleton α] : function.injective snd :=
  fun (x y : α × β) (h : snd x = snd y) => ext (subsingleton.elim (fst x) (fst y)) h

/-- Swap the factors of a product. `swap (a, b) = (b, a)` -/
def swap {α : Type u_1} {β : Type u_2} : α × β → β × α := fun (p : α × β) => (snd p, fst p)

@[simp] theorem swap_swap {α : Type u_1} {β : Type u_2} (x : α × β) : swap (swap x) = x :=
  cases_on x
    fun (x_fst : α) (x_snd : β) =>
      idRhs (swap (swap (x_fst, x_snd)) = swap (swap (x_fst, x_snd))) rfl

@[simp] theorem fst_swap {α : Type u_1} {β : Type u_2} {p : α × β} : fst (swap p) = snd p := rfl

@[simp] theorem snd_swap {α : Type u_1} {β : Type u_2} {p : α × β} : snd (swap p) = fst p := rfl

@[simp] theorem swap_prod_mk {α : Type u_1} {β : Type u_2} {a : α} {b : β} : swap (a, b) = (b, a) :=
  rfl

@[simp] theorem swap_swap_eq {α : Type u_1} {β : Type u_2} : swap ∘ swap = id := funext swap_swap

@[simp] theorem swap_left_inverse {α : Type u_1} {β : Type u_2} : function.left_inverse swap swap :=
  swap_swap

@[simp] theorem swap_right_inverse {α : Type u_1} {β : Type u_2} :
    function.right_inverse swap swap :=
  swap_swap

theorem swap_injective {α : Type u_1} {β : Type u_2} : function.injective swap :=
  function.left_inverse.injective swap_left_inverse

theorem swap_surjective {α : Type u_1} {β : Type u_2} : function.surjective swap :=
  function.left_inverse.surjective swap_left_inverse

theorem swap_bijective {α : Type u_1} {β : Type u_2} : function.bijective swap :=
  { left := swap_injective, right := swap_surjective }

@[simp] theorem swap_inj {α : Type u_1} {β : Type u_2} {p : α × β} {q : α × β} :
    swap p = swap q ↔ p = q :=
  function.injective.eq_iff swap_injective

theorem eq_iff_fst_eq_snd_eq {α : Type u_1} {β : Type u_2} {p : α × β} {q : α × β} :
    p = q ↔ fst p = fst q ∧ snd p = snd q :=
  sorry

theorem fst_eq_iff {α : Type u_1} {β : Type u_2} {p : α × β} {x : α} : fst p = x ↔ p = (x, snd p) :=
  sorry

theorem snd_eq_iff {α : Type u_1} {β : Type u_2} {p : α × β} {x : β} : snd p = x ↔ p = (fst p, x) :=
  sorry

theorem lex_def {α : Type u_1} {β : Type u_2} (r : α → α → Prop) (s : β → β → Prop) {p : α × β}
    {q : α × β} : lex r s p q ↔ r (fst p) (fst q) ∨ fst p = fst q ∧ s (snd p) (snd q) :=
  sorry

protected instance lex.decidable {α : Type u_1} {β : Type u_2} [DecidableEq α] (r : α → α → Prop)
    (s : β → β → Prop) [DecidableRel r] [DecidableRel s] : DecidableRel (lex r s) :=
  fun (p q : α × β) => decidable_of_decidable_of_iff or.decidable sorry

end prod

theorem function.injective.prod_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4}
    {f : α → γ} {g : β → δ} (hf : function.injective f) (hg : function.injective g) :
    function.injective (prod.map f g) :=
  fun (x y : α × β) (h : prod.map f g x = prod.map f g y) =>
    prod.ext (hf (and.left (iff.mp prod.ext_iff h))) (hg (and.right (iff.mp prod.ext_iff h)))

theorem function.surjective.prod_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4}
    {f : α → γ} {g : β → δ} (hf : function.surjective f) (hg : function.surjective g) :
    function.surjective (prod.map f g) :=
  sorry

end Mathlib


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

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

namespace Mathlib

/-!
# Monoidal natural transformations

Natural transformations between (lax) monoidal functors must satisfy
an additional compatibility relation with the tensorators:
`F.μ X Y ≫ app (X ⊗ Y) = (app X ⊗ app Y) ≫ G.μ X Y`.

(Lax) monoidal functors between a fixed pair of monoidal categories
themselves form a category.
-/

namespace category_theory

/--
A monoidal natural transformation is a natural transformation between (lax) monoidal functors
additionally satisfying:
`F.μ X Y ≫ app (X ⊗ Y) = (app X ⊗ app Y) ≫ G.μ X Y`
-/
structure monoidal_nat_trans {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] (F : lax_monoidal_functor C D) (G : lax_monoidal_functor C D)
extends nat_trans (lax_monoidal_functor.to_functor F) (lax_monoidal_functor.to_functor G)
where
  unit' : autoParam (lax_monoidal_functor.ε F ≫ nat_trans.app _to_nat_trans 𝟙_ = lax_monoidal_functor.ε G)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  tensor' : autoParam
  (∀ (X Y : C),
    lax_monoidal_functor.μ F X Y ≫ nat_trans.app _to_nat_trans (X ⊗ Y) =
      (nat_trans.app _to_nat_trans X ⊗ nat_trans.app _to_nat_trans Y) ≫ lax_monoidal_functor.μ G X Y)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

@[simp] theorem monoidal_nat_trans.tensor {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D} (c : monoidal_nat_trans F G) (X : C) (Y : C) : lax_monoidal_functor.μ F X Y ≫ nat_trans.app (monoidal_nat_trans.to_nat_trans c) (X ⊗ Y) =
  (nat_trans.app (monoidal_nat_trans.to_nat_trans c) X ⊗ nat_trans.app (monoidal_nat_trans.to_nat_trans c) Y) ≫
    lax_monoidal_functor.μ G X Y := sorry

@[simp] theorem monoidal_nat_trans.tensor_assoc {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D} (c : monoidal_nat_trans F G) (X : C) (Y : C) {X' : D} (f' : functor.obj (lax_monoidal_functor.to_functor G) (X ⊗ Y) ⟶ X') : lax_monoidal_functor.μ F X Y ≫ nat_trans.app (monoidal_nat_trans.to_nat_trans c) (X ⊗ Y) ≫ f' =
  (nat_trans.app (monoidal_nat_trans.to_nat_trans c) X ⊗ nat_trans.app (monoidal_nat_trans.to_nat_trans c) Y) ≫
    lax_monoidal_functor.μ G X Y ≫ f' := sorry

@[simp] theorem monoidal_nat_trans.unit {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D} (c : monoidal_nat_trans F G) : lax_monoidal_functor.ε F ≫ nat_trans.app (monoidal_nat_trans.to_nat_trans c) 𝟙_ = lax_monoidal_functor.ε G := sorry

@[simp] theorem monoidal_nat_trans.unit_assoc {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D} (c : monoidal_nat_trans F G) {X' : D} (f' : functor.obj (lax_monoidal_functor.to_functor G) 𝟙_ ⟶ X') : lax_monoidal_functor.ε F ≫ nat_trans.app (monoidal_nat_trans.to_nat_trans c) 𝟙_ ≫ f' = lax_monoidal_functor.ε G ≫ f' := sorry

namespace monoidal_nat_trans

/--
The identity monoidal natural transformation.
-/
def id {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] (F : lax_monoidal_functor C D) : monoidal_nat_trans F F :=
  mk (nat_trans.mk (nat_trans.app 𝟙))

protected instance inhabited {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] (F : lax_monoidal_functor C D) : Inhabited (monoidal_nat_trans F F) :=
  { default := id F }

/--
Vertical composition of monoidal natural transformations.
-/
def vcomp {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D} {H : lax_monoidal_functor C D} (α : monoidal_nat_trans F G) (β : monoidal_nat_trans G H) : monoidal_nat_trans F H :=
  mk (nat_trans.mk (nat_trans.app (nat_trans.vcomp (to_nat_trans α) (to_nat_trans β))))

protected instance category_lax_monoidal_functor {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] : category (lax_monoidal_functor C D) :=
  category.mk

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

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

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

/--
Horizontal composition of monoidal natural transformations.
-/
@[simp] theorem hcomp_to_nat_trans {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {E : Type u₃} [category E] [monoidal_category E] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D} {H : lax_monoidal_functor D E} {K : lax_monoidal_functor D E} (α : monoidal_nat_trans F G) (β : monoidal_nat_trans H K) : to_nat_trans (hcomp α β) = to_nat_trans α ◫ to_nat_trans β :=
  Eq.refl (to_nat_trans (hcomp α β))

end monoidal_nat_trans

namespace monoidal_nat_iso

protected instance is_iso_of_is_iso_app {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D} (α : F ⟶ G) [(X : C) → is_iso (nat_trans.app (monoidal_nat_trans.to_nat_trans α) X)] : is_iso α :=
  is_iso.mk
    (monoidal_nat_trans.mk (nat_trans.mk fun (X : C) => inv (nat_trans.app (monoidal_nat_trans.to_nat_trans α) X)))

/--
Construct a monoidal natural isomorphism from object level isomorphisms,
and the monoidal naturality in the forward direction.
-/
def of_components {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D} (app : (X : C) → functor.obj (lax_monoidal_functor.to_functor F) X ≅ functor.obj (lax_monoidal_functor.to_functor G) X) (naturality : ∀ {X Y : C} (f : X ⟶ Y),
  functor.map (lax_monoidal_functor.to_functor F) f ≫ iso.hom (app Y) =
    iso.hom (app X) ≫ functor.map (lax_monoidal_functor.to_functor G) f) (unit : lax_monoidal_functor.ε F ≫ iso.hom (app 𝟙_) = lax_monoidal_functor.ε G) (tensor : ∀ (X Y : C),
  lax_monoidal_functor.μ F X Y ≫ iso.hom (app (X ⊗ Y)) =
    (iso.hom (app X) ⊗ iso.hom (app Y)) ≫ lax_monoidal_functor.μ G X Y) : F ≅ G :=
  as_iso (monoidal_nat_trans.mk (nat_trans.mk fun (X : C) => iso.hom (app X)))

@[simp] theorem of_components.hom_app {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D} (app : (X : C) → functor.obj (lax_monoidal_functor.to_functor F) X ≅ functor.obj (lax_monoidal_functor.to_functor G) X) (naturality : ∀ {X Y : C} (f : X ⟶ Y),
  functor.map (lax_monoidal_functor.to_functor F) f ≫ iso.hom (app Y) =
    iso.hom (app X) ≫ functor.map (lax_monoidal_functor.to_functor G) f) (unit : lax_monoidal_functor.ε F ≫ iso.hom (app 𝟙_) = lax_monoidal_functor.ε G) (tensor : ∀ (X Y : C),
  lax_monoidal_functor.μ F X Y ≫ iso.hom (app (X ⊗ Y)) =
    (iso.hom (app X) ⊗ iso.hom (app Y)) ≫ lax_monoidal_functor.μ G X Y) (X : C) : nat_trans.app (monoidal_nat_trans.to_nat_trans (iso.hom (of_components app naturality unit tensor))) X = iso.hom (app X) :=
  rfl

@[simp] theorem of_components.inv_app {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D} (app : (X : C) → functor.obj (lax_monoidal_functor.to_functor F) X ≅ functor.obj (lax_monoidal_functor.to_functor G) X) (naturality : ∀ {X Y : C} (f : X ⟶ Y),
  functor.map (lax_monoidal_functor.to_functor F) f ≫ iso.hom (app Y) =
    iso.hom (app X) ≫ functor.map (lax_monoidal_functor.to_functor G) f) (unit : lax_monoidal_functor.ε F ≫ iso.hom (app 𝟙_) = lax_monoidal_functor.ε G) (tensor : ∀ (X Y : C),
  lax_monoidal_functor.μ F X Y ≫ iso.hom (app (X ⊗ Y)) =
    (iso.hom (app X) ⊗ iso.hom (app Y)) ≫ lax_monoidal_functor.μ G X Y) (X : C) : nat_trans.app (monoidal_nat_trans.to_nat_trans (iso.inv (of_components app naturality unit tensor))) X = iso.inv (app X) :=
  rfl