import tactic
import topology.instances.real

import .tokens
import .compute
import .commun

namespace tactic
setup_tactic_parser

@[derive has_reflect]
meta inductive On_args
| exct_aply : pexpr → list pexpr → On_args -- On conclut par ... (appliqué à ...)
| aply : pexpr → On_args             -- On applique ...
| aply_at : pexpr → list pexpr → On_args  -- On applique ... à ...
| rwrite : interactive.rw_rules_t → option name → option pexpr → On_args           -- On réécrit via ... (dans ... (qui devient ...))
| rwrite_all : interactive.rw_rules_t → On_args -- On réécrit via ... partout
| compute : On_args                  -- On calcule
| compute_at : name → On_args        -- On calcule dans ...
| linar : list pexpr → On_args       -- On combine ...
| contrap (push : bool) : On_args    -- On contrapose (simplement)
| push_negation (hyp : option name) (new : option pexpr) : On_args   -- On pousse la négation (dans ... (qui devient ...))
| discussion : pexpr → On_args       -- On discute en utilisant ... [cases]
| discussion_hyp : pexpr → On_args       -- On discute selon que ... [by_cases]
| deplie : list name → On_args -- On déplie ...
| deplie_at : list name → loc → option pexpr → On_args -- On déplie ... dans ... (qui devient ...)
| rname : name → name → option loc → option pexpr → On_args -- On renomme ... en ... (dans ... (qui devient ...))
| oubli : list name → On_args -- pour clear
| reforml : name → pexpr → On_args -- pour change at

open On_args

meta def qui_devient_parser : lean.parser (option pexpr) := (tk "qui" *> tk "devient" *> texpr)?

/-- Syntax for on parser-/
meta def On_parser : lean.parser On_args :=
with_desc "conclut par ... (appliqué à ...) / On applique ... (à ...) / On calcule (dans ...) / On réécrit via ... (dans ... (qui devient ...)) / On combine ... / On contrapose / On discute selon ... / On discute selon que ... / On déplie ... (dans ... (qui devient ...)) / On renomme ... en ... (dans ... (qui devient ...)) / On oublie ... / On reformule ... en ... / On pousse la négation (dans ... (qui devient ...))" $
(exct_aply <$> (tk "conclut" *> tk "par" *> texpr) <*> applique_a_parser) <|>
(do { e ← tk "applique" *> texpr,
      aply_at e <$> (tk "à" *> pexpr_list_or_texpr) <|> pure (aply e)}) <|>
(tk "calcule" *> (compute_at <$> (tk "dans" *> ident) <|> pure compute)) <|>
(linar <$> (tk "combine" *> pexpr_list_or_texpr)) <|>
do { rules ← tk "réécrit" *> tk "via" *> interactive.rw_rules,
     rwrite_all rules <$ tk "partout" <|>
     rwrite rules <$> (tk "dans" *> ident)? <*> qui_devient_parser } <|>
do { tk "contrapose",
     (contrap ff <$ tk "simplement") <|>
     pure (contrap tt) } <|>
push_negation <$> (tk "pousse" *> tk "la" *> tk "négation" *> (tk "dans" *> ident)?) <*> qui_devient_parser <|>
do { tk "discute",
     discussion_hyp <$> (tk "selon" *> tk "que" *> texpr) <|>
     discussion <$> (tk "en" *> tk "utilisant" *> texpr) } <|>
do { ids ← tk "déplie" *> ident*,
     do { place ← tk "dans" *> ident,
          deplie_at ids (loc.ns [place]) <$> qui_devient_parser } <|>
     pure (deplie ids) } <|>
do { old ← tk "renomme" *> ident <* tk "en",
     new ← ident,
     do { place ← tk "dans" *> ident,
          rname old new (loc.ns [place]) <$> qui_devient_parser } <|>
     pure (rname old new none none) } <|>
reforml <$> (tk "reformule" *> ident <* tk "en") <*> texpr <|>
oubli <$> (tk "oublie" *> ident*)

/-- Action de démonstration -/
@[interactive]
meta def On : parse On_parser → tactic unit
| (exct_aply pe l) := conclure pe l
| (aply pe) := focus1 (do
    to_expr pe >>= apply,
    all_goals (do try assumption, nettoyage),
    skip)
| (aply_at pe pl) := do l ← pl.mmap to_expr,
                        l.mmap' (apply_arrow_to_hyp pe)  <|> interactive.specialize (pexpr_mk_app pe pl)
| (rwrite pe l new) := do interactive.rewrite pe (loc.ns [l]),
                          match (l, new) with
                          | (some hyp, some newhyp) := do ne ← get_local hyp,
                                                          enewhyp ← to_expr newhyp,
                                                          infer_type ne >>= unify enewhyp
                          | (_, some n) := fail "On ne peut pas utiliser « qui devient » lorsqu'on réécrit via dans plusieurs endroits."
                          | (_, none) := skip
                          end
| (rwrite_all pe) := interactive.rewrite pe loc.wildcard
| compute := interactive.compute_at_goal'
| (compute_at h) := interactive.compute_at_hyp' h
| (linar le) := do le' ← le.mmap to_expr >>= split_ands,
                   linarith ff tt le' <|> fail "Combiner ces faits ce suffit pas."
| (contrap push) := do
      `(%%P → %%Q) ← target | fail "On ne peut pas contraposer, le but n'est pas une implication",
      cp ← mk_mapp ``imp_of_not_imp_not [P, Q] <|> fail "On ne peut pas contraposer, le but n'est pas une implication",
      apply cp,
      if push then try (tactic.interactive.push_neg (loc.ns [none])) else skip
| (discussion pe) := focus1 (do e ← to_expr pe,
                                `(%%P ∨ %%Q) ← infer_type e <|> fail "Cette expression n'est pas une disjonction.",
                                tgt ← target,
                                `[refine (or.elim %%e _ _)],
                                all_goals (try (clear e)) >> skip)
| (discussion_hyp pe) := do e ← to_expr pe,
                        `[refine (or.elim (classical.em %%e) _ _)]
| (deplie le) := interactive.unfold le (loc.ns [none])
| (deplie_at le loca new) := do interactive.unfold le loca,
                                match (loca, new) with
                                | (loc.ns [some hyp], some newhyp) := do ne ← get_local hyp,
                                                                         enewhyp ← to_expr newhyp,
                                                                         infer_type ne >>= unify enewhyp
                                | (_, some n) := fail "On ne peut pas utiliser « qui devient » lorsqu'on déplie dans plusieurs endroits."
                                | (_, none) := skip
                                end
| (rname old new loca newhyp) := match (loca, newhyp) with
                          | (some (loc.ns [some n]), some truc) := do e ← get_local n,
                                                                      rename_var_at_hyp old new e,
                                                                      interactive.guard_hyp_strict n truc <|>
                                                                        fail "Ce n'est pas l'expression obtenue."
                          | (some (loc.ns [some n]), none) := do e ← get_local n,
                                                                 rename_var_at_hyp old new e
                          | _ := rename_var_at_goal old new
                          end
| (oubli l) := clear_lst l
| (reforml n pe) := do h ← get_local n, e ← to_expr pe, change_core e (some h)
| (push_negation n new) := do interactive.push_neg (loc.ns [n]),
                              match (n, new) with
                              | (some hyp, some stuff) := do e ← get_local hyp,
                                                             enewhyp ← to_expr stuff,
                                                             infer_type e >>= unify enewhyp
                              | (none, some stuff) := fail "On ne peut pas indiquer « qui devient » quand on pousse la négation dans le but."
                              | _ := skip
                              end

end tactic

example (P Q R : Prop) (hRP : R → P) (hR : R) (hQ : Q) : P :=
begin
  fail_if_success { On conclut par hRP appliqué à hQ },
  On conclut par hRP appliqué à hR,
end

example (P : ℕ → Prop) (h : ∀ n, P n) : P 0 :=
begin
  On conclut par h appliqué à _,
end

example (P : ℕ → Prop) (h : ∀ n, P n) : P 0 :=
begin
  On conclut par h,
end

example {a b : ℕ}: a + b = b + a :=
begin
  On calcule,
end

example {a b : ℕ} (h : a + b - a = 0) : b = 0 :=
begin
  On calcule dans h,
  On conclut par h,
end

variables k : nat

example (h : true) : true :=
begin
  On conclut par h,
end

example (h : ∀ n : ℕ, true) : true :=
begin
  On conclut par h appliqué à 0,
end

example (h : true → true) : true :=
begin
  On applique h,
  trivial,
end

example (h : ∀ n k : ℕ, true) : true :=
begin
  On conclut par h appliqué à [0, 1],
end

example (a b : ℕ) (h : a < b) : a ≤ b :=
begin
  On conclut par h,
end

example (a b c : ℕ) (h : a < b ∧ a < c) : a ≤ b :=
begin
  On conclut par h,
end

example (a b c : ℕ) (h : a ≤ b) (h' : b ≤ c) : a ≤ c :=
begin
  On combine [h, h'],
end

example (a b c : ℤ) (h : a = b + c) (h' : b - a = c) : c = 0 :=
begin
  On combine [h, h'],
end

example (a b c : ℕ) (h : a ≤ b) (h' : b ≤ c ∧ a+b ≤ a+c) : a ≤ c :=
begin
  On combine [h, h'],
end

example (a b c : ℕ) (h : a = b) (h' : a = c) : b = c :=
begin
  On réécrit via ← h,
  On conclut par h',
end

example (a b c : ℕ) (h : a = b) (h' : a = c) : b = c :=
begin
  On réécrit via h dans h',
  On conclut par h',
end

example (f : ℕ → ℕ) (n : ℕ) (h : n > 0 → f n = 0) (hn : n > 0): f n = 0 :=
begin
  On réécrit via h,
  exact hn
end

example (f : ℕ → ℕ) (n : ℕ) (h : ∀ n > 0, f n = 0) : f 1 = 0 :=
begin
  On réécrit via h,
  norm_num
end

example (a b c : ℕ) (h : a = b) (h' : a = c) : b = c :=
begin
  success_if_fail { On réécrit via h dans h' qui devient a = c },
  On réécrit via h dans h' qui devient b = c,
  On conclut par h',
end

example (a b c : ℕ) (h : a = b) (h' : a = c) : a = c :=
begin
  On réécrit via h partout,
  On conclut par h',
end

example (P Q R : Prop) (h : P → Q) (h' : P) : Q :=
begin
  On applique h à h',
  On conclut par h',
end

example (P Q R : Prop) (h : P → Q → R) (hP : P) (hQ : Q) : R :=
begin
  On conclut par h appliqué à [hP, hQ],
end

example (f : ℕ → ℕ) (a b : ℕ) (h : a = b) : f a = f b :=
begin
  On applique f à h,
  On conclut par h,
end

example (P : ℕ → Prop) (h : ∀ n, P n) : P 0 :=
begin
  On applique h à 0,
  On conclut par h
end

example (x : ℝ) : (∀ ε > 0, x ≤ ε) → x ≤ 0 :=
begin
  On contrapose,
  intro h,
  use x/2,
  split,
    On conclut par h, -- linarith
  On conclut par h, -- linarith
end

example (ε : ℝ) (h : ε > 0) : ε ≥ 0 := by On conclut par h
example (ε : ℝ) (h : ε > 0) : ε/2 > 0 := by On conclut par h
example (ε : ℝ) (h : ε > 0) : ε ≥ -1 := by On conclut par h
example (ε : ℝ) (h : ε > 0) : ε/2 ≥ -3 := by On conclut par h

example (x : ℝ) (h : x = 3) : 2*x = 6 := by On conclut par h

example (x : ℝ) : (∀ ε > 0, x ≤ ε) → x ≤ 0 :=
begin
  On contrapose simplement,
  intro h,
  On pousse la négation,
  On pousse la négation dans h,
  use x/2,
  split,
    On conclut par h, -- linarith
  On conclut par h, -- linarith
end

example (x : ℝ) : (∀ ε > 0, x ≤ ε) → x ≤ 0 :=
begin
  On contrapose simplement,
  intro h,
  success_if_fail { On pousse la négation qui devient 0 < x },
  On pousse la négation,
  success_if_fail { On pousse la négation dans h qui devient ∃ (ε : ℝ), ε > 0 ∧ ε < x },
  On pousse la négation dans h qui devient 0 < x,
  use x/2,
  split,
    On conclut par h, -- linarith
  On conclut par h, -- linarith
end

example : (∀ n : ℕ, false) → 0 = 1 :=
begin
  On contrapose,
  On calcule,
end

example (P Q : Prop) (h : P ∨ Q) : true :=
begin
  On discute en utilisant h,
  all_goals { intro, trivial }
end

example (P : Prop) (hP₁ : P → true) (hP₂ : ¬ P → true): true :=
begin
  On discute selon que P,
  intro h,
  exact hP₁ h,
  intro h,
  exact hP₂ h,
end

def f (n : ℕ) := 2*n

example : f 2 = 4 :=
begin
  On déplie f,
  refl,
end

example (h : f 2 = 4) : true → true :=
begin
  On déplie f dans h,
  guard_hyp_strict h : 2*2 = 4,
  exact id
end

example (h : f 2 = 4) : true → true :=
begin
  success_if_fail { On déplie f dans h qui devient 2*2 = 5 },
  On déplie f dans h qui devient 2*2 = 4,
  exact id
end

example (P : ℕ → ℕ → Prop) (h : ∀ n : ℕ, ∃ k, P n k) : true :=
begin
  On renomme n en p dans h,
  On renomme k en l dans h,
  guard_hyp_strict h : ∀ p, ∃ l, P p l,
  trivial
end

example (P : ℕ → ℕ → Prop) (h : ∀ n : ℕ, ∃ k, P n k) : true :=
begin
  On renomme n en p dans h qui devient ∀ p, ∃ k, P p k,
  success_if_fail { On renomme k en l dans h qui devient ∀ p, ∃ j, P p j },
  On renomme k en l dans h qui devient ∀ p, ∃ l, P p l,
  trivial
end

example (P : ℕ → ℕ → Prop) : (∀ n : ℕ, ∃ k, P n k) ∨ true :=
begin
  On renomme n en p,
  On renomme k en l,
  guard_target_strict (∀ p, ∃ l, P p l) ∨ true,
  right,
  trivial
end

example (a b c : ℕ) : true :=
begin
  On oublie a,
  On oublie b c,
  trivial
end

example (h : 1 + 1 = 2) : true :=
begin
  success_if_fail { On reformule h en 2 = 3 },
  On reformule h en 2 = 2,
  trivial,
end


/-
Copyright (c) 2017 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.tactic.auto_cases
import Mathlib.tactic.chain
import Mathlib.tactic.norm_cast
import Mathlib.PostPort

namespace Mathlib

namespace tactic

namespace tidy

/-- Tag interactive tactics (locally) with `[tidy]` to add them to the list of default tactics
called by `tidy`. -/
end tidy

namespace interactive

/-- Use a variety of conservative tactics to solve goals.

`tidy?` reports back the tactic script it found. As an example
```lean
example : ∀ x : unit, x = unit.star :=
begin
  tidy? -- Prints the trace message: "Try this: intros x, exact dec_trivial"
end
```

The default list of tactics is stored in `tactic.tidy.default_tidy_tactics`.
This list can be overridden using `tidy { tactics := ... }`.
(The list must be a `list` of `tactic string`, so that `tidy?`
can report a usable tactic script.)

Tactics can also be added to the list by tagging them (locally) with the
`[tidy]` attribute. -/
end interactive

/-- Invoking the hole command `tidy` ("Use `tidy` to complete the goal") runs the tactic of
the same name, replacing the hole with the tactic script `tidy` produces.
-/
end Mathlib


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

import Aesop

def Foo := True

example : Foo := by
  fail_if_success aesop (options := { terminal := true })
  simp [Foo]

open Lean.Elab.Tactic in
@[aesop safe]
def myTactic : TacticM Unit := do
  evalTactic $ ← `(tactic| rw [Foo])

example : Foo := by
  aesop


/-
Copyright (c) 2021 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import category_theory.adjunction.comma
import category_theory.limits.preserves.shapes.terminal
import category_theory.structured_arrow
import category_theory.limits.shapes.equivalence

/-!
# Limits and the category of (co)cones

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

This files contains results that stem from the limit API. For the definition and the category
instance of `cone`, please refer to `category_theory/limits/cones.lean`.

## Main results
* The category of cones on `F : J ⥤ C` is equivalent to the category
  `costructured_arrow (const J) F`.
* A cone is limiting iff it is terminal in the category of cones. As a corollary, an equivalence of
  categories of cones preserves limiting properties.

-/

namespace category_theory.limits

open category_theory category_theory.functor

universes v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄

variables {J : Type u₁} [category.{v₁} J] {K : Type u₂} [category.{v₂} K]
variables {C : Type u₃} [category.{v₃} C] {D : Type u₄} [category.{v₄} D]

/-- Construct an object of the category `(Δ ↓ F)` from a cone on `F`. This is part of an
    equivalence, see `cone.equiv_costructured_arrow`. -/
@[simps]
def cone.to_costructured_arrow (F : J ⥤ C) : cone F ⥤ costructured_arrow (const J) F :=
{ obj := λ c, costructured_arrow.mk c.π,
  map := λ c d f, costructured_arrow.hom_mk f.hom $ by { ext, simp } }

/-- Construct a cone on `F` from an object of the category `(Δ ↓ F)`. This is part of an
    equivalence, see `cone.equiv_costructured_arrow`. -/
@[simps]
def cone.from_costructured_arrow (F : J ⥤ C) : costructured_arrow (const J) F ⥤ cone F :=
{ obj := λ c, ⟨c.left, c.hom⟩,
  map := λ c d f,
  { hom := f.left,
    w' := λ j, by { convert (congr_fun (congr_arg nat_trans.app f.w) j), dsimp, simp } } }

/-- The category of cones on `F` is just the comma category `(Δ ↓ F)`, where `Δ` is the constant
    functor. -/
@[simps]
def cone.equiv_costructured_arrow (F : J ⥤ C) : cone F ≌ costructured_arrow (const J) F :=
equivalence.mk (cone.to_costructured_arrow F) (cone.from_costructured_arrow F)
  (nat_iso.of_components cones.eta (by tidy))
  (nat_iso.of_components (λ c, (costructured_arrow.eta _).symm) (by tidy))

/-- A cone is a limit cone iff it is terminal. -/
def cone.is_limit_equiv_is_terminal {F : J ⥤ C} (c : cone F) : is_limit c ≃ is_terminal c :=
is_limit.iso_unique_cone_morphism.to_equiv.trans
{ to_fun := λ h, by exactI is_terminal.of_unique _,
  inv_fun := λ h s, ⟨⟨is_terminal.from h s⟩, λ a, is_terminal.hom_ext h a _⟩,
  left_inv := by tidy,
  right_inv := by tidy }

lemma has_limit_iff_has_terminal_cone (F : J ⥤ C) : has_limit F ↔ has_terminal (cone F) :=
⟨λ h, by exactI (cone.is_limit_equiv_is_terminal _ (limit.is_limit F)).has_terminal,
 λ h, ⟨⟨by exactI ⟨⊤_ _, (cone.is_limit_equiv_is_terminal _).symm terminal_is_terminal⟩⟩⟩⟩

lemma has_limits_of_shape_iff_is_left_adjoint_const :
  has_limits_of_shape J C ↔ nonempty (is_left_adjoint (const J : C ⥤ _)) :=
calc has_limits_of_shape J C
      ↔ ∀ F : J ⥤ C, has_limit F : ⟨λ h, h.has_limit, λ h, by exactI has_limits_of_shape.mk⟩
  ... ↔ ∀ F : J ⥤ C, has_terminal (cone F) : forall_congr has_limit_iff_has_terminal_cone
  ... ↔ ∀ F : J ⥤ C, has_terminal (costructured_arrow (const J) F) :
    forall_congr $ λ F, (cone.equiv_costructured_arrow F).has_terminal_iff
  ... ↔ nonempty (is_left_adjoint (const J : C ⥤ _)) :
    nonempty_is_left_adjoint_iff_has_terminal_costructured_arrow.symm

lemma is_limit.lift_cone_morphism_eq_is_terminal_from {F : J ⥤ C} {c : cone F} (hc : is_limit c)
  (s : cone F) : hc.lift_cone_morphism s =
    is_terminal.from (cone.is_limit_equiv_is_terminal _ hc) _ := rfl

lemma is_terminal.from_eq_lift_cone_morphism {F : J ⥤ C} {c : cone F} (hc : is_terminal c)
  (s : cone F) : is_terminal.from hc s =
    ((cone.is_limit_equiv_is_terminal _).symm hc).lift_cone_morphism s :=
by convert (is_limit.lift_cone_morphism_eq_is_terminal_from _ s).symm

/-- If `G : cone F ⥤ cone F'` preserves terminal objects, it preserves limit cones. -/
def is_limit.of_preserves_cone_terminal {F : J ⥤ C} {F' : K ⥤ D} (G : cone F ⥤ cone F')
  [preserves_limit (functor.empty.{0} _) G] {c : cone F} (hc : is_limit c) :
  is_limit (G.obj c) :=
(cone.is_limit_equiv_is_terminal _).symm $
  (cone.is_limit_equiv_is_terminal _ hc).is_terminal_obj _ _

/-- If `G : cone F ⥤ cone F'` reflects terminal objects, it reflects limit cones. -/
def is_limit.of_reflects_cone_terminal {F : J ⥤ C} {F' : K ⥤ D} (G : cone F ⥤ cone F')
  [reflects_limit (functor.empty.{0} _) G] {c : cone F} (hc : is_limit (G.obj c)) :
  is_limit c :=
(cone.is_limit_equiv_is_terminal _).symm $
  (cone.is_limit_equiv_is_terminal _ hc).is_terminal_of_obj _ _

/-- Construct an object of the category `(F ↓ Δ)` from a cocone on `F`. This is part of an
    equivalence, see `cocone.equiv_structured_arrow`. -/
@[simps]
def cocone.to_structured_arrow (F : J ⥤ C) : cocone F ⥤ structured_arrow F (const J) :=
{ obj := λ c, structured_arrow.mk c.ι,
  map := λ c d f, structured_arrow.hom_mk f.hom $ by { ext, simp } }

/-- Construct a cocone on `F` from an object of the category `(F ↓ Δ)`. This is part of an
    equivalence, see `cocone.equiv_structured_arrow`. -/
@[simps]
def cocone.from_structured_arrow (F : J ⥤ C) : structured_arrow F (const J) ⥤ cocone F :=
{ obj := λ c, ⟨c.right, c.hom⟩,
  map := λ c d f,
  { hom := f.right,
    w' := λ j, by { convert (congr_fun (congr_arg nat_trans.app f.w) j).symm, dsimp, simp } } }

/-- The category of cocones on `F` is just the comma category `(F ↓ Δ)`, where `Δ` is the constant
    functor. -/
@[simps]
def cocone.equiv_structured_arrow (F : J ⥤ C) : cocone F ≌ structured_arrow F (const J) :=
equivalence.mk (cocone.to_structured_arrow F) (cocone.from_structured_arrow F)
  (nat_iso.of_components cocones.eta (by tidy))
  (nat_iso.of_components (λ c, (structured_arrow.eta _).symm) (by tidy))

/-- A cocone is a colimit cocone iff it is initial. -/
def cocone.is_colimit_equiv_is_initial {F : J ⥤ C} (c : cocone F) : is_colimit c ≃ is_initial c :=
is_colimit.iso_unique_cocone_morphism.to_equiv.trans
{ to_fun := λ h, by exactI is_initial.of_unique _,
  inv_fun := λ h s, ⟨⟨is_initial.to h s⟩, λ a, is_initial.hom_ext h a _⟩,
  left_inv := by tidy,
  right_inv := by tidy }

lemma has_colimit_iff_has_initial_cocone (F : J ⥤ C) : has_colimit F ↔ has_initial (cocone F) :=
⟨λ h, by exactI (cocone.is_colimit_equiv_is_initial _ (colimit.is_colimit F)).has_initial,
 λ h, ⟨⟨by exactI ⟨⊥_ _, (cocone.is_colimit_equiv_is_initial _).symm initial_is_initial⟩⟩⟩⟩

lemma has_colimits_of_shape_iff_is_right_adjoint_const :
  has_colimits_of_shape J C ↔ nonempty (is_right_adjoint (const J : C ⥤ _)) :=
calc has_colimits_of_shape J C
      ↔ ∀ F : J ⥤ C, has_colimit F : ⟨λ h, h.has_colimit, λ h, by exactI has_colimits_of_shape.mk⟩
  ... ↔ ∀ F : J ⥤ C, has_initial (cocone F) : forall_congr has_colimit_iff_has_initial_cocone
  ... ↔ ∀ F : J ⥤ C, has_initial (structured_arrow F (const J)) :
    forall_congr $ λ F, (cocone.equiv_structured_arrow F).has_initial_iff
  ... ↔ nonempty (is_right_adjoint (const J : C ⥤ _)) :
    nonempty_is_right_adjoint_iff_has_initial_structured_arrow.symm

lemma is_colimit.desc_cocone_morphism_eq_is_initial_to {F : J ⥤ C} {c : cocone F}
  (hc : is_colimit c) (s : cocone F) :
  hc.desc_cocone_morphism s =
    is_initial.to (cocone.is_colimit_equiv_is_initial _ hc) _ := rfl

lemma is_initial.to_eq_desc_cocone_morphism {F : J ⥤ C} {c : cocone F}
  (hc : is_initial c) (s : cocone F) :
  is_initial.to hc s = ((cocone.is_colimit_equiv_is_initial _).symm hc).desc_cocone_morphism s :=
by convert (is_colimit.desc_cocone_morphism_eq_is_initial_to _ s).symm

/-- If `G : cocone F ⥤ cocone F'` preserves initial objects, it preserves colimit cocones. -/
def is_colimit.of_preserves_cocone_initial {F : J ⥤ C} {F' : K ⥤ D} (G : cocone F ⥤ cocone F')
  [preserves_colimit (functor.empty.{0} _) G] {c : cocone F} (hc : is_colimit c) :
  is_colimit (G.obj c) :=
(cocone.is_colimit_equiv_is_initial _).symm $
  (cocone.is_colimit_equiv_is_initial _ hc).is_initial_obj _ _

/-- If `G : cocone F ⥤ cocone F'` reflects initial objects, it reflects colimit cocones. -/
def is_colimit.of_reflects_cocone_initial {F : J ⥤ C} {F' : K ⥤ D} (G : cocone F ⥤ cocone F')
  [reflects_colimit (functor.empty.{0} _) G] {c : cocone F} (hc : is_colimit (G.obj c)) :
  is_colimit c :=
(cocone.is_colimit_equiv_is_initial _).symm $
  (cocone.is_colimit_equiv_is_initial _ hc).is_initial_of_obj _ _

end category_theory.limits


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury G. Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.affine_space.affine_map
import Mathlib.algebra.invertible
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4 u_5 l u_6 u_7 u_8 u_9 u_10

namespace Mathlib

/-!
# Affine equivalences

In this file we define `affine_equiv k P₁ P₂` (notation: `P₁ ≃ᵃ[k] P₂`) to be the type of affine
equivalences between `P₁` and `P₂, i.e., equivalences such that both forward and inverse maps are
affine maps.

We define the following equivalences:

* `affine_equiv.refl k P`: the identity map as an `affine_equiv`;

* `e.symm`: the inverse map of an `affine_equiv` as an `affine_equiv`;

* `e.trans e'`: composition of two `affine_equiv`s; note that the order follows `mathlib`'s
  `category_theory` convention (apply `e`, then `e'`), not the convention used in function
  composition and compositions of bundled morphisms.

## Tags

affine space, affine equivalence
-/

/-- An affine equivalence is an equivalence between affine spaces such that both forward
and inverse maps are affine.

We define it using an `equiv` for the map and a `linear_equiv` for the linear part in order
to allow affine equivalences with good definitional equalities. -/
structure affine_equiv (k : Type u_1) (P₁ : Type u_2) (P₂ : Type u_3) {V₁ : Type u_4}
    {V₂ : Type u_5} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂]
    extends P₁ ≃ P₂ where
  linear : linear_equiv k V₁ V₂
  map_vadd' : ∀ (p : P₁) (v : V₁), coe_fn _to_equiv (v +ᵥ p) = coe_fn linear v +ᵥ coe_fn _to_equiv p

protected instance affine_equiv.has_coe_to_fun (k : Type u_1) {V1 : Type u_2} (P1 : Type u_3)
    {V2 : Type u_4} (P2 : Type u_5) [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] : has_coe_to_fun (affine_equiv k P1 P2) :=
  has_coe_to_fun.mk (fun (e : affine_equiv k P1 P2) => P1 → P2)
    fun (e : affine_equiv k P1 P2) => equiv.to_fun (affine_equiv.to_equiv e)

namespace linear_equiv

/-- Interpret a linear equivalence between modules as an affine equivalence. -/
def to_affine_equiv {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_comm_group V₂] [semimodule k V₂] (e : linear_equiv k V₁ V₂) :
    affine_equiv k V₁ V₂ :=
  affine_equiv.mk (to_equiv e) e sorry

@[simp] theorem coe_to_affine_equiv {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_comm_group V₂] [semimodule k V₂]
    (e : linear_equiv k V₁ V₂) : ⇑(to_affine_equiv e) = ⇑e :=
  rfl

end linear_equiv

namespace affine_equiv

/-- Identity map as an `affine_equiv`. -/
def refl (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] : affine_equiv k P₁ P₁ :=
  mk (equiv.refl P₁) (linear_equiv.refl k V₁) sorry

@[simp] theorem coe_refl (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] : ⇑(refl k P₁) = id :=
  rfl

theorem refl_apply (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (x : P₁) : coe_fn (refl k P₁) x = x :=
  rfl

@[simp] theorem to_equiv_refl (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] :
    to_equiv (refl k P₁) = equiv.refl P₁ :=
  rfl

@[simp] theorem linear_refl (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] :
    linear (refl k P₁) = linear_equiv.refl k V₁ :=
  rfl

@[simp] theorem map_vadd {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) (p : P₁)
    (v : V₁) : coe_fn e (v +ᵥ p) = coe_fn (linear e) v +ᵥ coe_fn e p :=
  map_vadd' e p v

@[simp] theorem coe_to_equiv {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    ⇑(to_equiv e) = ⇑e :=
  rfl

/-- Reinterpret an `affine_equiv` as an `affine_map`. -/
def to_affine_map {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7}
    [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂]
    [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) : affine_map k P₁ P₂ :=
  affine_map.mk (⇑e) (↑(linear e)) (map_vadd' e)

@[simp] theorem coe_to_affine_map {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    ⇑(to_affine_map e) = ⇑e :=
  rfl

@[simp] theorem to_affine_map_mk {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (f : P₁ ≃ P₂)
    (f' : linear_equiv k V₁ V₂)
    (h : ∀ (p : P₁) (v : V₁), coe_fn f (v +ᵥ p) = coe_fn f' v +ᵥ coe_fn f p) :
    to_affine_map (mk f f' h) = affine_map.mk (⇑f) (↑f') h :=
  rfl

@[simp] theorem linear_to_affine_map {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    affine_map.linear (to_affine_map e) = ↑(linear e) :=
  rfl

theorem injective_to_affine_map {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] : function.injective to_affine_map :=
  sorry

@[simp] theorem to_affine_map_inj {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] {e : affine_equiv k P₁ P₂}
    {e' : affine_equiv k P₁ P₂} : to_affine_map e = to_affine_map e' ↔ e = e' :=
  function.injective.eq_iff injective_to_affine_map

theorem ext {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂]
    [add_torsor V₂ P₂] {e : affine_equiv k P₁ P₂} {e' : affine_equiv k P₁ P₂}
    (h : ∀ (x : P₁), coe_fn e x = coe_fn e' x) : e = e' :=
  injective_to_affine_map (affine_map.ext h)

theorem injective_coe_fn {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] :
    function.injective fun (e : affine_equiv k P₁ P₂) (x : P₁) => coe_fn e x :=
  sorry

@[simp] theorem coe_fn_inj {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] {e : affine_equiv k P₁ P₂}
    {e' : affine_equiv k P₁ P₂} : ⇑e = ⇑e' ↔ e = e' :=
  function.injective.eq_iff injective_coe_fn

theorem injective_to_equiv {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] : function.injective to_equiv :=
  fun (e e' : affine_equiv k P₁ P₂) (H : to_equiv e = to_equiv e') => ext (iff.mp equiv.ext_iff H)

@[simp] theorem to_equiv_inj {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] {e : affine_equiv k P₁ P₂}
    {e' : affine_equiv k P₁ P₂} : to_equiv e = to_equiv e' ↔ e = e' :=
  function.injective.eq_iff injective_to_equiv

/-- Construct an affine equivalence by verifying the relation between the map and its linear part at
one base point. Namely, this function takes an equivalence `e : P₁ ≃ P₂`, a linear equivalece
`e' : V₁ ≃ₗ[k] V₂`, and a point `p` such that for any other point `p'` we have
`e p' = e' (p' -ᵥ p) +ᵥ e p`. -/
def mk' {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂]
    [add_torsor V₂ P₂] (e : P₁ ≃ P₂) (e' : linear_equiv k V₁ V₂) (p : P₁)
    (h : ∀ (p' : P₁), coe_fn e p' = coe_fn e' (p' -ᵥ p) +ᵥ coe_fn e p) : affine_equiv k P₁ P₂ :=
  mk e e' sorry

@[simp] theorem coe_mk' {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : P₁ ≃ P₂)
    (e' : linear_equiv k V₁ V₂) (p : P₁)
    (h : ∀ (p' : P₁), coe_fn e p' = coe_fn e' (p' -ᵥ p) +ᵥ coe_fn e p) : ⇑(mk' e e' p h) = ⇑e :=
  rfl

@[simp] theorem to_equiv_mk' {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : P₁ ≃ P₂)
    (e' : linear_equiv k V₁ V₂) (p : P₁)
    (h : ∀ (p' : P₁), coe_fn e p' = coe_fn e' (p' -ᵥ p) +ᵥ coe_fn e p) :
    to_equiv (mk' e e' p h) = e :=
  rfl

@[simp] theorem linear_mk' {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : P₁ ≃ P₂)
    (e' : linear_equiv k V₁ V₂) (p : P₁)
    (h : ∀ (p' : P₁), coe_fn e p' = coe_fn e' (p' -ᵥ p) +ᵥ coe_fn e p) :
    linear (mk' e e' p h) = e' :=
  rfl

/-- Inverse of an affine equivalence as an affine equivalence. -/
def symm {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂]
    [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) : affine_equiv k P₂ P₁ :=
  mk (equiv.symm (to_equiv e)) (linear_equiv.symm (linear e)) sorry

@[simp] theorem symm_to_equiv {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    equiv.symm (to_equiv e) = to_equiv (symm e) :=
  rfl

@[simp] theorem symm_linear {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    linear_equiv.symm (linear e) = linear (symm e) :=
  rfl

protected theorem bijective {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    function.bijective ⇑e :=
  equiv.bijective (to_equiv e)

protected theorem surjective {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    function.surjective ⇑e :=
  equiv.surjective (to_equiv e)

protected theorem injective {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    function.injective ⇑e :=
  equiv.injective (to_equiv e)

@[simp] theorem range_eq {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    set.range ⇑e = set.univ :=
  function.surjective.range_eq (affine_equiv.surjective e)

@[simp] theorem apply_symm_apply {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) (p : P₂) :
    coe_fn e (coe_fn (symm e) p) = p :=
  equiv.apply_symm_apply (to_equiv e) p

@[simp] theorem symm_apply_apply {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) (p : P₁) :
    coe_fn (symm e) (coe_fn e p) = p :=
  equiv.symm_apply_apply (to_equiv e) p

theorem apply_eq_iff_eq_symm_apply {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) {p₁ : P₁}
    {p₂ : P₂} : coe_fn e p₁ = p₂ ↔ p₁ = coe_fn (symm e) p₂ :=
  equiv.apply_eq_iff_eq_symm_apply (to_equiv e)

@[simp] theorem apply_eq_iff_eq {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) {p₁ : P₁}
    {p₂ : P₁} : coe_fn e p₁ = coe_fn e p₂ ↔ p₁ = p₂ :=
  equiv.apply_eq_iff_eq (to_equiv e)

@[simp] theorem symm_refl {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] : symm (refl k P₁) = refl k P₁ :=
  rfl

/-- Composition of two `affine_equiv`alences, applied left to right. -/
def trans {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {V₃ : Type u_4} {P₁ : Type u_6}
    {P₂ : Type u_7} {P₃ : Type u_8} [ring k] [add_comm_group V₁] [semimodule k V₁]
    [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] [add_comm_group V₃]
    [semimodule k V₃] [add_torsor V₃ P₃] (e : affine_equiv k P₁ P₂) (e' : affine_equiv k P₂ P₃) :
    affine_equiv k P₁ P₃ :=
  mk (equiv.trans (to_equiv e) (to_equiv e')) (linear_equiv.trans (linear e) (linear e')) sorry

@[simp] theorem coe_trans {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {V₃ : Type u_4}
    {P₁ : Type u_6} {P₂ : Type u_7} {P₃ : Type u_8} [ring k] [add_comm_group V₁] [semimodule k V₁]
    [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] [add_comm_group V₃]
    [semimodule k V₃] [add_torsor V₃ P₃] (e : affine_equiv k P₁ P₂) (e' : affine_equiv k P₂ P₃) :
    ⇑(trans e e') = ⇑e' ∘ ⇑e :=
  rfl

theorem trans_apply {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {V₃ : Type u_4} {P₁ : Type u_6}
    {P₂ : Type u_7} {P₃ : Type u_8} [ring k] [add_comm_group V₁] [semimodule k V₁]
    [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] [add_comm_group V₃]
    [semimodule k V₃] [add_torsor V₃ P₃] (e : affine_equiv k P₁ P₂) (e' : affine_equiv k P₂ P₃)
    (p : P₁) : coe_fn (trans e e') p = coe_fn e' (coe_fn e p) :=
  rfl

theorem trans_assoc {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {V₃ : Type u_4} {V₄ : Type u_5}
    {P₁ : Type u_6} {P₂ : Type u_7} {P₃ : Type u_8} {P₄ : Type u_9} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂]
    [add_comm_group V₃] [semimodule k V₃] [add_torsor V₃ P₃] [add_comm_group V₄] [semimodule k V₄]
    [add_torsor V₄ P₄] (e₁ : affine_equiv k P₁ P₂) (e₂ : affine_equiv k P₂ P₃)
    (e₃ : affine_equiv k P₃ P₄) : trans (trans e₁ e₂) e₃ = trans e₁ (trans e₂ e₃) :=
  ext fun (_x : P₁) => rfl

@[simp] theorem trans_refl {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    trans e (refl k P₂) = e :=
  ext fun (_x : P₁) => rfl

@[simp] theorem refl_trans {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    trans (refl k P₁) e = e :=
  ext fun (_x : P₁) => rfl

@[simp] theorem trans_symm {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    trans e (symm e) = refl k P₁ :=
  ext (symm_apply_apply e)

@[simp] theorem symm_trans {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    trans (symm e) e = refl k P₂ :=
  ext (apply_symm_apply e)

@[simp] theorem apply_line_map {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) (a : P₁)
    (b : P₁) (c : k) :
    coe_fn e (coe_fn (affine_map.line_map a b) c) =
        coe_fn (affine_map.line_map (coe_fn e a) (coe_fn e b)) c :=
  affine_map.apply_line_map (to_affine_map e) a b c

protected instance group {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] : group (affine_equiv k P₁ P₁) :=
  group.mk (fun (e e' : affine_equiv k P₁ P₁) => trans e' e) sorry (refl k P₁) trans_refl refl_trans
    symm
    (div_inv_monoid.div._default (fun (e e' : affine_equiv k P₁ P₁) => trans e' e) sorry (refl k P₁)
      trans_refl refl_trans symm)
    trans_symm

theorem one_def {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] : 1 = refl k P₁ :=
  rfl

@[simp] theorem coe_one {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] : ⇑1 = id :=
  rfl

theorem mul_def {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (e : affine_equiv k P₁ P₁) (e' : affine_equiv k P₁ P₁) :
    e * e' = trans e' e :=
  rfl

@[simp] theorem coe_mul {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (e : affine_equiv k P₁ P₁) (e' : affine_equiv k P₁ P₁) :
    ⇑(e * e') = ⇑e ∘ ⇑e' :=
  rfl

theorem inv_def {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (e : affine_equiv k P₁ P₁) : e⁻¹ = symm e :=
  rfl

/-- The map `v ↦ v +ᵥ b` as an affine equivalence between a module `V` and an affine space `P` with
tangent space `V`. -/
def vadd_const (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (b : P₁) : affine_equiv k V₁ P₁ :=
  mk (equiv.vadd_const b) (linear_equiv.refl k V₁) sorry

@[simp] theorem linear_vadd_const (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (b : P₁) :
    linear (vadd_const k b) = linear_equiv.refl k V₁ :=
  rfl

@[simp] theorem vadd_const_apply (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (b : P₁) (v : V₁) :
    coe_fn (vadd_const k b) v = v +ᵥ b :=
  rfl

@[simp] theorem vadd_const_symm_apply (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (b : P₁) (p : P₁) :
    coe_fn (symm (vadd_const k b)) p = p -ᵥ b :=
  rfl

/-- `p' ↦ p -ᵥ p'` as an equivalence. -/
def const_vsub (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (p : P₁) : affine_equiv k P₁ V₁ :=
  mk (equiv.const_vsub p) (linear_equiv.neg k) sorry

@[simp] theorem coe_const_vsub (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (p : P₁) :
    ⇑(const_vsub k p) = has_vsub.vsub p :=
  rfl

@[simp] theorem coe_const_vsub_symm (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (p : P₁) :
    ⇑(symm (const_vsub k p)) = fun (v : V₁) => -v +ᵥ p :=
  rfl

/-- The map `p ↦ v +ᵥ p` as an affine automorphism of an affine space. -/
def const_vadd (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (v : V₁) : affine_equiv k P₁ P₁ :=
  mk (equiv.const_vadd P₁ v) (linear_equiv.refl k V₁) sorry

@[simp] theorem linear_const_vadd (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (v : V₁) :
    linear (const_vadd k P₁ v) = linear_equiv.refl k V₁ :=
  rfl

@[simp] theorem const_vadd_apply (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (v : V₁) (p : P₁) :
    coe_fn (const_vadd k P₁ v) p = v +ᵥ p :=
  rfl

@[simp] theorem const_vadd_symm_apply (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (v : V₁) (p : P₁) :
    coe_fn (symm (const_vadd k P₁ v)) p = -v +ᵥ p :=
  rfl

/-- Point reflection in `x` as a permutation. -/
def point_reflection (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (x : P₁) : affine_equiv k P₁ P₁ :=
  trans (const_vsub k x) (vadd_const k x)

theorem point_reflection_apply (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (x : P₁) (y : P₁) :
    coe_fn (point_reflection k x) y = x -ᵥ y +ᵥ x :=
  rfl

@[simp] theorem point_reflection_symm (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (x : P₁) :
    symm (point_reflection k x) = point_reflection k x :=
  injective_to_equiv (equiv.point_reflection_symm x)

@[simp] theorem to_equiv_point_reflection (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (x : P₁) :
    to_equiv (point_reflection k x) = equiv.point_reflection x :=
  rfl

@[simp] theorem point_reflection_self (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (x : P₁) :
    coe_fn (point_reflection k x) x = x :=
  vsub_vadd x x

theorem point_reflection_involutive (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (x : P₁) :
    function.involutive ⇑(point_reflection k x) :=
  equiv.point_reflection_involutive x

/-- `x` is the only fixed point of `point_reflection x`. This lemma requires
`x + x = y + y ↔ x = y`. There is no typeclass to use here, so we add it as an explicit argument. -/
theorem point_reflection_fixed_iff_of_injective_bit0 (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6}
    [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] {x : P₁} {y : P₁}
    (h : function.injective bit0) : coe_fn (point_reflection k x) y = y ↔ y = x :=
  equiv.point_reflection_fixed_iff_of_injective_bit0 h

theorem injective_point_reflection_left_of_injective_bit0 (k : Type u_1) {V₁ : Type u_2}
    {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    (h : function.injective bit0) (y : P₁) :
    function.injective fun (x : P₁) => coe_fn (point_reflection k x) y :=
  equiv.injective_point_reflection_left_of_injective_bit0 h y

theorem injective_point_reflection_left_of_module (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6}
    [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [invertible (bit0 1)]
    (y : P₁) : function.injective fun (x : P₁) => coe_fn (point_reflection k x) y :=
  sorry

theorem point_reflection_fixed_iff_of_module (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [invertible (bit0 1)] {x : P₁}
    {y : P₁} : coe_fn (point_reflection k x) y = y ↔ y = x :=
  iff.trans
    (function.injective.eq_iff' (injective_point_reflection_left_of_module k y)
      (point_reflection_self k y))
    eq_comm

end affine_equiv

namespace affine_map

theorem line_map_vadd {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (v : V₁) (v' : V₁) (p : P₁) (c : k) :
    coe_fn (line_map v v') c +ᵥ p = coe_fn (line_map (v +ᵥ p) (v' +ᵥ p)) c :=
  affine_equiv.apply_line_map (affine_equiv.vadd_const k p) v v' c

theorem line_map_vsub {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (p₁ : P₁) (p₂ : P₁) (p₃ : P₁) (c : k) :
    coe_fn (line_map p₁ p₂) c -ᵥ p₃ = coe_fn (line_map (p₁ -ᵥ p₃) (p₂ -ᵥ p₃)) c :=
  affine_equiv.apply_line_map (affine_equiv.symm (affine_equiv.vadd_const k p₃)) p₁ p₂ c

theorem vsub_line_map {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (p₁ : P₁) (p₂ : P₁) (p₃ : P₁) (c : k) :
    p₁ -ᵥ coe_fn (line_map p₂ p₃) c = coe_fn (line_map (p₁ -ᵥ p₂) (p₁ -ᵥ p₃)) c :=
  affine_equiv.apply_line_map (affine_equiv.const_vsub k p₁) p₂ p₃ c

theorem vadd_line_map {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (v : V₁) (p₁ : P₁) (p₂ : P₁) (c : k) :
    v +ᵥ coe_fn (line_map p₁ p₂) c = coe_fn (line_map (v +ᵥ p₁) (v +ᵥ p₂)) c :=
  affine_equiv.apply_line_map (affine_equiv.const_vadd k P₁ v) p₁ p₂ c

theorem homothety_neg_one_apply {V₁ : Type u_2} {P₁ : Type u_6} [add_comm_group V₁]
    [add_torsor V₁ P₁] {R' : Type u_10} [comm_ring R'] [semimodule R' V₁] (c : P₁) (p : P₁) :
    coe_fn (homothety c (-1)) p = coe_fn (affine_equiv.point_reflection R' c) p :=
  sorry

end Mathlib


syntax "foo" : tactic

macro_rules | `(tactic| foo) => `(tactic| assumption)
macro_rules | `(tactic| foo) => `(tactic| apply Nat.pred_lt; assumption)
macro_rules | `(tactic| foo) => `(tactic| contradiction)

example (i : Nat) (h : i - 1 < i) : i - 1 < i := by
  foo

example (i : Nat) (h : i ≠ 0) : i - 1 < i := by
  foo

example (i : Nat) (h : False) : i - 1 < i := by
  foo


/-
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.comma
import category_theory.punit
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 : D`.

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

universes v₁ v₂ u₁ u₂ -- morphism levels before object levels. See note [category_theory universes].
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

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

/-- The obvious projection functor from structured arrows. -/
def proj : structured_arrow S T ⥤ C := comma.snd _ _

/-- 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 = punit.star := 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

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, }, }

/--
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 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, }

open category_theory.limits

/-- 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' := begin
    rintros c m -,
    ext,
    apply T.map_injective,
    have := m.w.symm,
    dsimp at this,
    simpa using this,
  end }

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

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

/-- The obviuous projection functor from costructured arrows. -/
def proj : costructured_arrow S T ⥤ C := comma.fst _ _

/-- 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 = punit.star := rfl
@[simp] lemma mk_hom_eq_self (f : S.obj Y ⟶ T) : (mk f).hom = f := rfl

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 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 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, }

open category_theory.limits

/-- 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,
    have := m.w,
    dsimp at this,
    simpa using this,
  end }

end costructured_arrow

end category_theory


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

This file defines an alias command, which can be used to create copies
of a theorem or definition with different names.

Syntax:

/ -- doc string - /
alias my_theorem ← alias1 alias2 ...

This produces defs or theorems of the form:

/ -- doc string - /
@[alias] theorem alias1 : <type of my_theorem> := my_theorem

/ -- doc string - /
@[alias] theorem alias2 : <type of my_theorem> := my_theorem

Iff alias syntax:

alias A_iff_B ↔ B_of_A A_of_B
alias A_iff_B ↔ ..

This gets an existing biconditional theorem A_iff_B and produces
the one-way implications B_of_A and A_of_B (with no change in
implicit arguments). A blank _ can be used to avoid generating one direction.
The .. notation attempts to generate the 'of'-names automatically when the
input theorem has the form A_iff_B or A_iff_B_left etc.

-/
import data.buffer.parser

open lean.parser tactic interactive parser

namespace tactic.alias

@[user_attribute] meta def alias_attr : user_attribute :=
{ name := `alias, descr := "This definition is an alias of another." }

meta def alias_direct (d : declaration) (doc : string) (al : name) : tactic unit :=
do updateex_env $ λ env,
  env.add (match d.to_definition with
  | declaration.defn n ls t _ _ _ :=
    declaration.defn al ls t (expr.const n (level.param <$> ls))
      reducibility_hints.abbrev tt
  | declaration.thm n ls t _ :=
    declaration.thm al ls t $ task.pure $ expr.const n (level.param <$> ls)
  | _ := undefined
  end),
  alias_attr.set al () tt,
  add_doc_string al doc

meta def mk_iff_mp_app (iffmp : name) : expr → (nat → expr) → tactic expr
| (expr.pi n bi e t) f := expr.lam n bi e <$> mk_iff_mp_app t (λ n, f (n+1) (expr.var n))
| `(%%a ↔ %%b) f := pure $ @expr.const tt iffmp [] a b (f 0)
| _ f := fail "Target theorem must have the form `Π x y z, a ↔ b`"

meta def alias_iff (d : declaration) (doc : string) (al : name) (iffmp : name) : tactic unit :=
(if al = `_ then skip else get_decl al >> skip) <|> do
  let ls := d.univ_params,
  let t := d.type,
  v ← mk_iff_mp_app iffmp t (λ_, expr.const d.to_name (level.param <$> ls)),
  t' ← infer_type v,
  updateex_env $ λ env, env.add (declaration.thm al ls t' $ task.pure v),
  alias_attr.set al () tt,
  add_doc_string al doc

meta def make_left_right : name → tactic (name × name)
| (name.mk_string s p) := do
  let buf : char_buffer := s.to_char_buffer,
  sum.inr parts ← pure $ run (sep_by1 (ch '_') (many_char (sat (≠ '_')))) s.to_char_buffer,
  (left, _::right) ← pure $ parts.span (≠ "iff"),
  let pfx (a b : string) := a.to_list.is_prefix_of b.to_list,
  (suffix', right') ← pure $ right.reverse.span (λ s, pfx "left" s ∨ pfx "right" s),
  let right := right'.reverse,
  let suffix := suffix'.reverse,
  pure (p <.> "_".intercalate (right ++ "of" :: left ++ suffix),
        p <.> "_".intercalate (left ++ "of" :: right ++ suffix))
| _ := failed

@[user_command] meta def alias_cmd (meta_info : decl_meta_info)
  (_ : parse $ tk "alias") : lean.parser unit :=
do old ← ident,
  d ← (do old ← resolve_constant old, get_decl old) <|>
    fail ("declaration " ++ to_string old ++ " not found"),
  let doc := λ al : name, meta_info.doc_string.get_or_else $
    "**Alias** of `" ++ to_string old ++ "`.",
  do {
    tk "←" <|> tk "<-",
    aliases ← many ident,
    ↑(aliases.mmap' $ λ al, alias_direct d (doc al) al) } <|>
  do {
    tk "↔" <|> tk "<->",
    (left, right) ←
      mcond ((tk "." *> tk "." >> pure tt) <|> pure ff)
        (make_left_right old <|> fail "invalid name for automatic name generation")
        (prod.mk <$> types.ident_ <*> types.ident_),
    alias_iff d (doc left) left `iff.mp,
    alias_iff d (doc right) right `iff.mpr }

meta def get_lambda_body : expr → expr
| (expr.lam _ _ _ b) := get_lambda_body b
| a                  := a

meta def get_alias_target (n : name) : tactic (option name) :=
do attr ← try_core (has_attribute `alias n),
  option.cases_on attr (pure none) $ λ_, do
  d ← get_decl n,
  let (head, args) := (get_lambda_body d.value).get_app_fn_args,
  let head := if head.is_constant_of `iff.mp ∨ head.is_constant_of `iff.mpr then
    expr.get_app_fn (head.ith_arg 2)
  else head,
  guardb $ head.is_constant,
  pure $ head.const_name

end tactic.alias


/-
Copyright (c) 2017 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import algebra.group.defs
import control.functor

/-!
# `applicative` instances

This file provides `applicative` instances for concrete functors:
* `id`
* `functor.comp`
* `functor.const`
* `functor.add_const`
-/

universes u v w

section lemmas

open function

variables {F : Type u → Type v}
variables [applicative F] [is_lawful_applicative F]
variables {α β γ σ : Type u}

lemma applicative.map_seq_map (f : α → β → γ) (g : σ → β) (x : F α) (y : F σ) :
  (f <$> x) <*> (g <$> y) = (flip (∘) g ∘ f) <$> x <*> y :=
by simp [flip] with functor_norm

lemma applicative.pure_seq_eq_map' (f : α → β) : (<*>) (pure f : F (α → β)) = (<$>) f :=
by ext; simp with functor_norm

theorem applicative.ext {F} : ∀ {A1 : applicative F} {A2 : applicative F}
  [@is_lawful_applicative F A1] [@is_lawful_applicative F A2]
  (H1 : ∀ {α : Type u} (x : α),
    @has_pure.pure _ A1.to_has_pure _ x = @has_pure.pure _ A2.to_has_pure _ x)
  (H2 : ∀ {α β : Type u} (f : F (α → β)) (x : F α),
    @has_seq.seq _ A1.to_has_seq _ _ f x = @has_seq.seq _ A2.to_has_seq _ _ f x),
  A1 = A2
| {to_functor := F1, seq := s1, pure := p1, seq_left := sl1, seq_right := sr1}
  {to_functor := F2, seq := s2, pure := p2, seq_left := sl2, seq_right := sr2} L1 L2 H1 H2 :=
begin
  have : @p1 = @p2, {funext α x, apply H1}, subst this,
  have : @s1 = @s2, {funext α β f x, apply H2}, subst this,
  cases L1, cases L2,
  have : F1 = F2,
  { resetI, apply functor.ext, intros,
    exact (L1_pure_seq_eq_map _ _).symm.trans (L2_pure_seq_eq_map _ _) },
  subst this,
  congr; funext α β x y,
  { exact (L1_seq_left_eq _ _).trans (L2_seq_left_eq _ _).symm },
  { exact (L1_seq_right_eq _ _).trans (L2_seq_right_eq _ _).symm }
end

end lemmas

instance : is_comm_applicative id :=
by refine { .. }; intros; refl

namespace functor
namespace comp

open function (hiding comp)
open functor

variables {F : Type u → Type w} {G : Type v → Type u}

variables [applicative F] [applicative G]

variables [is_lawful_applicative F] [is_lawful_applicative G]
variables {α β γ : Type v}

lemma map_pure (f : α → β) (x : α) : (f <$> pure x : comp F G β) = pure (f x) :=
comp.ext $ by simp

lemma seq_pure (f : comp F G (α → β)) (x : α) :
  f <*> pure x = (λ g : α → β, g x) <$> f :=
comp.ext $ by simp [(∘)] with functor_norm

lemma pure_seq_eq_map (f : α → β) (x : comp F G α) :
  pure f <*> x = f <$> x :=
comp.ext $ by simp [applicative.pure_seq_eq_map'] with functor_norm

instance : is_lawful_applicative (comp F G) :=
{ pure_seq_eq_map := @comp.pure_seq_eq_map F G _ _ _ _,
  map_pure := @comp.map_pure F G _ _ _ _,
  seq_pure := @comp.seq_pure F G _ _ _ _,
  seq_assoc := @comp.seq_assoc F G _ _ _ _ }

theorem applicative_id_comp {F} [AF : applicative F] [LF : is_lawful_applicative F] :
  @comp.applicative id F _ _ = AF :=
@applicative.ext F _ _ (@comp.is_lawful_applicative id F _ _ _ _) _
  (λ α x, rfl) (λ α β f x, rfl)

theorem applicative_comp_id {F} [AF : applicative F] [LF : is_lawful_applicative F] :
  @comp.applicative F id _ _ = AF :=
@applicative.ext F _ _ (@comp.is_lawful_applicative F id _ _ _ _) _
  (λ α x, rfl) (λ α β f x, show id <$> f <*> x = f <*> x, by rw id_map)

open is_comm_applicative

instance {f : Type u → Type w} {g : Type v → Type u}
  [applicative f] [applicative g]
  [is_comm_applicative f] [is_comm_applicative g] :
  is_comm_applicative (comp f g) :=
by { refine { .. @comp.is_lawful_applicative f g _ _ _ _, .. },
     intros, casesm* comp _ _ _, simp! [map,has_seq.seq] with functor_norm,
     rw [commutative_map],
     simp [comp.mk,flip,(∘)] with functor_norm,
     congr, funext, rw [commutative_map], congr }

end comp
end functor

open functor

@[functor_norm]
lemma comp.seq_mk {α β : Type w}
  {f : Type u → Type v} {g : Type w → Type u}
  [applicative f] [applicative g]
  (h : f (g (α → β))) (x : f (g α)) :
  comp.mk h <*> comp.mk x = comp.mk (has_seq.seq <$> h <*> x) := rfl

instance {α} [has_one α] [has_mul α] : applicative (const α) :=
{ pure := λ β x, (1 : α),
  seq := λ β γ f x, (f * x : α) }

instance {α} [monoid α] : is_lawful_applicative (const α) :=
by refine { .. }; intros; simp [mul_assoc, (<$>), (<*>), pure]

instance {α} [has_zero α] [has_add α] : applicative (add_const α) :=
{ pure := λ β x, (0 : α),
  seq := λ β γ f x, (f + x : α) }

instance {α} [add_monoid α] : is_lawful_applicative (add_const α) :=
by refine { .. }; intros; simp [add_assoc, (<$>), (<*>), pure]