/-
Copyright (c) 2020 Bhavik Mehta, Edward Ayers, Thomas Read. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Edward Ayers, Thomas Read
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.limits.shapes.finite_products
import Mathlib.category_theory.limits.preserves.shapes.binary_products
import Mathlib.category_theory.closed.monoidal
import Mathlib.category_theory.monoidal.of_has_finite_products
import Mathlib.category_theory.adjunction.default
import Mathlib.category_theory.adjunction.mates
import Mathlib.category_theory.epi_mono
import Mathlib.PostPort

universes v u u₂

namespace Mathlib

/-!
# Cartesian closed categories

Given a category with finite products, the cartesian monoidal structure is provided by the local
instance `monoidal_of_has_finite_products`.

We define exponentiable objects to be closed objects with respect to this monoidal structure,
i.e. `(X × -)` is a left adjoint.

We say a category is cartesian closed if every object is exponentiable
(equivalently, that the category equipped with the cartesian monoidal structure is closed monoidal).

Show that exponential forms a difunctor and define the exponential comparison morphisms.

## TODO
Some of the results here are true more generally for closed objects and
for closed monoidal categories, and these could be generalised.
-/

namespace category_theory

/--
An object `X` is *exponentiable* if `(X × -)` is a left adjoint.
We define this as being `closed` in the cartesian monoidal structure.
-/
def exponentiable {C : Type u} [category C] [limits.has_finite_products C] (X : C) := closed X

/--
If `X` and `Y` are exponentiable then `X ⨯ Y` is.
This isn't an instance because it's not usually how we want to construct exponentials, we'll usually
prove all objects are exponential uniformly.
-/
def binary_product_exponentiable {C : Type u} [category C] [limits.has_finite_products C] {X : C}
    {Y : C} (hX : exponentiable X) (hY : exponentiable Y) : exponentiable (X ⨯ Y) :=
  closed.mk
    (adjunction.left_adjoint_of_nat_iso (iso.symm (monoidal_category.tensor_left_tensor X Y)))

/--
The terminal object is always exponentiable.
This isn't an instance because most of the time we'll prove cartesian closed for all objects
at once, rather than just for this one.
-/
def terminal_exponentiable {C : Type u} [category C] [limits.has_finite_products C] :
    exponentiable (⊤_C) :=
  unit_closed

/--
A category `C` is cartesian closed if it has finite products and every object is exponentiable.
We define this as `monoidal_closed` with respect to the cartesian monoidal structure.
-/
def cartesian_closed (C : Type u) [category C] [limits.has_finite_products C] := monoidal_closed C

/-- This is (-)^A. -/
def exp {C : Type u} [category C] (A : C) [limits.has_finite_products C] [exponentiable A] :
    C ⥤ C :=
  is_left_adjoint.right (monoidal_category.tensor_left A)

/-- The adjunction between A ⨯ - and (-)^A. -/
def exp.adjunction {C : Type u} [category C] (A : C) [limits.has_finite_products C]
    [exponentiable A] : functor.obj limits.prod.functor A ⊣ exp A :=
  is_left_adjoint.adj

/-- The evaluation natural transformation. -/
def ev {C : Type u} [category C] (A : C) [limits.has_finite_products C] [exponentiable A] :
    exp A ⋙ functor.obj limits.prod.functor A ⟶ 𝟭 :=
  adjunction.counit is_left_adjoint.adj

/-- The coevaluation natural transformation. -/
def coev {C : Type u} [category C] (A : C) [limits.has_finite_products C] [exponentiable A] :
    𝟭 ⟶ functor.obj limits.prod.functor A ⋙ exp A :=
  adjunction.unit is_left_adjoint.adj

@[simp] theorem exp_adjunction_counit {C : Type u} [category C] (A : C)
    [limits.has_finite_products C] [exponentiable A] :
    adjunction.counit (exp.adjunction A) = ev A :=
  rfl

@[simp] theorem exp_adjunction_unit {C : Type u} [category C] (A : C) [limits.has_finite_products C]
    [exponentiable A] : adjunction.unit (exp.adjunction A) = coev A :=
  rfl

@[simp] theorem ev_naturality {C : Type u} [category C] (A : C) [limits.has_finite_products C]
    [exponentiable A] {X : C} {Y : C} (f : X ⟶ Y) :
    limits.prod.map 𝟙 (functor.map (exp A) f) ≫ nat_trans.app (ev A) Y =
        nat_trans.app (ev A) X ≫ f :=
  nat_trans.naturality (ev A) f

@[simp] theorem coev_naturality_assoc {C : Type u} [category C] (A : C)
    [limits.has_finite_products C] [exponentiable A] {X : C} {Y : C} (f : X ⟶ Y) {X' : C}
    (f' : functor.obj (functor.obj limits.prod.functor A ⋙ exp A) Y ⟶ X') :
    f ≫ nat_trans.app (coev A) Y ≫ f' =
        nat_trans.app (coev A) X ≫ functor.map (exp A) (limits.prod.map 𝟙 f) ≫ f' :=
  sorry

@[simp] theorem ev_coev {C : Type u} [category C] (A : C) (B : C) [limits.has_finite_products C]
    [exponentiable A] :
    limits.prod.map 𝟙 (nat_trans.app (coev A) B) ≫ nat_trans.app (ev A) (A ⨯ B) = 𝟙 :=
  adjunction.left_triangle_components (exp.adjunction A)

@[simp] theorem coev_ev {C : Type u} [category C] (A : C) (B : C) [limits.has_finite_products C]
    [exponentiable A] :
    nat_trans.app (coev A) (functor.obj (exp A) B) ≫ functor.map (exp A) (nat_trans.app (ev A) B) =
        𝟙 :=
  adjunction.right_triangle_components (exp.adjunction A)

protected instance obj.limits.preserves_colimits {C : Type u} [category C] (A : C)
    [limits.has_finite_products C] [exponentiable A] :
    limits.preserves_colimits (functor.obj limits.prod.functor A) :=
  adjunction.left_adjoint_preserves_colimits (exp.adjunction A)

-- Wrap these in a namespace so we don't clash with the core versions.

namespace cartesian_closed

/-- Currying in a cartesian closed category. -/
def curry {C : Type u} [category C] {A : C} {X : C} {Y : C} [limits.has_finite_products C]
    [exponentiable A] : (A ⨯ Y ⟶ X) → (Y ⟶ functor.obj (exp A) X) :=
  equiv.to_fun (adjunction.hom_equiv is_left_adjoint.adj Y X)

/-- Uncurrying in a cartesian closed category. -/
def uncurry {C : Type u} [category C] {A : C} {X : C} {Y : C} [limits.has_finite_products C]
    [exponentiable A] : (Y ⟶ functor.obj (exp A) X) → (A ⨯ Y ⟶ X) :=
  equiv.inv_fun (adjunction.hom_equiv is_left_adjoint.adj Y X)

end cartesian_closed

theorem curry_natural_left_assoc {C : Type u} [category C] {A : C} {X : C} {X' : C} {Y : C}
    [limits.has_finite_products C] [exponentiable A] (f : X ⟶ X') (g : A ⨯ X' ⟶ Y) :
    ∀ {X'_1 : C} (f' : functor.obj (exp A) Y ⟶ X'_1),
        cartesian_closed.curry (limits.prod.map 𝟙 f ≫ g) ≫ f' = f ≫ cartesian_closed.curry g ≫ f' :=
  sorry

theorem curry_natural_right_assoc {C : Type u} [category C] {A : C} {X : C} {Y : C} {Y' : C}
    [limits.has_finite_products C] [exponentiable A] (f : A ⨯ X ⟶ Y) (g : Y ⟶ Y') {X' : C}
    (f' : functor.obj (exp A) Y' ⟶ X') :
    cartesian_closed.curry (f ≫ g) ≫ f' = cartesian_closed.curry f ≫ functor.map (exp A) g ≫ f' :=
  sorry

theorem uncurry_natural_right {C : Type u} [category C] {A : C} {X : C} {Y : C} {Y' : C}
    [limits.has_finite_products C] [exponentiable A] (f : X ⟶ functor.obj (exp A) Y) (g : Y ⟶ Y') :
    cartesian_closed.uncurry (f ≫ functor.map (exp A) g) = cartesian_closed.uncurry f ≫ g :=
  adjunction.hom_equiv_naturality_right_symm is_left_adjoint.adj f g

theorem uncurry_natural_left {C : Type u} [category C] {A : C} {X : C} {X' : C} {Y : C}
    [limits.has_finite_products C] [exponentiable A] (f : X ⟶ X') (g : X' ⟶ functor.obj (exp A) Y) :
    cartesian_closed.uncurry (f ≫ g) = limits.prod.map 𝟙 f ≫ cartesian_closed.uncurry g :=
  adjunction.hom_equiv_naturality_left_symm is_left_adjoint.adj f g

@[simp] theorem uncurry_curry {C : Type u} [category C] {A : C} {X : C} {Y : C}
    [limits.has_finite_products C] [exponentiable A] (f : A ⨯ X ⟶ Y) :
    cartesian_closed.uncurry (cartesian_closed.curry f) = f :=
  equiv.left_inv (adjunction.hom_equiv is_left_adjoint.adj X Y) f

@[simp] theorem curry_uncurry {C : Type u} [category C] {A : C} {X : C} {Y : C}
    [limits.has_finite_products C] [exponentiable A] (f : X ⟶ functor.obj (exp A) Y) :
    cartesian_closed.curry (cartesian_closed.uncurry f) = f :=
  equiv.right_inv (adjunction.hom_equiv is_left_adjoint.adj X Y) f

theorem curry_eq_iff {C : Type u} [category C] {A : C} {X : C} {Y : C}
    [limits.has_finite_products C] [exponentiable A] (f : A ⨯ Y ⟶ X)
    (g : Y ⟶ functor.obj (exp A) X) :
    cartesian_closed.curry f = g ↔ f = cartesian_closed.uncurry g :=
  adjunction.hom_equiv_apply_eq is_left_adjoint.adj f g

theorem eq_curry_iff {C : Type u} [category C] {A : C} {X : C} {Y : C}
    [limits.has_finite_products C] [exponentiable A] (f : A ⨯ Y ⟶ X)
    (g : Y ⟶ functor.obj (exp A) X) :
    g = cartesian_closed.curry f ↔ cartesian_closed.uncurry g = f :=
  adjunction.eq_hom_equiv_apply is_left_adjoint.adj f g

-- I don't think these two should be simp.

theorem uncurry_eq {C : Type u} [category C] {A : C} {X : C} {Y : C} [limits.has_finite_products C]
    [exponentiable A] (g : Y ⟶ functor.obj (exp A) X) :
    cartesian_closed.uncurry g = limits.prod.map 𝟙 g ≫ nat_trans.app (ev A) X :=
  adjunction.hom_equiv_counit is_left_adjoint.adj

theorem curry_eq {C : Type u} [category C] {A : C} {X : C} {Y : C} [limits.has_finite_products C]
    [exponentiable A] (g : A ⨯ Y ⟶ X) :
    cartesian_closed.curry g = nat_trans.app (coev A) Y ≫ functor.map (exp A) g :=
  adjunction.hom_equiv_unit is_left_adjoint.adj

theorem uncurry_id_eq_ev {C : Type u} [category C] [limits.has_finite_products C] (A : C) (X : C)
    [exponentiable A] : cartesian_closed.uncurry 𝟙 = nat_trans.app (ev A) X :=
  sorry

theorem curry_id_eq_coev {C : Type u} [category C] [limits.has_finite_products C] (A : C) (X : C)
    [exponentiable A] : cartesian_closed.curry 𝟙 = nat_trans.app (coev A) X :=
  sorry

theorem curry_injective {C : Type u} [category C] {A : C} {X : C} {Y : C}
    [limits.has_finite_products C] [exponentiable A] : function.injective cartesian_closed.curry :=
  equiv.injective (adjunction.hom_equiv is_left_adjoint.adj Y X)

theorem uncurry_injective {C : Type u} [category C] {A : C} {X : C} {Y : C}
    [limits.has_finite_products C] [exponentiable A] :
    function.injective cartesian_closed.uncurry :=
  equiv.injective (equiv.symm (adjunction.hom_equiv is_left_adjoint.adj Y X))

/--
Show that the exponential of the terminal object is isomorphic to itself, i.e. `X^1 ≅ X`.

The typeclass argument is explicit: any instance can be used.
-/
def exp_terminal_iso_self {C : Type u} [category C] {X : C} [limits.has_finite_products C]
    [exponentiable (⊤_C)] : functor.obj (exp (⊤_C)) X ≅ X :=
  yoneda.ext (functor.obj (exp (⊤_C)) X) X
    (fun (Y : C) (f : Y ⟶ functor.obj (exp (⊤_C)) X) =>
      iso.inv (limits.prod.left_unitor Y) ≫ cartesian_closed.uncurry f)
    (fun (Y : C) (f : Y ⟶ X) => cartesian_closed.curry (iso.hom (limits.prod.left_unitor Y) ≫ f))
    sorry sorry sorry

/-- The internal element which points at the given morphism. -/
def internalize_hom {C : Type u} [category C] {A : C} {Y : C} [limits.has_finite_products C]
    [exponentiable A] (f : A ⟶ Y) : ⊤_C ⟶ functor.obj (exp A) Y :=
  cartesian_closed.curry (limits.prod.fst ≫ f)

/-- Pre-compose an internal hom with an external hom. -/
def pre {C : Type u} [category C] {A : C} {B : C} [limits.has_finite_products C] [exponentiable A]
    (f : B ⟶ A) [exponentiable B] : exp A ⟶ exp B :=
  coe_fn (transfer_nat_trans_self (exp.adjunction A) (exp.adjunction B))
    (functor.map limits.prod.functor f)

theorem prod_map_pre_app_comp_ev {C : Type u} [category C] {A : C} {B : C}
    [limits.has_finite_products C] [exponentiable A] (f : B ⟶ A) [exponentiable B] (X : C) :
    limits.prod.map 𝟙 (nat_trans.app (pre f) X) ≫ nat_trans.app (ev B) X =
        limits.prod.map f 𝟙 ≫ nat_trans.app (ev A) X :=
  transfer_nat_trans_self_counit (exp.adjunction A) (exp.adjunction B)
    (functor.map limits.prod.functor f) X

theorem uncurry_pre {C : Type u} [category C] {A : C} {B : C} [limits.has_finite_products C]
    [exponentiable A] (f : B ⟶ A) [exponentiable B] (X : C) :
    cartesian_closed.uncurry (nat_trans.app (pre f) X) =
        limits.prod.map f 𝟙


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

/-!
# fintype instances for sigma types

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

open function
open_locale nat

universes u v

variables {α β γ : Type*}

open finset function

instance {α : Type*} (β : α → Type*)
  [fintype α] [∀ a, fintype (β a)] : fintype (sigma β) :=
⟨univ.sigma (λ _, univ), λ ⟨a, b⟩, by simp⟩

@[simp] lemma finset.univ_sigma_univ {α : Type*} {β : α → Type*} [fintype α] [∀ a, fintype (β a)] :
  (univ : finset α).sigma (λ a, (univ : finset (β a))) = univ := rfl

instance psigma.fintype {α : Type*} {β : α → Type*} [fintype α] [∀ a, fintype (β a)] :
  fintype (Σ' a, β a) :=
fintype.of_equiv _ (equiv.psigma_equiv_sigma _).symm


/-
Copyright (c) 2019 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import tactic.noncomm_ring
import data.equiv.module
import data.bracket

/-!
# Lie algebras

This file defines Lie rings and Lie algebras over a commutative ring together with their
modules, morphisms and equivalences, as well as various lemmas to make these definitions usable.

## Main definitions

  * `lie_ring`
  * `lie_algebra`
  * `lie_ring_module`
  * `lie_module`
  * `lie_hom`
  * `lie_equiv`
  * `lie_module_hom`
  * `lie_module_equiv`

## Notation

Working over a fixed commutative ring `R`, we introduce the notations:
 * `L →ₗ⁅R⁆ L'` for a morphism of Lie algebras,
 * `L ≃ₗ⁅R⁆ L'` for an equivalence of Lie algebras,
 * `M →ₗ⁅R,L⁆ N` for a morphism of Lie algebra modules `M`, `N` over a Lie algebra `L`,
 * `M ≃ₗ⁅R,L⁆ N` for an equivalence of Lie algebra modules `M`, `N` over a Lie algebra `L`.

## Implementation notes

Lie algebras are defined as modules with a compatible Lie ring structure and thus, like modules,
are partially unbundled.

## References
* [N. Bourbaki, *Lie Groups and Lie Algebras, Chapters 1--3*](bourbaki1975)

## Tags

lie bracket, jacobi identity, lie ring, lie algebra, lie module
-/

universes u v w w₁ w₂
open function

/-- A Lie ring is an additive group with compatible product, known as the bracket, satisfying the
Jacobi identity. -/
@[protect_proj] class lie_ring (L : Type v) extends add_comm_group L, has_bracket L L :=
(add_lie  : ∀ (x y z : L), ⁅x + y, z⁆ = ⁅x, z⁆ + ⁅y, z⁆)
(lie_add  : ∀ (x y z : L), ⁅x, y + z⁆ = ⁅x, y⁆ + ⁅x, z⁆)
(lie_self : ∀ (x : L), ⁅x, x⁆ = 0)
(leibniz_lie : ∀ (x y z : L), ⁅x, ⁅y, z⁆⁆ = ⁅⁅x, y⁆, z⁆ + ⁅y, ⁅x, z⁆⁆)

/-- A Lie algebra is a module with compatible product, known as the bracket, satisfying the Jacobi
identity. Forgetting the scalar multiplication, every Lie algebra is a Lie ring. -/
@[protect_proj] class lie_algebra (R : Type u) (L : Type v) [comm_ring R] [lie_ring L]
  extends module R L :=
(lie_smul : ∀ (t : R) (x y : L), ⁅x, t • y⁆ = t • ⁅x, y⁆)

/-- A Lie ring module is an additive group, together with an additive action of a
Lie ring on this group, such that the Lie bracket acts as the commutator of endomorphisms.
(For representations of Lie *algebras* see `lie_module`.) -/
@[protect_proj] class lie_ring_module (L : Type v) (M : Type w)
  [lie_ring L] [add_comm_group M] extends has_bracket L M :=
(add_lie     : ∀ (x y : L) (m : M), ⁅x + y, m⁆ = ⁅x, m⁆ + ⁅y, m⁆)
(lie_add     : ∀ (x : L) (m n : M), ⁅x, m + n⁆ = ⁅x, m⁆ + ⁅x, n⁆)
(leibniz_lie : ∀ (x y : L) (m : M), ⁅x, ⁅y, m⁆⁆ = ⁅⁅x, y⁆, m⁆ + ⁅y, ⁅x, m⁆⁆)

/-- A Lie module is a module over a commutative ring, together with a linear action of a Lie
algebra on this module, such that the Lie bracket acts as the commutator of endomorphisms. -/
@[protect_proj] class lie_module (R : Type u) (L : Type v) (M : Type w)
  [comm_ring R] [lie_ring L] [lie_algebra R L] [add_comm_group M] [module R M]
  [lie_ring_module L M] :=
(smul_lie : ∀ (t : R) (x : L) (m : M), ⁅t • x, m⁆ = t • ⁅x, m⁆)
(lie_smul : ∀ (t : R) (x : L) (m : M), ⁅x, t • m⁆ = t • ⁅x, m⁆)

section basic_properties

variables {R : Type u} {L : Type v} {M : Type w} {N : Type w₁}
variables [comm_ring R] [lie_ring L] [lie_algebra R L]
variables [add_comm_group M] [module R M] [lie_ring_module L M] [lie_module R L M]
variables [add_comm_group N] [module R N] [lie_ring_module L N] [lie_module R L N]
variables (t : R) (x y z : L) (m n : M)

@[simp] lemma add_lie : ⁅x + y, m⁆ = ⁅x, m⁆ + ⁅y, m⁆ := lie_ring_module.add_lie x y m

@[simp] lemma lie_add : ⁅x, m + n⁆ = ⁅x, m⁆ + ⁅x, n⁆ := lie_ring_module.lie_add x m n

@[simp] lemma smul_lie : ⁅t • x, m⁆ = t • ⁅x, m⁆ := lie_module.smul_lie t x m

@[simp] lemma lie_smul : ⁅x, t • m⁆ = t • ⁅x, m⁆ := lie_module.lie_smul t x m

lemma leibniz_lie : ⁅x, ⁅y, m⁆⁆ = ⁅⁅x, y⁆, m⁆ + ⁅y, ⁅x, m⁆⁆ := lie_ring_module.leibniz_lie x y m

@[simp] lemma lie_zero : ⁅x, 0⁆ = (0 : M) := (add_monoid_hom.mk' _ (lie_add x)).map_zero

@[simp] lemma zero_lie : ⁅(0 : L), m⁆ = 0 :=
(add_monoid_hom.mk' (λ (x : L), ⁅x, m⁆) (λ x y, add_lie x y m)).map_zero

@[simp] lemma lie_self : ⁅x, x⁆ = 0 := lie_ring.lie_self x

instance lie_ring_self_module : lie_ring_module L L := { ..(infer_instance : lie_ring L) }

@[simp] lemma lie_skew : -⁅y, x⁆ = ⁅x, y⁆ :=
have h : ⁅x + y, x⁆ + ⁅x + y, y⁆ = 0, { rw ← lie_add, apply lie_self, },
by simpa [neg_eq_iff_add_eq_zero] using h

/-- Every Lie algebra is a module over itself. -/
instance lie_algebra_self_module : lie_module R L L :=
{ smul_lie := λ t x m, by rw [←lie_skew, ←lie_skew x m, lie_algebra.lie_smul, smul_neg],
  lie_smul := by apply lie_algebra.lie_smul, }

@[simp] lemma neg_lie : ⁅-x, m⁆ = -⁅x, m⁆ :=
by { rw [←sub_eq_zero, sub_neg_eq_add, ←add_lie], simp, }

@[simp] lemma lie_neg : ⁅x, -m⁆ = -⁅x, m⁆ :=
by { rw [←sub_eq_zero, sub_neg_eq_add, ←lie_add], simp, }

@[simp] lemma sub_lie : ⁅x - y, m⁆ = ⁅x, m⁆ - ⁅y, m⁆ :=
by simp [sub_eq_add_neg]

@[simp] lemma lie_sub : ⁅x, m - n⁆ = ⁅x, m⁆ - ⁅x, n⁆ :=
by simp [sub_eq_add_neg]

@[simp] lemma nsmul_lie (n : ℕ) : ⁅n • x, m⁆ = n • ⁅x, m⁆ :=
add_monoid_hom.map_nsmul ⟨λ (x : L), ⁅x, m⁆, zero_lie m, λ _ _, add_lie _ _ _⟩ _ _

@[simp] lemma lie_nsmul (n : ℕ) : ⁅x, n • m⁆ = n • ⁅x, m⁆ :=
add_monoid_hom.map_nsmul ⟨λ (m : M), ⁅x, m⁆, lie_zero x, λ _ _, lie_add _ _ _⟩ _ _

@[simp] lemma zsmul_lie (a : ℤ) : ⁅a • x, m⁆ = a • ⁅x, m⁆ :=
add_monoid_hom.map_zsmul ⟨λ (x : L), ⁅x, m⁆, zero_lie m, λ _ _, add_lie _ _ _⟩ _ _

@[simp] lemma lie_zsmul (a : ℤ) : ⁅x, a • m⁆ = a • ⁅x, m⁆ :=
add_monoid_hom.map_zsmul ⟨λ (m : M), ⁅x, m⁆, lie_zero x, λ _ _, lie_add _ _ _⟩ _ _

@[simp] lemma lie_lie : ⁅⁅x, y⁆, m⁆ = ⁅x, ⁅y, m⁆⁆ - ⁅y, ⁅x, m⁆⁆ :=
by rw [leibniz_lie, add_sub_cancel]

lemma lie_jacobi : ⁅x, ⁅y, z⁆⁆ + ⁅y, ⁅z, x⁆⁆ + ⁅z, ⁅x, y⁆⁆ = 0 :=
by { rw [← neg_neg ⁅x, y⁆, lie_neg z, lie_skew y x, ← lie_skew, lie_lie], abel, }

instance lie_ring.int_lie_algebra : lie_algebra ℤ L :=
{ lie_smul := λ n x y, lie_zsmul x y n, }

instance : lie_ring_module L (M →ₗ[R] N) :=
{ bracket     := λ x f,
  { to_fun    := λ m, ⁅x, f m⁆ - f ⁅x, m⁆,
    map_add'  := λ m n, by { simp only [lie_add, linear_map.map_add], abel, },
    map_smul' := λ t m, by simp only [smul_sub, linear_map.map_smul, lie_smul, ring_hom.id_apply] },
  add_lie     := λ x y f, by
    { ext n, simp only [add_lie, linear_map.coe_mk, linear_map.add_apply, linear_map.map_add],
      abel, },
  lie_add     := λ x f g, by
    { ext n, simp only [linear_map.coe_mk, lie_add, linear_map.add_apply], abel, },
  leibniz_lie := λ x y f, by
    { ext n,
      simp only [lie_lie, linear_map.coe_mk, linear_map.map_sub, linear_map.add_apply, lie_sub],
      abel, }, }

@[simp] lemma lie_hom.lie_apply (f : M →ₗ[R] N) (x : L) (m : M) :
  ⁅x, f⁆ m = ⁅x, f m⁆ - f ⁅x, m⁆ :=
rfl

instance : lie_module R L (M →ₗ[R] N) :=
{ smul_lie := λ t x f, by
    { ext n,
      simp only [smul_sub, smul_lie, linear_map.smul_apply, lie_hom.lie_apply,
        linear_map.map_smul], },
  lie_smul := λ t x f, by
    { ext n, simp only [smul_sub, linear_map.smul_apply, lie_hom.lie_apply, lie_smul], }, }

end basic_properties

/-- A morphism of Lie algebras is a linear map respecting the bracket operations. -/
structure lie_hom (R : Type u) (L : Type v) (L' : Type w)
  [comm_ring R] [lie_ring L] [lie_algebra R L] [lie_ring L'] [lie_algebra R L']
  extends L →ₗ[R] L' :=
(map_lie' : ∀ {x y : L}, to_fun ⁅x, y⁆ = ⁅to_fun x, to_fun y⁆)

attribute [nolint doc_blame] lie_hom.to_linear_map

notation L ` →ₗ⁅`:25 R:25 `⁆ `:0 L':0 := lie_hom R L L'

namespace lie_hom

variables {R : Type u} {L₁ : Type v} {L₂ : Type w} {L₃ : Type w₁}
variables [comm_ring R]
variables [lie_ring L₁] [lie_algebra R L₁]
variables [lie_ring L₂] [lie_algebra R L₂]
variables [lie_ring L₃] [lie_algebra R L₃]

instance : has_coe (L₁ →ₗ⁅R⁆ L₂) (L₁ →ₗ[R] L₂) := ⟨lie_hom.to_linear_map⟩

/-- see Note [function coercion] -/
instance : has_coe_to_fun (L₁ →ₗ⁅R⁆ L₂) (λ _, L₁ → L₂) := ⟨λ f, f.to_linear_map.to_fun⟩

/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
  because it is a composition of multiple projections. -/
def simps.apply (h : L₁ →ₗ⁅R⁆ L₂) : L₁ → L₂ := h

initialize_simps_projections lie_hom (to_linear_map_to_fun → apply)

@[simp, norm_cast] lemma coe_to_linear_map (f : L₁ →ₗ⁅R⁆ L₂) : ((f : L₁ →ₗ[R] L₂) : L₁ → L₂) = f :=
rfl

@[simp] lemma to_fun_eq_coe (f : L₁ →ₗ⁅R⁆ L₂) : f.to_fun = ⇑f := rfl

@[simp] lemma map_smul (f : L₁ →ₗ⁅R⁆ L₂) (c : R) (x : L₁) : f (c • x) = c • f x :=
linear_map.map_smul (f : L₁ →ₗ[R] L₂) c x

@[simp] lemma map_add (f : L₁ →ₗ⁅R⁆ L₂) (x y : L₁) : f (x + y) = (f x) + (f y) :=
linear_map.map_add (f : L₁ →ₗ[R] L₂) x y

@[simp] lemma map_sub (f : L₁ →ₗ⁅R⁆ L₂) (x y : L₁) : f (x - y) = (f x) - (f y) :=
linear_map.map_sub (f : L₁ →ₗ[R] L₂) x y

@[simp] lemma map_neg (f : L₁ →ₗ⁅R⁆ L₂) (x : L₁) : f (-x) = -(f x) :=
linear_map.map_neg (f : L₁ →ₗ[R] L₂) x

@[simp] lemma map_lie (f : L₁ →ₗ⁅R⁆ L₂) (x y : L₁) : f ⁅x, y⁆ = ⁅f x, f y⁆ := lie_hom.map_lie' f

@[simp] lemma map_zero (f : L₁ →ₗ⁅R⁆ L₂) : f 0 = 0 := (f : L₁ →ₗ[R] L₂).map_zero

/-- The identity map is a morphism of Lie algebras. -/
def id : L₁ →ₗ⁅R⁆ L₁ :=
{ map_lie' := λ x y, rfl,
  .. (linear_map.id : L₁ →ₗ[R] L₁) }

@[simp] lemma coe_id : ((id : L₁ →ₗ⁅R⁆ L₁) : L₁ → L₁) = _root_.id := rfl

lemma id_apply (x : L₁) : (id : L₁ →ₗ⁅R⁆ L₁) x = x := rfl

/-- The constant 0 map is a Lie algebra morphism. -/
instance : has_zero (L₁ →ₗ⁅R⁆ L₂) := ⟨{ map_lie' := by simp, ..(0 : L₁ →ₗ[R] L₂)}⟩

@[norm_cast, simp] lemma coe_zero : ((0 : L₁ →ₗ⁅R⁆ L₂) : L₁ → L₂) = 0 := rfl

lemma zero_apply (x : L₁) : (0 : L₁ →ₗ⁅R⁆ L₂) x = 0 := rfl

/-- The identity map is a Lie algebra morphism. -/
instance : has_one (L₁ →ₗ⁅R⁆ L₁) := ⟨id⟩

@[simp] lemma coe_one : ((1 : (L₁ →ₗ⁅R⁆ L₁)) : L₁ → L₁) = _root_.id := rfl

lemma one_apply (x : L₁) : (1 : (L₁ →ₗ⁅R⁆ L₁)) x = x := rfl

instance : inhabited (L₁ →ₗ⁅R⁆ L₂) := ⟨0⟩

lemma coe_injective : @function.injective (L₁ →ₗ⁅R⁆ L₂) (L₁ → L₂) coe_fn :=
by rintro ⟨⟨f, _⟩⟩ ⟨⟨g, _⟩⟩ ⟨h⟩; congr

@[ext] lemma ext {f g : L₁ →ₗ⁅R⁆ L₂} (h : ∀ x, f x = g x) : f = g :=
coe_injective $ funext h

lemma ext_iff {f g : L₁ →ₗ⁅R⁆ L₂} : f = g ↔ ∀ x, f x = g x :=
⟨by { rintro rfl x, refl }, ext⟩

lemma congr_fun {f g : L₁ →ₗ⁅R⁆ L₂} (h : f = g) (x : L₁) : f x = g x := h ▸ rfl

@[simp] lemma mk_coe (f : L₁ →ₗ⁅R⁆ L₂) (h₁ h₂ h₃) :
  (⟨⟨f, h₁, h₂⟩, h₃⟩ : L₁ →ₗ⁅R⁆ L₂) = f :=
by { ext, refl, }

@[simp] lemma coe_mk (f : L₁ → L₂) (h₁ h₂ h₃) :
  ((⟨⟨f, h₁, h₂⟩, h₃⟩ : L₁ →ₗ⁅R⁆ L₂) : L₁ → L₂) = f := rfl

/-- The composition of morphisms is a morphism. -/
def comp (f : L₂ →ₗ⁅R⁆ L₃) (g : L₁ →ₗ⁅R⁆ L₂) : L₁ →ₗ⁅R⁆ L₃ :=
{ map_lie' := λ x y, by { change f (g ⁅x, y⁆) = ⁅f (g x), f (g y)⁆, rw [map_lie, map_lie], },
  ..linear_map.comp f.to_linear_map g.to_linear_map }

lemma comp_apply (f : L₂ →ₗ⁅R⁆ L₃) (g : L₁ →ₗ⁅R⁆ L₂) (x : L₁) :
  f.comp g x = f (g x) := rfl

@[norm_cast, simp]
lemma coe_comp (f : L₂ →ₗ⁅R⁆ L₃) (g : L₁ →ₗ⁅R⁆ L₂) :
  (f.comp g : L₁ → L₃) = f ∘ g :=
rfl

@[norm_cast, simp]
lemma coe_linear_map_comp (f : L₂ →ₗ⁅R⁆ L₃) (g : L₁ →ₗ⁅R⁆ L₂) :
  (f.comp g : L₁ →ₗ[R] L₃) = (f : L₂ →ₗ[R] L₃).comp (g : L₁ →ₗ[R] L₂) :=
rfl

@[simp] lemma comp_id (f : L₁ →ₗ⁅R⁆ L₂) : f.comp (id : L₁ →ₗ⁅R⁆ L₁) = f :=
by { ext, refl, }

@[simp] lemma id_comp (f : L₁ →ₗ⁅R⁆ L₂) : (id : L₂ →ₗ⁅R⁆ L₂).comp f = f :=
by { ext, refl, }

/-- The inverse of a bijective morphism is a morphism. -/
def inverse (f : L₁ →ₗ⁅R⁆ L₂) (g : L₂ → L₁)
  (h₁ : function.left_inverse g f) (h₂ : function.right_inverse g f) : L₂ →ₗ⁅R⁆ L₁ :=
{ map_lie' := λ x y,
  calc g ⁅x, y⁆ = g ⁅f (g x), f (g y)⁆ : by { conv_lhs { rw [←h₂ x, ←h₂ y], }, }
            ... = g (f ⁅g x, g y⁆) : by rw map_lie
            ... = ⁅g x, g y⁆ : (h₁ _),
  ..linear_map.inverse f.to_linear_map g h₁ h₂ }

end lie_hom

/-- An equivalence of Lie algebras is a morphism which is also a linear equivalence. We could
instead define an equivalence to be a morphism which is also a (plain) equivalence. However it is
more convenient to define via linear equivalence to get `.to_linear_equiv` for free. -/
structure lie_equiv (R : Type u) (L : Type v) (L' : Type w)
  [comm_ring R] [lie_ring L] [lie_algebra R L] [lie_ring L'] [lie_algebra R L']
  extends L →ₗ⁅R⁆ L' :=
(inv_fun   : L' → L)
(left_inv  : function.left_inverse inv_fun to_lie_hom.to_fun)
(right_inv : function.right_inverse inv_fun to_lie_hom.to_fun)

attribute [nolint doc_blame] lie_equiv.to_lie_hom

notation L ` ≃ₗ⁅`:50 R `⁆ ` L' := lie_equiv R L L'

namespace lie_equiv

variables {R : Type u} {L₁ : Type v} {L₂ : Type w} {L₃ : Type w₁}
variables [comm_ring R] [lie_ring L₁] [lie_ring L₂] [lie_ring L₃]
variables [lie_algebra R L₁] [lie_algebra R L₂] [lie_algebra R L₃]

/-- Consider an equivalence of Lie algebras as a linear equivalence. -/
def to_linear_equiv (f : L₁ ≃ₗ⁅R⁆ L₂) : L₁ ≃ₗ[R] L₂ := { ..f.to_lie_hom, ..f }

instance has_coe_to_lie_hom : has_coe (L₁ ≃ₗ⁅R⁆ L₂) (L₁ →ₗ⁅R⁆ L₂) := ⟨to_lie_hom⟩
instance has_coe_to_linear_equiv : has_coe (L₁ ≃ₗ⁅R⁆ L₂) (L₁ ≃ₗ[R] L₂) := ⟨to_linear_equiv⟩

/-- see Note [function coercion] -/
instance : has_coe_to_fun (L₁ ≃ₗ⁅R⁆ L₂) (λ _, L₁ → L₂) := ⟨λ e, e.to_lie_hom.to_fun⟩

@[simp, norm_cast] lemma coe_to_lie_hom (e : L₁ ≃ₗ⁅R⁆ L₂) : ((e : L₁ →ₗ⁅R⁆ L₂) : L₁ → L₂) = e :=
rfl

@[simp, norm_cast] lemma coe_to_linear_equiv (e : L₁ ≃ₗ⁅R⁆ L₂) :
  ((e : L₁ ≃ₗ[R] L₂) : L₁ → L₂) = e := rfl

@[simp] lemma to_linear_equiv_mk (f : L₁ →ₗ⁅R⁆ L₂) (g h₁ h₂) :
  (mk f g h₁ h₂ : L₁ ≃ₗ[R] L₂) = { inv_fun := g, left_inv := h₁, right_inv := h₂, .. f } := rfl

lemma coe_linear_equiv_injective : injective (coe : (L₁ ≃ₗ⁅R⁆ L₂) → (L₁ ≃ₗ[R] L₂)) :=
begin
  intros f₁ f₂ h, cases f₁, cases f₂, dsimp at h, simp only at h,
  congr, exacts [lie_hom.coe_injective h.1, h.2]
end

lemma coe_injective : @injective (L₁ ≃ₗ⁅R⁆ L₂) (L₁ → L₂) coe_fn :=
linear_equiv.coe_injective.comp coe_linear_equiv_injective

@[ext] lemma ext {f g : L₁ ≃ₗ⁅R⁆ L₂} (h : ∀ x, f x = g x) : f = g := coe_injective $ funext h

instance : has_one (L₁ ≃ₗ⁅R⁆ L₁) :=
⟨{ map_lie' := λ x y, rfl,
  ..(1 : L₁ ≃ₗ[R] L₁)}⟩

@[simp] lemma one_apply (x : L₁) : (1 : (L₁ ≃ₗ⁅R⁆ L₁)) x = x := rfl

instance : inhabited (L₁ ≃ₗ⁅R⁆ L₁) := ⟨1⟩

/-- Lie algebra equivalences are reflexive. -/
@[refl]
def refl : L₁ ≃ₗ⁅R⁆ L₁ := 1

@[simp] lemma refl_apply (x : L₁) : (refl : L₁ ≃ₗ⁅R⁆ L₁) x = x := rfl

/-- Lie algebra equivalences are symmetric. -/
@[symm]
def symm (e : L₁ ≃ₗ⁅R⁆ L₂) : L₂ ≃ₗ⁅R⁆ L₁ :=
{ ..lie_hom.inverse e.to_lie_hom e.inv_fun e.left_inv e.right_inv,
  ..e.to_linear_equiv.symm }

@[simp] lemma symm_symm (e : L₁ ≃ₗ⁅R⁆ L₂) : e.symm.symm = e :=
by { ext, refl }

@[simp] lemma apply_symm_apply (e : L₁ ≃ₗ⁅R⁆ L₂) : ∀ x, e (e.symm x) = x :=
  e.to_linear_equiv.apply_symm_apply

@[simp] lemma symm_apply_apply (e : L₁ ≃ₗ⁅R⁆ L₂) : ∀ x, e.symm (e x) = x :=
  e.to_linear_equiv.symm_apply_apply

/-- Lie algebra equivalences are transitive. -/
@[trans]
def trans (e₁ : L₁ ≃ₗ⁅R⁆ L₂) (e₂ : L₂ ≃ₗ⁅R⁆ L₃) : L₁ ≃ₗ⁅R⁆ L₃ :=
{ ..lie_hom.comp e₂.to_lie_hom e₁.to_lie_hom,
  ..linear_equiv.trans e₁.to_linear_equiv e₂.to_linear_equiv }

@[simp] lemma self_trans_symm (e : L₁ ≃ₗ⁅R⁆ L₂) : e.trans e.symm = refl :=
ext e.symm_apply_apply

@[simp] lemma symm_trans_self (e : L₁ ≃ₗ⁅R⁆ L₂) : e.symm.trans e = refl :=
e.symm.self_trans_symm

@[simp] lemma trans_apply (e₁ : L₁ ≃ₗ⁅R⁆ L₂) (e₂ : L₂ ≃ₗ⁅R⁆ L₃) (x : L₁) :
  (e₁.trans e₂) x = e₂ (e₁ x) := rfl

@[simp] lemma symm_trans (e₁ : L₁ ≃ₗ⁅R⁆ L₂) (e₂ : L₂ ≃ₗ⁅R⁆ L₃) :
  (e₁.trans e₂).symm = e₂.symm.trans e₁.symm := rfl

protected lemma bijective (e : L₁ ≃ₗ⁅R⁆ L₂) : function.bijective ((e : L₁ →ₗ⁅R⁆ L₂) : L₁ → L₂) :=
e.to_linear_equiv.bijective

protected lemma injective (e : L₁ ≃ₗ⁅R⁆ L₂) : function.injective ((e : L₁ →ₗ⁅R⁆ L₂) : L₁ → L₂) :=
e.to_linear_equiv.injective

protected lemma surjective (e : L₁ ≃ₗ⁅R⁆ L₂) : function.surjective ((e : L₁ →ₗ⁅R⁆ L₂) : L₁ → L₂) :=
e.to_linear_equiv.surjective

end lie_equiv

section lie_module_morphisms

variables (R : Type u) (L : Type v) (M : Type w) (N : Type w₁) (P : Type w₂)
variables [comm_ring R] [lie_ring L] [lie_algebra R L]
variables [add_comm_group M] [add_comm_group N] [add_comm_group P]
variables [module R M] [module R N] [module R P]
variables [lie_ring_module L M] [lie_ring_module L N] [lie_ring_module L P]
variables [lie_module R L M] [lie_module R L N] [lie_module R L P]

/-- A morphism of Lie algebra modules is a linear map which commutes with the action of the Lie
algebra. -/
structure lie_module_hom extends M →ₗ[R] N :=
(map_lie' : ∀ {x : L} {m : M}, to_fun ⁅x, m⁆ = ⁅x, to_fun m⁆)

attribute [nolint doc_blame] lie_module_hom.to_linear_map

notation M ` →ₗ⁅`:25 R,L:25 `⁆ `:0 N:0 := lie_module_hom R L M N

namespace lie_module_hom

variables {R L M N P}

instance : has_coe (M →ₗ⁅R,L⁆ N) (M →ₗ[R] N) := ⟨lie_module_hom.to_linear_map⟩

/-- see Note [function coercion] -/
instance : has_coe_to_fun (M →ₗ⁅R,L⁆ N) (λ _, M → N) := ⟨λ f, f.to_linear_map.to_fun⟩

@[simp, norm_cast] lemma coe_to_linear_map (f : M →ₗ⁅R,L⁆ N) : ((f : M →ₗ[R] N) : M → N) = f :=
rfl

@[simp] lemma map_smul (f : M →ₗ⁅R,L⁆ N) (c : R) (x : M) : f (c • x) = c • f x :=
linear_map.map_smul (f : M →ₗ[R] N) c x

@[simp] lemma map_add (f : M →ₗ⁅R,L⁆ N) (x y : M) : f (x + y) = (f x) + (f y) :=
linear_map.map_add (f : M →ₗ[R] N) x y

@[simp] lemma map_sub (f : M →ₗ⁅R,L⁆ N) (x y : M) : f (x - y) = (f x) - (f y) :=
linear_map.map_sub (f : M →ₗ[R] N) x y

@[simp] lemma map_neg (f : M →ₗ⁅R,L⁆ N) (x : M) : f (-x) = -(f x) :=
linear_map.map_neg (f : M →ₗ[R] N) x

@[simp] lemma map_lie (f : M →ₗ⁅R,L⁆ N) (x : L) (m : M) : f ⁅x, m⁆ = ⁅x, f m⁆ :=
lie_module_hom.map_lie' f

lemma map_lie₂ (f : M →ₗ⁅R,L⁆ N →ₗ[R] P) (x : L) (m : M) (n : N) :
  ⁅x, f m n⁆ = f ⁅x, m⁆ n + f m ⁅x, n⁆ :=
by simp only [sub_add_cancel, map_lie, lie_hom.lie_apply]

@[simp] lemma map_zero (f : M →ₗ⁅R,L⁆ N) : f 0 = 0 :=
linear_map.map_zero (f : M →ₗ[R] N)

/-- The constant 0 map is a Lie module morphism. -/
instance : has_zero (M →ₗ⁅R,L⁆ N) := ⟨{ map_lie' := by simp, ..(0 : M →ₗ[R] N) }⟩

@[norm_cast, simp] lemma coe_zero : ((0 : M →ₗ⁅R,L⁆ N) : M → N) = 0 := rfl

lemma zero_apply (m : M) : (0 : M →ₗ⁅R,L⁆ N) m = 0 := rfl

/-- The identity map is a Lie module morphism. -/
instance : has_one (M →ₗ⁅R,L⁆ M) := ⟨{ map_lie' := by simp, ..(1 : M →ₗ[R] M) }⟩

instance : inhabited (M →ₗ⁅R,L⁆ N) := ⟨0⟩

lemma coe_injective : @function.injective (M →ₗ⁅R,L⁆ N) (M → N) coe_fn :=
by { rintros ⟨⟨f, _⟩⟩ ⟨⟨g, _⟩⟩ ⟨h⟩, congr, }

@[ext] lemma ext {f g : M →ₗ⁅R,L⁆ N} (h : ∀ m, f m = g m) : f = g :=
coe_injective $ funext h

lemma ext_iff {f g : M →ₗ⁅R,L⁆ N} : f = g ↔ ∀ m, f m = g m :=
⟨by { rintro rfl m, refl, }, ext⟩

lemma congr_fun {f g : M →ₗ⁅R,L⁆ N} (h : f = g) (x : M) : f x = g x := h ▸ rfl

@[simp] lemma mk_coe (f : M →ₗ⁅R,L⁆ N) (h) :
  (⟨f, h⟩ : M →ₗ⁅R,L⁆ N) = f :=
by { ext, refl, }

@[simp] lemma coe_mk (f : M →ₗ[R] N) (h) :
  ((⟨f, h⟩ : M →ₗ⁅R,L⁆ N) : M → N) = f :=
by { ext, refl, }

@[norm_cast, simp] lemma coe_linear_mk (f : M →ₗ[R] N) (h) :
  ((⟨f, h⟩ : M →ₗ⁅R,L⁆ N) : M →ₗ[R] N) = f :=
by { ext, refl, }

/-- The composition of Lie module morphisms is a morphism. -/
def comp (f : N →ₗ⁅R,L⁆ P) (g : M →ₗ⁅R,L⁆ N) : M →ₗ⁅R,L⁆ P :=
{ map_lie' := λ x m, by { change f (g ⁅x, m⁆) = ⁅x, f (g m)⁆, rw [map_lie, map_lie], },
  ..linear_map.comp f.to_linear_map g.to_linear_map }

lemma comp_apply (f : N →ₗ⁅R,L⁆ P) (g : M →ₗ⁅R,L⁆ N) (m : M) :
  f.comp g m = f (g m) := rfl

@[norm_cast, simp] lemma coe_comp (f : N →ₗ⁅R,L⁆ P) (g : M →ₗ⁅R,L⁆ N) :
  (f.comp g : M → P) = f ∘ g :=
rfl

@[norm_cast, simp] lemma coe_linear_map_comp (f : N →ₗ⁅R,L⁆ P) (g : M →ₗ⁅R,L⁆ N) :
  (f.comp g : M →ₗ[R] P) = (f : N →ₗ[R] P).comp (g : M →ₗ[R] N) :=
rfl

/-- The inverse of a bijective morphism of Lie modules is a morphism of Lie modules. -/
def inverse (f : M →ₗ⁅R,L⁆ N) (g : N → M)
  (h₁ : function.left_inverse g f) (h₂ : function.right_inverse g f) : N →ₗ⁅R,L⁆ M :=
{ map_lie' := λ x n,
    calc g ⁅x, n⁆ = g ⁅x, f (g n)⁆ : by rw h₂
              ... = g (f ⁅x, g n⁆) : by rw map_lie
              ... = ⁅x, g n⁆ : (h₁ _),
  ..linear_map.inverse f.to_linear_map g h₁ h₂ }

instance : has_add (M →ₗ⁅R,L⁆ N) :=
{ add := λ f g, { map_lie' := by simp, ..((f : M →ₗ[R] N) + (g : M →ₗ[R] N)) }, }

instance : has_sub (M →ₗ⁅R,L⁆ N) :=
{ sub := λ f g, { map_lie' := by simp, ..((f : M →ₗ[R] N) - (g : M →ₗ[R] N)) }, }

instance : has_neg (M →ₗ⁅R,L⁆ N) :=
{ neg := λ f, { map_lie' := by simp, ..(-(f : (M →ₗ[R] N))) }, }

@[norm_cast, simp] lemma coe_add (f g : M →ₗ⁅R,L⁆ N) : ⇑(f + g) = f + g := rfl

lemma add_apply (f g : M →ₗ⁅R,L⁆ N) (m : M) : (f + g) m = f m + g m := rfl

@[norm_cast, simp] lemma coe_sub (f g : M →ₗ⁅R,L⁆ N) : ⇑(f - g) = f - g := rfl

lemma sub_apply (f g : M →ₗ⁅R,L⁆ N) (m : M) : (f - g) m = f m - g m := rfl

@[norm_cast, simp] lemma coe_neg (f : M →ₗ⁅R,L⁆ N) : ⇑(-f) = -f := rfl

lemma neg_apply (f : M →ₗ⁅R,L⁆ N) (m : M) : (-f) m = -(f m) := rfl

instance : add_comm_group (M →ₗ⁅R,L⁆ N) :=
{ zero           := 0,
  add            := (+),
  neg            := has_neg.neg,
  sub            := has_sub.sub,
  nsmul          := λ n f, { map_lie' := λ x m, by simp, ..(n • (f : M →ₗ[R] N)) },
  nsmul_zero'    := λ f, by { ext, simp, },
  nsmul_succ'    := λ n f, by { ext, simp [nat.succ_eq_one_add, add_nsmul], },
  ..(coe_injective.add_comm_group _ coe_zero coe_add coe_neg coe_sub :
    add_comm_group (M →ₗ⁅R,L⁆ N)) }

instance : has_scalar R (M →ₗ⁅R,L⁆ N) :=
{ smul := λ t f, { map_lie' := by simp, ..(t • (f : M →ₗ[R] N)) }, }

@[norm_cast, simp] lemma coe_smul (t : R) (f : M →ₗ⁅R,L⁆ N) : ⇑(t • f) = t • f := rfl

lemma smul_apply (t : R) (f : M →ₗ⁅R,L⁆ N) (m : M) : (t • f) m = t • (f m) := rfl

instance : module R (M →ₗ⁅R,L⁆ N) :=
function.injective.module R ⟨λ f, f.to_linear_map.to_fun, rfl, coe_add⟩ coe_injective coe_smul

end lie_module_hom

/-- An equivalence of Lie algebra modules is a linear equivalence which is also a morphism of
Lie algebra modules. -/
structure lie_module_equiv extends M →ₗ⁅R,L⁆ N :=
(inv_fun   : N → M)
(left_inv  : function.left_inverse inv_fun to_fun)
(right_inv : function.right_inverse inv_fun to_fun)

attribute [nolint doc_blame] lie_module_equiv.to_lie_module_hom

notation M ` ≃ₗ⁅`:25 R,L:25 `⁆ `:0 N:0 := lie_module_equiv R L M N

namespace lie_module_equiv

variables {R L M N P}

/-- View an equivalence of Lie modules as a linear equivalence. -/
@[ancestor]
def to_linear_equiv (e : M ≃ₗ⁅R,L⁆ N) : M ≃ₗ[R] N := { ..e }

/-- View an equivalence of Lie modules as a type level equivalence. -/
@[ancestor]
def to_equiv (e : M ≃ₗ⁅R,L⁆ N) : M ≃ N := { ..e }

instance has_coe_to_equiv : has_coe (M ≃ₗ⁅R,L⁆ N) (M ≃ N) := ⟨to_equiv⟩
instance has_coe_to_lie_module_hom : has_coe (M ≃ₗ⁅R,L⁆ N) (M →ₗ⁅R,L⁆ N) := ⟨to_lie_module_hom⟩
instance has_coe_to_linear_equiv : has_coe (M ≃ₗ⁅R,L⁆ N) (M ≃ₗ[R] N) := ⟨to_linear_equiv⟩

/-- see Note [function coercion] -/
instance : has_coe_to_fun (M ≃ₗ⁅R,L⁆ N) (λ _, M → N) := ⟨λ e, e.to_lie_module_hom.to_fun⟩

lemma injective (e : M ≃ₗ⁅R,L⁆ N) : function.injective e := e.to_equiv.injective

@[simp] lemma coe_mk (f : M →ₗ⁅R,L⁆ N) (inv_fun h₁ h₂) :
  ((⟨f, inv_fun, h₁, h₂⟩ : M ≃ₗ⁅R,L⁆ N) : M → N) = f := rfl

@[simp, norm_cast] lemma coe_to_lie_module_hom (e : M ≃ₗ⁅R,L⁆ N) :
  ((e : M →ₗ⁅R,L⁆ N) : M → N) = e := rfl

@[simp, norm_cast] lemma coe_to_linear_equiv (e : M ≃ₗ⁅R,L⁆ N) : ((e : M ≃ₗ[R] N) : M → N) = e :=
rfl

lemma to_equiv_injective : function.injective (to_equiv : (M ≃ₗ⁅R,L⁆ N) → M ≃ N) :=
λ e₁ e₂ h, begin
  rcases e₁ with ⟨⟨⟩⟩, rcases e₂ with ⟨⟨⟩⟩,
  have inj := equiv.mk.inj h,
  dsimp at inj,
  apply lie_module_equiv.mk.inj_eq.mpr,
  split,
  { congr,
    ext,
    rw inj.1 },
  { exact inj.2 },
end

@[ext] lemma ext (e₁ e₂ : M ≃ₗ⁅R,L⁆ N) (h : ∀ m, e₁ m = e₂ m) : e₁ = e₂ :=
to_equiv_injective (equiv.ext h)

instance : has_one (M ≃ₗ⁅R,L⁆ M) := ⟨{ map_lie' := λ x m, rfl, ..(1 : M ≃ₗ[R] M) }⟩

@[simp] lemma one_apply (m : M) : (1 : (M ≃ₗ⁅R,L⁆ M)) m = m := rfl

instance : inhabited (M ≃ₗ⁅R,L⁆ M) := ⟨1⟩

/-- Lie module equivalences are reflexive. -/
@[refl] def refl : M ≃ₗ⁅R,L⁆ M := 1

@[simp] lemma refl_apply (m : M) : (refl : M ≃ₗ⁅R,L⁆ M) m = m := rfl

/-- Lie module equivalences are syemmtric. -/
@[symm] def symm (e : M ≃ₗ⁅R,L⁆ N) : N ≃ₗ⁅R,L⁆ M :=
{ ..lie_module_hom.inverse e.to_lie_module_hom e.inv_fun e.left_inv e.right_inv,
  ..(e : M ≃ₗ[R] N).symm }

@[simp] lemma apply_symm_apply (e : M ≃ₗ⁅R,L⁆ N) : ∀ x, e (e.symm x) = x :=
  e.to_linear_equiv.apply_symm_apply

@[simp] lemma symm_apply_apply (e : M ≃ₗ⁅R,L⁆ N) : ∀ x, e.symm (e x) = x :=
  e.to_linear_equiv.symm_apply_apply

@[simp] lemma symm_symm (e : M ≃ₗ⁅R,L⁆ N) : e.symm.symm = e :=
by { ext, apply_fun e.symm using e.symm.injective, simp, }

/-- Lie module equivalences are transitive. -/
@[trans] def trans (e₁ : M ≃ₗ⁅R,L⁆ N) (e₂ : N ≃ₗ⁅R,L⁆ P) : M ≃ₗ⁅R,L⁆ P :=
{ ..lie_module_hom.comp e₂.to_lie_module_hom e₁.to_lie_module_hom,
  ..linear_equiv.trans e₁.to_linear_equiv e₂.to_linear_equiv }

@[simp] lemma trans_apply (e₁ : M ≃ₗ⁅R,L⁆ N) (e₂ : N ≃ₗ⁅R,L⁆ P) (m : M) :
  (e₁.trans e₂) m = e₂ (e₁ m) := rfl

@[simp] lemma symm_trans (e₁ : M ≃ₗ⁅R,L⁆ N) (e₂ : N ≃ₗ⁅R,L⁆ P) :
  (e₁.trans e₂).symm = e₂.symm.trans e₁.symm := rfl

@[simp] lemma self_trans_symm (e : M ≃ₗ⁅R,L⁆ N) : e.trans e.symm = refl :=
ext _ _ e.symm_apply_apply

@[simp] lemma symm_trans_self (e : M ≃ₗ⁅R,L⁆ N) : e.symm.trans e = refl :=
ext _ _ e.apply_symm_apply

end lie_module_equiv

end lie_module_morphisms


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

import category_theory.arrow
import category_theory.limits.shapes.binary_products

noncomputable theory

open category_theory.limits opposite category_theory.category

namespace category_theory

namespace arrow

variables {C D : Type*} [category C] [category D]

/-- Condition that the image of `f` by `F` is an isomorphism -/
def is_inverted_by (f : arrow C) (F : C ⥤ D) : Prop := is_iso (F.map f.hom)

namespace is_inverted_by

lemma of_is_iso {f : arrow C} {F : C ⥤ D} (h : is_iso (F.map f.hom)) : f.is_inverted_by F := h

end is_inverted_by

lemma congr_left {f g : arrow C} (h : f = g) : f.left = g.left := by rw h
lemma congr_right {f g : arrow C} (h : f = g) : f.right = g.right := by rw h

--lemma mk_eq (f : arrow C) : arrow.mk f.hom = f :=
--by { cases f, dsimp [arrow.mk], refl, }

def mk_iso {f g : arrow C} (e₁ : f.left ≅ g.left) (e₂ : f.right ≅ g.right)
  (fac : e₁.hom ≫ g.hom = f.hom ≫ e₂.hom) :
  f ≅ g :=
{ hom :=
  { left := e₁.hom,
    right := e₂.hom,
    w' := fac, },
  inv :=
  { left := e₁.inv,
    right := e₂.inv,
    w' := begin
      rw [← comp_id f.hom],
      dsimp,
      rw [← e₂.hom_inv_id],
      slice_lhs 2 3 { rw ← fac, },
      slice_lhs 1 2 { rw e₁.inv_hom_id, },
      rw id_comp,
    end, },
  hom_inv_id' := begin
    ext,
    exacts [e₁.hom_inv_id, e₂.hom_inv_id],
  end,
  inv_hom_id' := begin
    ext,
    exacts [e₁.inv_hom_id, e₂.inv_hom_id],
  end, }

@[simps]
def op_prod {C : Type*} [category C] (X Y : C) [has_binary_product X Y]
  [has_binary_coproduct (op X) (op Y)] :
  op (X ⨯ Y) ≅ op X ⨿ op Y :=
begin
  let cofan : binary_cofan (op X) (op Y) :=
    binary_cofan.mk (limits.prod.fst : X ⨯ Y ⟶ X).op ((limits.prod.snd : X ⨯ Y ⟶ Y).op),
  refine (is_colimit.cocone_point_unique_up_to_iso (coprod_is_coprod (op X) (op Y)) (_ : is_colimit cofan)).symm,
  exact
  { desc := λ s, (limits.prod.lift (s.ι.app (discrete.mk walking_pair.left)).unop (s.ι.app (discrete.mk walking_pair.right)).unop).op,
    fac' := λ s j, begin
      cases j,
      cases j; dsimp [cofan],
      { rw [← op_comp, prod.lift_fst, quiver.hom.op_unop], },
      { rw [← op_comp, prod.lift_snd, quiver.hom.op_unop], },
    end,
    uniq' := λ s j hs, begin
      dsimp,
      apply quiver.hom.unop_inj,
      rw quiver.hom.unop_op,
      ext,
      { simp only [prod.lift_fst],
        exact congr_arg quiver.hom.unop (hs (discrete.mk walking_pair.left)), },
      { simp only [prod.lift_snd],
        exact congr_arg quiver.hom.unop (hs (discrete.mk walking_pair.right)), },
    end, },
end

def iso_op_prod_lift {A X Y : C} [has_binary_product X Y]
  [has_binary_coproduct (op X) (op Y)] (f : A ⟶ X) (g : A ⟶ Y) :
  arrow.mk (prod.lift f g).op ≅ arrow.mk (coprod.desc f.op g.op) :=
begin
  symmetry,
  refine mk_iso (op_prod _ _).symm (by refl) _,
  ext,
  { dsimp [limits.is_colimit.cocone_point_unique_up_to_iso, coprod_is_coprod],
    simp only [coprod.inl_desc, id_comp, comp_id, coprod.desc_comp, ← op_comp, prod.lift_fst, comp_id], },
  { dsimp [limits.is_colimit.cocone_point_unique_up_to_iso, coprod_is_coprod],
    simp only [coprod.inr_desc, id_comp, comp_id, coprod.desc_comp, ← op_comp, prod.lift_snd, comp_id], },
end

@[simps]
def unop_prod (X Y : Cᵒᵖ) [has_binary_coproduct X.unop Y.unop] [has_binary_product X Y] :
  unop (X ⨯ Y) ≅ X.unop ⨿ Y.unop :=
begin
  let cofan : binary_cofan X.unop Y.unop :=
    binary_cofan.mk (limits.prod.fst : X ⨯ Y ⟶ X).unop ((limits.prod.snd : X ⨯ Y ⟶ Y)).unop,
  refine (is_colimit.cocone_point_unique_up_to_iso (coprod_is_coprod X.unop Y.unop) (_ : is_colimit cofan)).symm,
  exact
  { desc := λ s, (limits.prod.lift (s.ι.app (discrete.mk walking_pair.left)).op (s.ι.app (discrete.mk walking_pair.right)).op).unop,
    fac' := λ s j, begin
      cases j,
      cases j; dsimp [cofan],
      { rw [← unop_comp, prod.lift_fst, quiver.hom.unop_op], },
      { rw [← unop_comp, prod.lift_snd, quiver.hom.unop_op], },
    end,
    uniq' := λ s j hs, begin
      dsimp,
      apply quiver.hom.op_inj,
      rw quiver.hom.op_unop,
      ext,
      { simp only [prod.lift_fst],
        exact congr_arg quiver.hom.op (hs (discrete.mk walking_pair.left)), },
      { simp only [prod.lift_snd],
        exact congr_arg quiver.hom.op (hs (discrete.mk walking_pair.right)), },
    end, },
end

def iso_unop_prod_lift {A X Y : Cᵒᵖ} [has_binary_product X Y]
  [has_binary_coproduct (unop X) (unop Y)] (f : A ⟶ X) (g : A ⟶ Y) :
  arrow.mk (prod.lift f g).unop ≅ arrow.mk (coprod.desc f.unop g.unop) :=
begin
  symmetry,
  refine mk_iso (unop_prod _ _).symm (by refl) _,
  ext,
  { dsimp [limits.is_colimit.cocone_point_unique_up_to_iso, coprod_is_coprod],
    simp only [id_comp, coprod.desc_comp, coprod.inl_desc, comp_id, ← unop_comp, prod.lift_fst], },
  { dsimp [limits.is_colimit.cocone_point_unique_up_to_iso, coprod_is_coprod],
    simp only [id_comp, coprod.desc_comp, coprod.inr_desc, comp_id, ← unop_comp, prod.lift_snd], },
end

end arrow

end category_theory


class Zero.{u} (α : Type u) where
  zero : α

instance Zero.toOfNat0 {α} [Zero α] : OfNat α (nat_lit 0) where
  ofNat := ‹Zero α›.1

instance Zero.ofOfNat0 {α} [OfNat α (nat_lit 0)] : Zero α where
  zero := 0

class One (α : Type u) where
  one : α

instance One.toOfNat1 {α} [One α] : OfNat α (nat_lit 1) where
  ofNat := ‹One α›.1

instance One.ofOfNat1 {α} [OfNat α (nat_lit 1)] : One α where
  one := 1

theorem ex1 : (@OfNat.ofNat Nat 0 Zero.toOfNat0) = @OfNat.ofNat Nat 1 One.toOfNat1 := by
  refine' congrArg _ (congrArg _ _)
  rfl

example : (@OfNat.ofNat Nat 0 Zero.toOfNat0) = @OfNat.ofNat Nat 1 One.toOfNat1 := by
  apply congrArg
  apply congrArg
  apply rfl

theorem ex2 : (@OfNat.ofNat Nat 0 Zero.toOfNat0) = @OfNat.ofNat Nat 1 One.toOfNat1 := by
  apply congrArg
  apply congrArg
  apply rfl


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group_power.default
import Mathlib.logic.function.iterate
import Mathlib.PostPort

universes u_1 u_3 u_5

namespace Mathlib

/-!
# Iterates of monoid and ring homomorphisms

Iterate of a monoid/ring homomorphism is a monoid/ring homomorphism but it has a wrong type, so Lean
can't apply lemmas like `monoid_hom.map_one` to `f^[n] 1`. Though it is possible to define
a monoid structure on the endomorphisms, quite often we do not want to convert from
`M →* M` to (not yet defined) `monoid.End M` and from `f^[n]` to `f^n` just to apply a simple lemma.

So, we restate standard `*_hom.map_*` lemmas under names `*_hom.iterate_map_*`.

We also prove formulas for iterates of add/mul left/right.

## Tags

homomorphism, iterate
-/

namespace monoid_hom

@[simp] theorem Mathlib.add_monoid_hom.iterate_map_zero {M : Type u_1} [add_monoid M] (f : M →+ M)
    (n : ℕ) : nat.iterate (⇑f) n 0 = 0 :=
  function.iterate_fixed (add_monoid_hom.map_zero f) n

@[simp] theorem iterate_map_mul {M : Type u_1} [monoid M] (f : M →* M) (n : ℕ) (x : M) (y : M) :
    nat.iterate (⇑f) n (x * y) = nat.iterate (⇑f) n x * nat.iterate (⇑f) n y :=
  function.semiconj₂.iterate (map_mul f) n x y

@[simp] theorem iterate_map_inv {G : Type u_3} [group G] (f : G →* G) (n : ℕ) (x : G) :
    nat.iterate (⇑f) n (x⁻¹) = (nat.iterate (⇑f) n x⁻¹) :=
  function.commute.iterate_left (map_inv f) n x

theorem iterate_map_pow {M : Type u_1} [monoid M] (f : M →* M) (a : M) (n : ℕ) (m : ℕ) :
    nat.iterate (⇑f) n (a ^ m) = nat.iterate (⇑f) n a ^ m :=
  function.commute.iterate_left (fun (x : M) => map_pow f x m) n a

theorem iterate_map_gpow {G : Type u_3} [group G] (f : G →* G) (a : G) (n : ℕ) (m : ℤ) :
    nat.iterate (⇑f) n (a ^ m) = nat.iterate (⇑f) n a ^ m :=
  function.commute.iterate_left (fun (x : G) => map_gpow f x m) n a

end monoid_hom

namespace add_monoid_hom

@[simp] theorem iterate_map_sub {G : Type u_3} [add_group G] (f : G →+ G) (n : ℕ) (x : G) (y : G) :
    nat.iterate (⇑f) n (x - y) = nat.iterate (⇑f) n x - nat.iterate (⇑f) n y :=
  function.semiconj₂.iterate (map_sub f) n x y

theorem iterate_map_smul {M : Type u_1} [add_monoid M] (f : M →+ M) (n : ℕ) (m : ℕ) (x : M) :
    nat.iterate (⇑f) n (m •ℕ x) = m •ℕ nat.iterate (⇑f) n x :=
  monoid_hom.iterate_map_pow (coe_fn to_multiplicative f) x n m

theorem iterate_map_gsmul {G : Type u_3} [add_group G] (f : G →+ G) (n : ℕ) (m : ℤ) (x : G) :
    nat.iterate (⇑f) n (m •ℤ x) = m •ℤ nat.iterate (⇑f) n x :=
  monoid_hom.iterate_map_gpow (coe_fn to_multiplicative f) x n m

end add_monoid_hom

namespace ring_hom

theorem coe_pow {R : Type u_5} [semiring R] (f : R →+* R) (n : ℕ) : ⇑(f ^ n) = nat.iterate (⇑f) n :=
  sorry

theorem iterate_map_one {R : Type u_5} [semiring R] (f : R →+* R) (n : ℕ) :
    nat.iterate (⇑f) n 1 = 1 :=
  monoid_hom.iterate_map_one (to_monoid_hom f) n

theorem iterate_map_zero {R : Type u_5} [semiring R] (f : R →+* R) (n : ℕ) :
    nat.iterate (⇑f) n 0 = 0 :=
  add_monoid_hom.iterate_map_zero (to_add_monoid_hom f) n

theorem iterate_map_add {R : Type u_5} [semiring R] (f : R →+* R) (n : ℕ) (x : R) (y : R) :
    nat.iterate (⇑f) n (x + y) = nat.iterate (⇑f) n x + nat.iterate (⇑f) n y :=
  add_monoid_hom.iterate_map_add (to_add_monoid_hom f) n x y

theorem iterate_map_mul {R : Type u_5} [semiring R] (f : R →+* R) (n : ℕ) (x : R) (y : R) :
    nat.iterate (⇑f) n (x * y) = nat.iterate (⇑f) n x * nat.iterate (⇑f) n y :=
  monoid_hom.iterate_map_mul (to_monoid_hom f) n x y

theorem iterate_map_pow {R : Type u_5} [semiring R] (f : R →+* R) (a : R) (n : ℕ) (m : ℕ) :
    nat.iterate (⇑f) n (a ^ m) = nat.iterate (⇑f) n a ^ m :=
  monoid_hom.iterate_map_pow (to_monoid_hom f) a n m

theorem iterate_map_smul {R : Type u_5} [semiring R] (f : R →+* R) (n : ℕ) (m : ℕ) (x : R) :
    nat.iterate (⇑f) n (m •ℕ x) = m •ℕ nat.iterate (⇑f) n x :=
  add_monoid_hom.iterate_map_smul (to_add_monoid_hom f) n m x

theorem iterate_map_sub {R : Type u_5} [ring R] (f : R →+* R) (n : ℕ) (x : R) (y : R) :
    nat.iterate (⇑f) n (x - y) = nat.iterate (⇑f) n x - nat.iterate (⇑f) n y :=
  add_monoid_hom.iterate_map_sub (to_add_monoid_hom f) n x y

theorem iterate_map_neg {R : Type u_5} [ring R] (f : R →+* R) (n : ℕ) (x : R) :
    nat.iterate (⇑f) n (-x) = -nat.iterate (⇑f) n x :=
  add_monoid_hom.iterate_map_neg (to_add_monoid_hom f) n x

theorem iterate_map_gsmul {R : Type u_5} [ring R] (f : R →+* R) (n : ℕ) (m : ℤ) (x : R) :
    nat.iterate (⇑f) n (m •ℤ x) = m •ℤ nat.iterate (⇑f) n x :=
  add_monoid_hom.iterate_map_gsmul (to_add_monoid_hom f) n m x

end ring_hom

@[simp] theorem mul_left_iterate {M : Type u_1} [monoid M] (a : M) (n : ℕ) :
    nat.iterate (Mul.mul a) n = Mul.mul (a ^ n) :=
  sorry

@[simp] theorem add_left_iterate {M : Type u_1} [add_monoid M] (a : M) (n : ℕ) :
    nat.iterate (Add.add a) n = Add.add (n •ℕ a) :=
  mul_left_iterate a n

@[simp] theorem mul_right_iterate {M : Type u_1} [monoid M] (a : M) (n : ℕ) :
    nat.iterate (fun (x : M) => x * a) n = fun (x : M) => x * a ^ n :=
  sorry

@[simp] theorem add_right_iterate {M : Type u_1} [add_monoid M] (a : M) (n : ℕ) :
    nat.iterate (fun (x : M) => x + a) n = fun (x : M) => x + n •ℕ a :=
  mul_right_iterate a n

end Mathlib


/-
Copyright (c) 2022 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang, Eric Wieser
-/
import algebra.graded_monoid

/-!
# Additively-graded multiplicative action structures

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

This module provides a set of heterogeneous typeclasses for defining a multiplicative structure
over the sigma type `graded_monoid A` such that `(•) : A i → M j → M (i + j)`; that is to say, `A`
has an additively-graded multiplicative action on `M`. The typeclasses are:

* `graded_monoid.ghas_smul A M`
* `graded_monoid.gmul_action A M`

With the `sigma_graded` locale open, these respectively imbue:

* `has_smul (graded_monoid A) (graded_monoid M)`
* `mul_action (graded_monoid A) (graded_monoid M)`

For now, these typeclasses are primarily used in the construction of `direct_sum.gmodule.module` and
the rest of that file.

## Internally graded multiplicative actions

In addition to the above typeclasses, in the most frequent case when `A` is an indexed collection of
`set_like` subobjects (such as `add_submonoid`s, `add_subgroup`s, or `submodule`s), this file
provides the `Prop` typeclasses:

* `set_like.has_graded_smul A M` (which provides the obvious `graded_monoid.ghas_smul A` instance)

which provides the API lemma

* `set_like.graded_smul_mem_graded`

Note that there is no need for `set_like.graded_mul_action` or similar, as all the information it
would contain is already supplied by `has_graded_smul` when the objects within `A` and `M` have
a `mul_action` instance.

## tags

graded action
-/

set_option old_structure_cmd true

variables {ι : Type*}

namespace graded_monoid

/-! ### Typeclasses -/
section defs

variables (A : ι → Type*) (M : ι → Type*)

/-- A graded version of `has_smul`. Scalar multiplication combines grades additively, i.e.
if `a ∈ A i` and `m ∈ M j`, then `a • b` must be in `M (i + j)`-/
class ghas_smul [has_add ι] :=
(smul {i j} : A i → M j → M (i + j))

/-- A graded version of `has_mul.to_has_smul` -/
instance ghas_mul.to_ghas_smul [has_add ι] [ghas_mul A] : ghas_smul A A :=
{ smul := λ _ _, ghas_mul.mul }

instance ghas_smul.to_has_smul [has_add ι] [ghas_smul A M] :
  has_smul (graded_monoid A) (graded_monoid M) :=
⟨λ (x : graded_monoid A) (y : graded_monoid M), ⟨_, ghas_smul.smul x.snd y.snd⟩⟩

lemma mk_smul_mk [has_add ι] [ghas_smul A M] {i j} (a : A i) (b : M j) :
  mk i a • mk j b = mk (i + j) (ghas_smul.smul a b) :=
rfl

/-- A graded version of `mul_action`. -/
class gmul_action [add_monoid ι] [gmonoid A] extends ghas_smul A M :=
(one_smul (b : graded_monoid M) : (1 : graded_monoid A) • b = b)
(mul_smul (a a' : graded_monoid A) (b : graded_monoid M) : (a * a') • b = a • a' • b)

/-- The graded version of `monoid.to_mul_action`. -/
instance gmonoid.to_gmul_action [add_monoid ι] [gmonoid A] :
  gmul_action A A :=
{ one_smul := gmonoid.one_mul,
  mul_smul := gmonoid.mul_assoc,
  ..ghas_mul.to_ghas_smul _ }

instance gmul_action.to_mul_action [add_monoid ι] [gmonoid A] [gmul_action A M] :
  mul_action (graded_monoid A) (graded_monoid M) :=
{ one_smul := gmul_action.one_smul,
  mul_smul := gmul_action.mul_smul }

end defs

end graded_monoid

/-! ### Shorthands for creating instance of the above typeclasses for collections of subobjects -/

section subobjects

variables {R : Type*}

/-- A version of `graded_monoid.ghas_smul` for internally graded objects. -/
class set_like.has_graded_smul {S R N M : Type*} [set_like S R] [set_like N M]
  [has_smul R M] [has_add ι] (A : ι → S) (B : ι → N) : Prop :=
(smul_mem : ∀ ⦃i j : ι⦄ {ai bj}, ai ∈ A i → bj ∈ B j → ai • bj ∈ B (i + j))

instance set_like.ghas_smul {S R N M : Type*} [set_like S R] [set_like N M]
  [has_smul R M] [has_add ι] (A : ι → S) (B : ι → N) [set_like.has_graded_smul A B] :
  graded_monoid.ghas_smul (λ i, A i) (λ i, B i) :=
{ smul := λ i j a b, ⟨(a : R) • b, set_like.has_graded_smul.smul_mem a.2 b.2⟩ }

@[simp] lemma set_like.coe_ghas_smul {S R N M : Type*} [set_like S R] [set_like N M]
  [has_smul R M] [has_add ι] (A : ι → S) (B : ι → N) [set_like.has_graded_smul A B]
  {i j : ι} (x : A i) (y : B j) :
  (@graded_monoid.ghas_smul.smul ι (λ i, A i) (λ i, B i) _ _ i j x y : M) = ((x : R) • y) :=
rfl

/-- Internally graded version of `has_mul.to_has_smul`. -/
instance set_like.has_graded_mul.to_has_graded_smul [add_monoid ι] [monoid R]
  {S : Type*} [set_like S R] (A : ι → S) [set_like.graded_monoid A] :
  set_like.has_graded_smul A A :=
{ smul_mem := λ i j ai bj hi hj, set_like.graded_monoid.mul_mem hi hj, }

end subobjects

section homogeneous_elements

variables {S R N M : Type*} [set_like S R] [set_like N M]

lemma set_like.is_homogeneous.graded_smul [has_add ι] [has_smul R M] {A : ι → S} {B : ι → N}
  [set_like.has_graded_smul A B] {a : R} {b : M} :
  set_like.is_homogeneous A a → set_like.is_homogeneous B b → set_like.is_homogeneous B (a • b)
| ⟨i, hi⟩ ⟨j, hj⟩ := ⟨i + j, set_like.has_graded_smul.smul_mem hi hj⟩

end homogeneous_elements


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import category_theory.category.Pointed
import data.pfun

/-!
# The category of types with partial functions

This defines `PartialFun`, the category of types equipped with partial functions.

This category is classically equivalent to the category of pointed types. The reason it doesn't hold
constructively stems from the difference between `part` and `option`. Both can model partial
functions, but the latter forces a decidable domain.

Precisely, `PartialFun_to_Pointed` turns a partial function `α →. β` into a function
`option α → option β` by sending to `none` the undefined values (and `none` to `none`). But being
defined is (generally) undecidable while being sent to `none` is decidable. So it can't be
constructive.

## References

* [nLab, *The category of sets and partial functions*]
  (https://ncatlab.org/nlab/show/partial+function)
-/

open category_theory option

universes u
variables {α β : Type*}

/-- The category of types equipped with partial functions. -/
def PartialFun : Type* := Type*

namespace PartialFun

instance : has_coe_to_sort PartialFun Type* := ⟨id⟩

/-- Turns a type into a `PartialFun`. -/
@[nolint has_nonempty_instance] def of : Type* → PartialFun := id

@[simp] lemma coe_of (X : Type*) : ↥(of X) = X := rfl

instance : inhabited PartialFun := ⟨Type*⟩

instance large_category : large_category.{u} PartialFun :=
{ hom := pfun,
  id := pfun.id,
  comp := λ X Y Z f g, g.comp f,
  id_comp' := @pfun.comp_id,
  comp_id' := @pfun.id_comp,
  assoc' := λ W X Y Z _ _ _, (pfun.comp_assoc _ _ _).symm }

/-- Constructs a partial function isomorphism between types from an equivalence between them. -/
@[simps] def iso.mk {α β : PartialFun.{u}} (e : α ≃ β) : α ≅ β :=
{ hom := e,
  inv := e.symm,
  hom_inv_id' := (pfun.coe_comp _ _).symm.trans $ congr_arg coe e.symm_comp_self,
  inv_hom_id' := (pfun.coe_comp _ _).symm.trans $ congr_arg coe e.self_comp_symm }

end PartialFun

/-- The forgetful functor from `Type` to `PartialFun` which forgets that the maps are total. -/
def Type_to_PartialFun : Type.{u} ⥤ PartialFun :=
{ obj := id,
  map := @pfun.lift,
  map_comp' := λ _ _ _ _ _, pfun.coe_comp _ _ }

instance : faithful Type_to_PartialFun := ⟨λ X Y, pfun.coe_injective⟩

/-- The functor which deletes the point of a pointed type. In return, this makes the maps partial.
This the computable part of the equivalence `PartialFun_equiv_Pointed`. -/
@[simps map] def Pointed_to_PartialFun : Pointed.{u} ⥤ PartialFun :=
{ obj := λ X, {x : X // x ≠ X.point},
  map := λ X Y f, pfun.to_subtype _ f.to_fun ∘ subtype.val,
  map_id' := λ X, pfun.ext $ λ a b,
    pfun.mem_to_subtype_iff.trans (subtype.coe_inj.trans part.mem_some_iff.symm),
  map_comp' := λ X Y Z f g, pfun.ext $ λ a c, begin
    refine (pfun.mem_to_subtype_iff.trans _).trans part.mem_bind_iff.symm,
    simp_rw [pfun.mem_to_subtype_iff, subtype.exists],
    refine ⟨λ h, ⟨f.to_fun a, λ ha, c.2 $ h.trans
      ((congr_arg g.to_fun ha : g.to_fun _ = _).trans g.map_point), rfl, h⟩, _⟩,
    rintro ⟨b, _, (rfl : b = _), h⟩,
    exact h,
  end }

/-- The functor which maps undefined values to a new point. This makes the maps total and creates
pointed types. This the noncomputable part of the equivalence `PartialFun_equiv_Pointed`. It can't
be computable because `= option.none` is decidable while the domain of a general `part` isn't. -/
@[simps map] noncomputable def PartialFun_to_Pointed : PartialFun ⥤ Pointed :=
by classical; exact
{ obj := λ X, ⟨option X, none⟩,
  map := λ X Y f, ⟨option.elim none (λ a, (f a).to_option), rfl⟩,
  map_id' := λ X, Pointed.hom.ext _ _ $ funext $ λ o,
    option.rec_on o rfl $ λ a, part.some_to_option _,
  map_comp' := λ X Y Z f g, Pointed.hom.ext _ _ $ funext $ λ o, option.rec_on o rfl $ λ a,
    part.bind_to_option _ _ }

/-- The equivalence induced by `PartialFun_to_Pointed` and `Pointed_to_PartialFun`.
`part.equiv_option` made functorial. -/
@[simps] noncomputable def PartialFun_equiv_Pointed : PartialFun.{u} ≌ Pointed :=
by classical; exact
equivalence.mk PartialFun_to_Pointed Pointed_to_PartialFun
  (nat_iso.of_components (λ X, PartialFun.iso.mk
    { to_fun := λ a, ⟨some a, some_ne_none a⟩,
      inv_fun := λ a, get $ ne_none_iff_is_some.1 a.2,
      left_inv := λ a, get_some _ _,
      right_inv := λ a, by simp only [subtype.val_eq_coe, some_get, subtype.coe_eta] }) $ λ X Y f,
      pfun.ext $ λ a b, begin
        unfold_projs,
        dsimp,
        rw part.bind_some,
        refine (part.mem_bind_iff.trans _).trans pfun.mem_to_subtype_iff.symm,
        obtain ⟨b | b, hb⟩ := b,
        { exact (hb rfl).elim },
        dsimp,
        simp_rw [part.mem_some_iff, subtype.mk_eq_mk, exists_prop, some_inj, exists_eq_right'],
        refine part.mem_to_option.symm.trans _,
        exact eq_comm,
      end)
  (nat_iso.of_components (λ X, Pointed.iso.mk
    { to_fun := option.elim X.point subtype.val,
      inv_fun := λ a, if h : a = X.point then none else some ⟨_, h⟩,
      left_inv := λ a, option.rec_on a (dif_pos rfl) $ λ a, (dif_neg a.2).trans $
        by simp only [option.elim, subtype.val_eq_coe, subtype.coe_eta],
      right_inv := λ a, begin
        change option.elim _ _ (dite _ _ _) = _,
        split_ifs,
        { rw h, refl },
        { refl }
      end } rfl) $ λ X Y f, Pointed.hom.ext _ _ $ funext $ λ a, option.rec_on a f.map_point.symm $
    λ a, begin
      unfold_projs,
      dsimp,
      change option.elim _ _ _ = _,
      rw part.elim_to_option,
      split_ifs,
      { refl },
      { exact eq.symm (of_not_not h) }
    end)

/-- Forgetting that maps are total and making them total again by adding a point is the same as just
adding a point. -/
@[simps] noncomputable def Type_to_PartialFun_iso_PartialFun_to_Pointed :
  Type_to_PartialFun ⋙ PartialFun_to_Pointed ≅ Type_to_Pointed :=
nat_iso.of_components (λ X, { hom := ⟨id, rfl⟩,
                              inv := ⟨id, rfl⟩,
                              hom_inv_id' := rfl,
                              inv_hom_id' := rfl }) $ λ X Y f,
  Pointed.hom.ext _ _ $ funext $ λ a, option.rec_on a rfl $ λ a, by convert part.some_to_option _


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta
-/
import category_theory.limits.shapes.terminal
import category_theory.discrete_category
import category_theory.epi_mono
import category_theory.over

/-!
# Binary (co)products

We define a category `walking_pair`, which is the index category
for a binary (co)product diagram. A convenience method `pair X Y`
constructs the functor from the walking pair, hitting the given objects.

We define `prod X Y` and `coprod X Y` as limits and colimits of such functors.

Typeclasses `has_binary_products` and `has_binary_coproducts` assert the existence
of (co)limits shaped as walking pairs.

We include lemmas for simplifying equations involving projections and coprojections, and define
braiding and associating isomorphisms, and the product comparison morphism.

## References
* [Stacks: Products of pairs](https://stacks.math.columbia.edu/tag/001R)
* [Stacks: coproducts of pairs](https://stacks.math.columbia.edu/tag/04AN)
-/

noncomputable theory

universes v u u₂

open category_theory

namespace category_theory.limits

/-- The type of objects for the diagram indexing a binary (co)product. -/
@[derive decidable_eq, derive inhabited]
inductive walking_pair : Type v
| left | right

open walking_pair

/--
The equivalence swapping left and right.
-/
def walking_pair.swap : walking_pair ≃ walking_pair :=
{ to_fun := λ j, walking_pair.rec_on j right left,
  inv_fun := λ j, walking_pair.rec_on j right left,
  left_inv := λ j, by { cases j; refl, },
  right_inv := λ j, by { cases j; refl, }, }

@[simp] lemma walking_pair.swap_apply_left : walking_pair.swap left = right := rfl
@[simp] lemma walking_pair.swap_apply_right : walking_pair.swap right = left := rfl
@[simp] lemma walking_pair.swap_symm_apply_tt : walking_pair.swap.symm left = right := rfl
@[simp] lemma walking_pair.swap_symm_apply_ff : walking_pair.swap.symm right = left := rfl

/--
An equivalence from `walking_pair` to `bool`, sometimes useful when reindexing limits.
-/
def walking_pair.equiv_bool : walking_pair ≃ bool :=
{ to_fun := λ j, walking_pair.rec_on j tt ff, -- to match equiv.sum_equiv_sigma_bool
  inv_fun := λ b, bool.rec_on b right left,
  left_inv := λ j, by { cases j; refl, },
  right_inv := λ b, by { cases b; refl, }, }

@[simp] lemma walking_pair.equiv_bool_apply_left : walking_pair.equiv_bool left = tt := rfl
@[simp] lemma walking_pair.equiv_bool_apply_right : walking_pair.equiv_bool right = ff := rfl
@[simp] lemma walking_pair.equiv_bool_symm_apply_tt : walking_pair.equiv_bool.symm tt = left := rfl
@[simp] lemma walking_pair.equiv_bool_symm_apply_ff : walking_pair.equiv_bool.symm ff = right := rfl

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

/-- The diagram on the walking pair, sending the two points to `X` and `Y`. -/
def pair (X Y : C) : discrete walking_pair ⥤ C :=
discrete.functor (λ j, walking_pair.cases_on j X Y)

@[simp] lemma pair_obj_left (X Y : C) : (pair X Y).obj left = X := rfl
@[simp] lemma pair_obj_right (X Y : C) : (pair X Y).obj right = Y := rfl

section
variables {F G : discrete walking_pair.{v} ⥤ C} (f : F.obj left ⟶ G.obj left)
  (g : F.obj right ⟶ G.obj right)

/-- The natural transformation between two functors out of the walking pair, specified by its
components. -/
def map_pair : F ⟶ G := { app := λ j, walking_pair.cases_on j f g }

@[simp] lemma map_pair_left : (map_pair f g).app left = f := rfl
@[simp] lemma map_pair_right : (map_pair f g).app right = g := rfl

/-- The natural isomorphism between two functors out of the walking pair, specified by its
components. -/
@[simps]
def map_pair_iso (f : F.obj left ≅ G.obj left) (g : F.obj right ≅ G.obj right) : F ≅ G :=
nat_iso.of_components (λ j, walking_pair.cases_on j f g) (by tidy)

end

/-- Every functor out of the walking pair is naturally isomorphic (actually, equal) to a `pair` -/
@[simps]
def diagram_iso_pair (F : discrete walking_pair ⥤ C) :
  F ≅ pair (F.obj walking_pair.left) (F.obj walking_pair.right) :=
map_pair_iso (iso.refl _) (iso.refl _)

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

/-- The natural isomorphism between `pair X Y ⋙ F` and `pair (F.obj X) (F.obj Y)`. -/
def pair_comp (X Y : C) (F : C ⥤ D) : pair X Y ⋙ F ≅ pair (F.obj X) (F.obj Y) :=
diagram_iso_pair _

end

/-- A binary fan is just a cone on a diagram indexing a product. -/
abbreviation binary_fan (X Y : C) := cone (pair X Y)

/-- The first projection of a binary fan. -/
abbreviation binary_fan.fst {X Y : C} (s : binary_fan X Y) := s.π.app walking_pair.left

/-- The second projection of a binary fan. -/
abbreviation binary_fan.snd {X Y : C} (s : binary_fan X Y) := s.π.app walking_pair.right

@[simp] lemma binary_fan.π_app_left {X Y : C} (s : binary_fan X Y) :
  s.π.app walking_pair.left = s.fst := rfl
@[simp] lemma binary_fan.π_app_right {X Y : C} (s : binary_fan X Y) :
  s.π.app walking_pair.right = s.snd := rfl

lemma binary_fan.is_limit.hom_ext {W X Y : C} {s : binary_fan X Y} (h : is_limit s)
  {f g : W ⟶ s.X} (h₁ : f ≫ s.fst = g ≫ s.fst) (h₂ : f ≫ s.snd = g ≫ s.snd) : f = g :=
h.hom_ext $ λ j, walking_pair.cases_on j h₁ h₂

/-- A binary cofan is just a cocone on a diagram indexing a coproduct. -/
abbreviation binary_cofan (X Y : C) := cocone (pair X Y)

/-- The first inclusion of a binary cofan. -/
abbreviation binary_cofan.inl {X Y : C} (s : binary_cofan X Y) := s.ι.app walking_pair.left

/-- The second inclusion of a binary cofan. -/
abbreviation binary_cofan.inr {X Y : C} (s : binary_cofan X Y) := s.ι.app walking_pair.right

@[simp] lemma binary_cofan.ι_app_left {X Y : C} (s : binary_cofan X Y) :
  s.ι.app walking_pair.left = s.inl := rfl
@[simp] lemma binary_cofan.ι_app_right {X Y : C} (s : binary_cofan X Y) :
  s.ι.app walking_pair.right = s.inr := rfl

lemma binary_cofan.is_colimit.hom_ext {W X Y : C} {s : binary_cofan X Y} (h : is_colimit s)
  {f g : s.X ⟶ W} (h₁ : s.inl ≫ f = s.inl ≫ g) (h₂ : s.inr ≫ f = s.inr ≫ g) : f = g :=
h.hom_ext $ λ j, walking_pair.cases_on j h₁ h₂

variables {X Y : C}

/-- A binary fan with vertex `P` consists of the two projections `π₁ : P ⟶ X` and `π₂ : P ⟶ Y`. -/
@[simps X]
def binary_fan.mk {P : C} (π₁ : P ⟶ X) (π₂ : P ⟶ Y) : binary_fan X Y :=
{ X := P,
  π := { app := λ j, walking_pair.cases_on j π₁ π₂ }}

/-- A binary cofan with vertex `P` consists of the two inclusions `ι₁ : X ⟶ P` and `ι₂ : Y ⟶ P`. -/
@[simps X]
def binary_cofan.mk {P : C} (ι₁ : X ⟶ P) (ι₂ : Y ⟶ P) : binary_cofan X Y :=
{ X := P,
  ι := { app := λ j, walking_pair.cases_on j ι₁ ι₂ }}

@[simp] lemma binary_fan.mk_π_app_left {P : C} (π₁ : P ⟶ X) (π₂ : P ⟶ Y) :
  (binary_fan.mk π₁ π₂).π.app walking_pair.left = π₁ := rfl
@[simp] lemma binary_fan.mk_π_app_right {P : C} (π₁ : P ⟶ X) (π₂ : P ⟶ Y) :
  (binary_fan.mk π₁ π₂).π.app walking_pair.right = π₂ := rfl
@[simp] lemma binary_cofan.mk_ι_app_left {P : C} (ι₁ : X ⟶ P) (ι₂ : Y ⟶ P) :
  (binary_cofan.mk ι₁ ι₂).ι.app walking_pair.left = ι₁ := rfl
@[simp] lemma binary_cofan.mk_ι_app_right {P : C} (ι₁ : X ⟶ P) (ι₂ : Y ⟶ P) :
  (binary_cofan.mk ι₁ ι₂).ι.app walking_pair.right = ι₂ := rfl

/-- If `s` is a limit binary fan over `X` and `Y`, then every pair of morphisms `f : W ⟶ X` and
    `g : W ⟶ Y` induces a morphism `l : W ⟶ s.X` satisfying `l ≫ s.fst = f` and `l ≫ s.snd = g`.
    -/
@[simps]
def binary_fan.is_limit.lift' {W X Y : C} {s : binary_fan X Y} (h : is_limit s) (f : W ⟶ X)
  (g : W ⟶ Y) : {l : W ⟶ s.X // l ≫ s.fst = f ∧ l ≫ s.snd = g} :=
⟨h.lift $ binary_fan.mk f g, h.fac _ _, h.fac _ _⟩

/-- If `s` is a colimit binary cofan over `X` and `Y`,, then every pair of morphisms `f : X ⟶ W` and
    `g : Y ⟶ W` induces a morphism `l : s.X ⟶ W` satisfying `s.inl ≫ l = f` and `s.inr ≫ l = g`.
    -/
@[simps]
def binary_cofan.is_colimit.desc' {W X Y : C} {s : binary_cofan X Y} (h : is_colimit s) (f : X ⟶ W)
  (g : Y ⟶ W) : {l : s.X ⟶ W // s.inl ≫ l = f ∧ s.inr ≫ l = g} :=
⟨h.desc $ binary_cofan.mk f g, h.fac _ _, h.fac _ _⟩

/-- An abbreviation for `has_limit (pair X Y)`. -/
abbreviation has_binary_product (X Y : C) := has_limit (pair X Y)
/-- An abbreviation for `has_colimit (pair X Y)`. -/
abbreviation has_binary_coproduct (X Y : C) := has_colimit (pair X Y)

/-- If we have a product of `X` and `Y`, we can access it using `prod X Y` or
    `X ⨯ Y`. -/
abbreviation prod (X Y : C) [has_binary_product X Y] := limit (pair X Y)

/-- If we have a coproduct of `X` and `Y`, we can access it using `coprod X Y ` or
    `X ⨿ Y`. -/
abbreviation coprod (X Y : C) [has_binary_coproduct X Y] := colimit (pair X Y)

notation X ` ⨯ `:20 Y:20 := prod X Y
notation X ` ⨿ `:20 Y:20 := coprod X Y

/-- The projection map to the first component of the product. -/
abbreviation prod.fst {X Y : C} [has_binary_product X Y] : X ⨯ Y ⟶ X :=
limit.π (pair X Y) walking_pair.left

/-- The projecton map to the second component of the product. -/
abbreviation prod.snd {X Y : C} [has_binary_product X Y] : X ⨯ Y ⟶ Y :=
limit.π (pair X Y) walking_pair.right

/-- The inclusion map from the first component of the coproduct. -/
abbreviation coprod.inl {X Y : C} [has_binary_coproduct X Y] : X ⟶ X ⨿ Y :=
colimit.ι (pair X Y) walking_pair.left

/-- The inclusion map from the second component of the coproduct. -/
abbreviation coprod.inr {X Y : C} [has_binary_coproduct X Y] : Y ⟶ X ⨿ Y :=
colimit.ι (pair X Y) walking_pair.right

/-- The binary fan constructed from the projection maps is a limit. -/
def prod_is_prod (X Y : C) [has_binary_product X Y] :
  is_limit (binary_fan.mk (prod.fst : X ⨯ Y ⟶ X) prod.snd) :=
(limit.is_limit _).of_iso_limit (cones.ext (iso.refl _) (by { rintro (_ | _), tidy }))

/-- The binary cofan constructed from the coprojection maps is a colimit. -/
def coprod_is_coprod (X Y : C) [has_binary_coproduct X Y] :
  is_colimit (binary_cofan.mk (coprod.inl : X ⟶ X ⨿ Y) coprod.inr) :=
(colimit.is_colimit _).of_iso_colimit (cocones.ext (iso.refl _) (by { rintro (_ | _), tidy }))

@[ext] lemma prod.hom_ext {W X Y : C} [has_binary_product X Y] {f g : W ⟶ X ⨯ Y}
  (h₁ : f ≫ prod.fst = g ≫ prod.fst) (h₂ : f ≫ prod.snd = g ≫ prod.snd) : f = g :=
binary_fan.is_limit.hom_ext (limit.is_limit _) h₁ h₂

@[ext] lemma coprod.hom_ext {W X Y : C} [has_binary_coproduct X Y] {f g : X ⨿ Y ⟶ W}
  (h₁ : coprod.inl ≫ f = coprod.inl ≫ g) (h₂ : coprod.inr ≫ f = coprod.inr ≫ g) : f = g :=
binary_cofan.is_colimit.hom_ext (colimit.is_colimit _) h₁ h₂

/-- If the product of `X` and `Y` exists, then every pair of morphisms `f : W ⟶ X` and `g : W ⟶ Y`
    induces a morphism `prod.lift f g : W ⟶ X ⨯ Y`. -/
abbreviation prod.lift {W X Y : C} [has_binary_product X Y] (f : W ⟶ X) (g : W ⟶ Y) : W ⟶ X ⨯ Y :=
limit.lift _ (binary_fan.mk f g)

/-- diagonal arrow of the binary product in the category `fam I` -/
abbreviation diag (X : C) [has_binary_product X X] : X ⟶ X ⨯ X :=
prod.lift (𝟙 _) (𝟙 _)

/-- If the coproduct of `X` and `Y` exists, then every pair of morphisms `f : X ⟶ W` and
    `g : Y ⟶ W` induces a morphism `coprod.desc f g : X ⨿ Y ⟶ W`. -/
abbreviation coprod.desc {W X Y : C} [has_binary_coproduct X Y] (f : X ⟶ W) (g : Y ⟶ W) :
  X ⨿ Y ⟶ W :=
colimit.desc _ (binary_cofan.mk f g)

/-- codiagonal arrow of the binary coproduct -/
abbreviation codiag (X : C) [has_binary_coproduct X X] : X ⨿ X ⟶ X :=
coprod.desc (𝟙 _) (𝟙 _)

@[simp, reassoc]
lemma prod.lift_fst {W X Y : C} [has_binary_product X Y] (f : W ⟶ X) (g : W ⟶ Y) :
  prod.lift f g ≫ prod.fst = f :=
limit.lift_π _ _

@[simp, reassoc]
lemma prod.lift_snd {W X Y : C} [has_binary_product X Y] (f : W ⟶ X) (g : W ⟶ Y) :
  prod.lift f g ≫ prod.snd = g :=
limit.lift_π _ _

-- The simp linter says simp can prove the reassoc version of this lemma.
@[reassoc, simp]
lemma coprod.inl_desc {W X Y : C} [has_binary_coproduct X Y] (f : X ⟶ W) (g : Y ⟶ W) :
  coprod.inl ≫ coprod.desc f g = f :=
colimit.ι_desc _ _

-- The simp linter says simp can prove the reassoc version of this lemma.
@[reassoc, simp]
lemma coprod.inr_desc {W X Y : C} [has_binary_coproduct X Y] (f : X ⟶ W) (g : Y ⟶ W) :
  coprod.inr ≫ coprod.desc f g = g :=
colimit.ι_desc _ _

instance prod.mono_lift_of_mono_left {W X Y : C} [has_binary_product X Y] (f : W ⟶ X) (g : W ⟶ Y)
  [mono f] : mono (prod.lift f g) :=
mono_of_mono_fac $ prod.lift_fst _ _

instance prod.mono_lift_of_mono_right {W X Y : C} [has_binary_product X Y] (f : W ⟶ X) (g : W ⟶ Y)
  [mono g] : mono (prod.lift f g) :=
mono_of_mono_fac $ prod.lift_snd _ _

instance coprod.epi_desc_of_epi_left {W X Y : C} [has_binary_coproduct X Y] (f : X ⟶ W) (g : Y ⟶ W)
  [epi f] : epi (coprod.desc f g) :=
epi_of_epi_fac $ coprod.inl_desc _ _

instance coprod.epi_desc_of_epi_right {W X Y : C} [has_binary_coproduct X Y] (f : X ⟶ W) (g : Y ⟶ W)
  [epi g] : epi (coprod.desc f g) :=
epi_of_epi_fac $ coprod.inr_desc _ _

/-- If the product of `X` and `Y` exists, then every pair of morphisms `f : W ⟶ X` and `g : W ⟶ Y`
    induces a morphism `l : W ⟶ X ⨯ Y` satisfying `l ≫ prod.fst = f` and `l ≫ prod.snd = g`. -/
def prod.lift' {W X Y : C} [has_binary_product X Y] (f : W ⟶ X) (g : W ⟶ Y) :
  {l : W ⟶ X ⨯ Y // l ≫ prod.fst = f ∧ l ≫ prod.snd = g} :=
⟨prod.lift f g, prod.lift_fst _ _, prod.lift_snd _ _⟩

/-- If the coproduct of `X` and `Y` exists, then every pair of morphisms `f : X ⟶ W` and
    `g : Y ⟶ W` induces a morphism `l : X ⨿ Y ⟶ W` satisfying `coprod.inl ≫ l = f` and
    `coprod.inr ≫ l = g`. -/
def coprod.desc' {W X Y : C} [has_binary_coproduct X Y] (f : X ⟶ W) (g : Y ⟶ W) :
  {l : X ⨿ Y ⟶ W // coprod.inl ≫ l = f ∧ coprod.inr ≫ l = g} :=
⟨coprod.desc f g, coprod.inl_desc _ _, coprod.inr_desc _ _⟩

/-- If the products `W ⨯ X` and `Y ⨯ Z` exist, then every pair of morphisms `f : W ⟶ Y` and
    `g : X ⟶ Z` induces a morphism `prod.map f g : W ⨯ X ⟶ Y ⨯ Z`. -/
def prod.map {W X Y Z : C} [has_binary_product W X] [has_binary_product Y Z]
  (f : W ⟶ Y) (g : X ⟶ Z) : W ⨯ X ⟶ Y ⨯ Z :=
lim_map (map_pair f g)

/-- If the coproducts `W ⨿ X` and `Y ⨿ Z` exist, then every pair of morphisms `f : W ⟶ Y` and
    `g : W ⟶ Z` induces a morphism `coprod.map f g : W ⨿ X ⟶ Y ⨿ Z`. -/
def coprod.map {W X Y Z : C} [has_binary_coproduct W X] [has_binary_coproduct Y Z]
  (f : W ⟶ Y) (g : X ⟶ Z) : W ⨿ X ⟶ Y ⨿ Z :=
colim_map (map_pair f g)

section prod_lemmas

-- Making the reassoc version of this a simp lemma seems to be more harmful than helpful.
@[reassoc, simp]
lemma prod.comp_lift {V W X Y : C} [has_binary_product X Y] (f : V ⟶ W) (g : W ⟶ X) (h : W ⟶ Y) :
  f ≫ prod.lift g h = prod.lift (f ≫ g) (f ≫ h) :=
by { ext; simp }

lemma prod.comp_diag {X Y : C} [has_binary_product Y Y] (f : X ⟶ Y) :
  f ≫ diag Y = prod.lift f f :=
by simp

@[simp, reassoc]
lemma prod.map_fst {W X Y Z : C} [has_binary_product W X] [has_binary_product Y Z]
  (f : W ⟶ Y) (g : X ⟶ Z) : prod.map f g ≫ prod.fst = prod.fst ≫ f :=
lim_map_π _ _

@[simp, reassoc]
lemma prod.map_snd {W X Y Z : C} [has_binary_product W X] [has_binary_product Y Z]
  (f : W ⟶ Y) (g : X ⟶ Z) : prod.map f g ≫ prod.snd = prod.snd ≫ g :=
lim_map_π _ _

@[simp] lemma prod.map_id_id {X Y : C} [has_binary_product X Y] :
  prod.map (𝟙 X) (𝟙 Y) = 𝟙 _ :=
by { ext; simp }

@[simp] lemma prod.lift_fst_snd {X Y : C} [has_binary_product X Y] :
  prod.lift prod.fst prod.snd = 𝟙 (X ⨯ Y) :=
by { ext; simp }

@[simp, reassoc] lemma prod.lift_map {V W X Y Z : C} [has_binary_product W X]
  [has_binary_product Y Z] (f : V ⟶ W) (g : V ⟶ X) (h : W ⟶ Y) (k : X ⟶ Z) :
  prod.lift f g ≫ prod.map h k = prod.lift (f ≫ h) (g ≫ k) :=
by { ext; simp }

@[simp] lemma prod.lift_fst_comp_snd_comp {W X Y Z : C} [has_binary_product W Y]
  [has_binary_product X Z] (g : W ⟶ X) (g' : Y ⟶ Z) :
  prod.lift (prod.fst ≫ g) (prod.snd ≫ g') = prod.map g g' :=
by { rw ← prod.lift_map, simp }

-- We take the right hand side here to be simp normal form, as this way composition lemmas for
-- `f ≫ h` and `g ≫ k` can fire (eg `id_comp`) , while `map_fst` and `map_snd` can still work just
-- as well.
@[simp, reassoc]
lemma prod.map_map {A₁ A₂ A₃ B₁ B₂ B₃ : C}
  [has_binary_product A₁ B₁] [has_binary_product A₂ B₂] [has_binary_product A₃ B₃]
  (f : A₁ ⟶ A₂) (g : B₁ ⟶ B₂) (h : A₂ ⟶ A₃) (k : B₂ ⟶ B₃) :
  prod.map f g ≫ prod.map h k = prod.map (f ≫ h) (g ≫ k) :=
by { ext; simp }

-- TODO: is it necessary to weaken the assumption here?
@[reassoc]
lemma prod.map_swap {A B X Y : C} (f : A ⟶ B) (g : X ⟶ Y)
  [has_limits_of_shape (discrete walking_pair) C] :
  prod.map (𝟙 X) f ≫ prod.map g (𝟙 B) = prod.map g (𝟙 A) ≫ prod.map (𝟙 Y) f :=
by simp

@[reassoc] lemma prod.map_comp_id {X Y Z W : C} (f : X ⟶ Y) (g : Y ⟶ Z)
  [has_binary_product X W] [has_binary_product Z W] [has_binary_product Y W] :
  prod.map (f ≫ g) (𝟙 W) = prod.map f (𝟙 W) ≫ prod.map g (𝟙 W) :=
by simp

@[reassoc] lemma prod.map_id_comp {X Y Z W : C} (f : X ⟶ Y) (g : Y ⟶ Z)
  [has_binary_product W X] [has_binary_product W Y] [has_binary_product W Z] :
  prod.map (𝟙 W) (f ≫ g) = prod.map (𝟙 W) f ≫ prod.map (𝟙 W) g :=
by simp

/-- If the products `W ⨯ X` and `Y ⨯ Z` exist, then every pair of isomorphisms `f : W ≅ Y` and
    `g : X ≅ Z` induces an isomorphism `prod.map_iso f g : W ⨯ X ≅ Y ⨯ Z`. -/
@[simps]
def prod.map_iso {W X Y Z : C} [has_binary_product W X] [has_binary_product Y Z]
  (f : W ≅ Y) (g : X ≅ Z) : W ⨯ X ≅ Y ⨯ Z :=
{ hom := prod.map f.hom g.hom,
  inv := prod.map f.inv g.inv }

instance is_iso_prod {W X Y Z : C} [has_binary_product W X] [has_binary_product Y Z]
  (f : W ⟶ Y) (g : X ⟶ Z) [is_iso f] [is_iso g] : is_iso (prod.map f g) :=
is_iso.of_iso (prod.map_iso (as_iso f) (as_iso g))

@[simp, reassoc]
lemma prod.diag_map {X Y : C} (f : X ⟶ Y) [has_binary_product X X] [has_binary_product Y Y] :
  diag X ≫ prod.map f f = f ≫ diag Y :=
by simp

@[simp, reassoc]
lemma prod.diag_map_fst_snd {X Y : C} [has_binary_product X Y]
  [has_binary_product (X ⨯ Y) (X ⨯ Y)] :
  diag (X ⨯ Y) ≫ prod.map prod.fst prod.snd = 𝟙 (X ⨯ Y) :=
by simp

@[simp, reassoc]
lemma prod.diag_map_fst_snd_comp  [has_limits_of_shape (discrete walking_pair) C]
  {X X' Y Y' : C} (g : X ⟶ Y) (g' : X' ⟶ Y') :
  diag (X ⨯ X') ≫ prod.map (prod.fst ≫ g) (prod.snd ≫ g') = prod.map g g' :=
by simp

instance {X : C} [has_binary_product X X] : split_mono (diag X) :=
{ retraction := prod.fst }

end prod_lemmas

section coprod_lemmas

@[simp, reassoc]
lemma coprod.desc_comp {V W X Y : C} [has_binary_coproduct X Y] (f : V ⟶ W) (g : X ⟶ V)
  (h : Y ⟶ V) :
  coprod.desc g h ≫ f = coprod.desc (g ≫ f) (h ≫ f) :=
by { ext; simp }

lemma coprod.diag_comp {X Y : C} [has_binary_coproduct X X] (f : X ⟶ Y) :
  codiag X ≫ f = coprod.desc f f :=
by simp

@[simp, reassoc]
lemma coprod.inl_map {W X Y Z : C} [has_binary_coproduct W X] [has_binary_coproduct Y Z]
  (f : W ⟶ Y) (g : X ⟶ Z) : coprod.inl ≫ coprod.map f g = f ≫ coprod.inl :=
ι_colim_map _ _

@[simp, reassoc]
lemma coprod.inr_map {W X Y Z : C} [has_binary_coproduct W X] [has_binary_coproduct Y Z]
  (f : W ⟶ Y) (g : X ⟶ Z) : coprod.inr ≫ coprod.map f g = g ≫ coprod.inr :=
ι_colim_map _ _

@[simp]
lemma coprod.map_id_id {X Y : C} [has_binary_coproduct X Y] :
  coprod.map (𝟙 X) (𝟙 Y) = 𝟙 _ :=
by { ext; simp }

@[simp]
lemma coprod.desc_inl_inr {X Y : C} [has_binary_coproduct X Y] :
  coprod.desc coprod.inl coprod.inr = 𝟙 (X ⨿ Y) :=
by { ext; simp }

-- The simp linter says simp can prove the reassoc version of this lemma.
@[reassoc, simp]
lemma coprod.map_desc {S T U V W : C} [has_binary_coproduct U W] [has_binary_coproduct T V]
  (f : U ⟶ S) (g : W ⟶ S) (h : T ⟶ U) (k : V ⟶ W) :
  coprod.map h k ≫ coprod.desc f g = coprod.desc (h ≫ f) (k ≫ g) :=
by { ext; simp }

@[simp]
lemma coprod.desc_comp_inl_comp_inr {W X Y Z : C}
  [has_binary_coproduct W Y] [has_binary_coproduct X Z]
  (g : W ⟶ X) (g' : Y ⟶ Z) :
  coprod.desc (g ≫ coprod.inl) (g' ≫ coprod.inr) = coprod.map g g' :=
by { rw ← coprod.map_desc, simp }

-- We take the right hand side here to be simp normal form, as this way composition lemmas for
-- `f ≫ h` and `g ≫ k` can fire (eg `id_comp`) , while `inl_map` and `inr_map` can still work just
-- as well.
@[simp, reassoc]
lemma coprod.map_map {A₁ A₂ A₃ B₁ B₂ B₃ : C}
  [has_binary_coproduct A₁ B₁] [has_binary_coproduct A₂ B₂] [has_binary_coproduct A₃ B₃]
  (f : A₁ ⟶ A₂) (g : B₁ ⟶ B₂) (h : A₂ ⟶ A₃) (k : B₂ ⟶ B₃) :
  coprod.map f g ≫ coprod.map h k = coprod.map (f ≫ h) (g ≫ k) :=
by { ext; simp }

-- I don't think it's a good idea to make any of the following three simp lemmas.
@[reassoc]
lemma coprod.map_swap {A B X Y : C} (f : A ⟶ B) (g : X ⟶ Y)
  [has_colimits_of_shape (discrete walking_pair) C] :
  coprod.map (𝟙 X) f ≫ coprod.map g (𝟙 B) = coprod.map g (𝟙 A) ≫ coprod.map (𝟙 Y) f :=
by simp

@[reassoc] lemma coprod.map_comp_id {X Y Z W : C} (f : X ⟶ Y) (g : Y ⟶ Z)
  [has_binary_coproduct Z W] [has_binary_coproduct Y W] [has_binary_coproduct X W] :
  coprod.map (f ≫ g) (𝟙 W) = coprod.map f (𝟙 W) ≫ coprod.map g (𝟙 W) :=
by simp

@[reassoc] lemma coprod.map_id_comp {X Y Z W : C} (f : X ⟶ Y) (g : Y ⟶ Z)
  [has_binary_coproduct W X] [has_binary_coproduct W Y] [has_binary_coproduct W Z] :
  coprod.map (𝟙 W) (f ≫ g) = coprod.map (𝟙 W) f ≫ coprod.map (𝟙 W) g :=
by simp

/-- If the coproducts `W ⨿ X` and `Y ⨿ Z` exist, then every pair of isomorphisms `f : W ≅ Y` and
    `g : W ≅ Z` induces a isomorphism `coprod.map_iso f g : W ⨿ X ≅ Y ⨿ Z`. -/
@[simps]
def coprod.map_iso {W X Y Z : C} [has_binary_coproduct W X] [has_binary_coproduct Y Z]
  (f : W ≅ Y) (g : X ≅ Z) : W ⨿ X ≅ Y ⨿ Z :=
{ hom := coprod.map f.hom g.hom,
  inv := coprod.map f.inv g.inv }

instance is_iso_coprod {W X Y Z : C} [has_binary_coproduct W X] [has_binary_coproduct Y Z]
  (f : W ⟶ Y) (g : X ⟶ Z) [is_iso f] [is_iso g] : is_iso (coprod.map f g) :=
is_iso.of_iso (coprod.map_iso (as_iso f) (as_iso g))

-- The simp linter says simp can prove the reassoc version of this lemma.
@[reassoc, simp]
lemma coprod.map_codiag {X Y : C} (f : X ⟶ Y) [has_binary_coproduct X X]
  [has_binary_coproduct Y Y] :
  coprod.map f f ≫ codiag Y = codiag X ≫ f :=
by simp

-- The simp linter says simp can prove the reassoc version of this lemma.
@[reassoc, simp]
lemma coprod.map_inl_inr_codiag {X Y : C} [has_binary_coproduct X Y]
  [has_binary_coproduct (X ⨿ Y) (X ⨿ Y)] :
  coprod.map coprod.inl coprod.inr ≫ codiag (X ⨿ Y) = 𝟙 (X ⨿ Y) :=
by simp

-- The simp linter says simp can prove the reassoc version of this lemma.
@[reassoc, simp]
lemma coprod.map_comp_inl_inr_codiag [has_colimits_of_shape (discrete walking_pair) C]
  {X X' Y Y' : C} (g : X ⟶ Y) (g' : X' ⟶ Y') :
  coprod.map (g ≫ coprod.inl) (g' ≫ coprod.inr) ≫ codiag (Y ⨿ Y') = coprod.map g g' :=
by simp

end coprod_lemmas

variables (C)

/--
`has_binary_products` represents a choice of product for every pair of objects.

See https://stacks.math.columbia.edu/tag/001T.
-/
abbreviation has_binary_products := has_limits_of_shape (discrete walking_pair) C

/--
`has_binary_coproducts` represents a choice of coproduct for every pair of objects.

See https://stacks.math.columbia.edu/tag/04AP.
-/
abbreviation has_binary_coproducts := has_colimits_of_shape (discrete walking_pair) C

/-- If `C` has all limits of diagrams `pair X Y`, then it has all binary products -/
lemma has_binary_products_of_has_limit_pair [Π {X Y : C}, has_limit (pair X Y)] :
  has_binary_products C :=
{ has_limit := λ F, has_limit_of_iso (diagram_iso_pair F).symm }

/-- If `C` has all colimits of diagrams `pair X Y`, then it has all binary coproducts -/
lemma has_binary_coproducts_of_has_colimit_pair [Π {X Y : C}, has_colimit (pair X Y)] :
  has_binary_coproducts C :=
{ has_colimit := λ F, has_colimit_of_iso (diagram_iso_pair F) }

section
variables {C}

/-- The braiding isomorphism which swaps a binary product. -/
@[simps] def prod.braiding (P Q : C) [has_binary_product P Q] [has_binary_product Q P] :
  P ⨯ Q ≅ Q ⨯ P :=
{ hom := prod.lift prod.snd prod.fst,
  inv := prod.lift prod.snd prod.fst }

/-- The braiding isomorphism can be passed through a map by swapping the order. -/
@[reassoc] lemma braid_natural [has_binary_products C] {W X Y Z : C} (f : X ⟶ Y) (g : Z ⟶ W) :
  prod.map f g ≫ (prod.braiding _ _).hom = (prod.braiding _ _).hom ≫ prod.map g f :=
by simp

@[reassoc] lemma prod.symmetry' (P Q : C) [has_binary_product P Q] [has_binary_product Q P] :
  prod.lift prod.snd prod.fst ≫ prod.lift prod.snd prod.fst = 𝟙 (P ⨯ Q) :=
(prod.braiding _ _).hom_inv_id

/-- The braiding isomorphism is symmetric. -/
@[reassoc] lemma prod.symmetry (P Q : C) [has_binary_product P Q] [has_binary_product Q P] :
  (prod.braiding P Q).hom ≫ (prod.braiding Q P).hom = 𝟙 _ :=
(prod.braiding _ _).hom_inv_id

/-- The associator isomorphism for binary products. -/
@[simps] def prod.associator [has_binary_products C] (P Q R : C) :
  (P ⨯ Q) ⨯ R ≅ P ⨯ (Q ⨯ R) :=
{ hom :=
  prod.lift
    (prod.fst ≫ prod.fst)
    (prod.lift (prod.fst ≫ prod.snd) prod.snd),
  inv :=
  prod.lift
    (prod.lift prod.fst (prod.snd ≫ prod.fst))
    (prod.snd ≫ prod.snd) }

@[reassoc]
lemma prod.pentagon [has_binary_products C] (W X Y Z : C) :
  prod.map ((prod.associator W X Y).hom) (𝟙 Z) ≫
      (prod.associator W (X ⨯ Y) Z).hom ≫ prod.map (𝟙 W) ((prod.associator X Y Z).hom) =
    (prod.associator (W ⨯ X) Y Z).hom ≫ (prod.associator W X (Y ⨯ Z)).hom :=
by simp

@[reassoc]
lemma prod.associator_naturality [has_binary_products C] {X₁ X₂ X₃ Y₁ Y₂ Y₃ : C}
  (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (f₃ : X₃ ⟶ Y₃) :
  prod.map (prod.map f₁ f₂) f₃ ≫ (prod.associator Y₁ Y₂ Y₃).hom =
    (prod.associator X₁ X₂ X₃).hom ≫ prod.map f₁ (prod.map f₂ f₃) :=
by simp

variables [has_terminal C]

/-- The left unitor isomorphism for binary products with the terminal object. -/
@[simps] def prod.left_unitor (P : C) [has_binary_product (⊤_ C) P] :
  ⊤_ C ⨯ P ≅ P :=
{ hom := prod.snd,
  inv := prod.lift (terminal.from P) (𝟙 _) }

/-- The right unitor isomorphism for binary products with the terminal object. -/
@[simps] def prod.right_unitor (P : C) [has_binary_product P (⊤_ C)] :
  P ⨯ ⊤_ C ≅ P :=
{ hom := prod.fst,
  inv := prod.lift (𝟙 _) (terminal.from P) }

@[reassoc]
lemma prod.left_unitor_hom_naturality [has_binary_products C] (f : X ⟶ Y) :
  prod.map (𝟙 _) f ≫ (prod.left_unitor Y).hom = (prod.left_unitor X).hom ≫ f :=
prod.map_snd _ _

@[reassoc]
lemma prod.left_unitor_inv_naturality [has_binary_products C] (f : X ⟶ Y) :
  (prod.left_unitor X).inv ≫ prod.map (𝟙 _) f = f ≫ (prod.left_unitor Y).inv :=
by rw [iso.inv_comp_eq, ← category.assoc, iso.eq_comp_inv, prod.left_unitor_hom_naturality]

@[reassoc]
lemma prod.right_unitor_hom_naturality [has_binary_products C] (f : X ⟶ Y) :
  prod.map f (𝟙 _) ≫ (prod.right_unitor Y).hom = (prod.right_unitor X).hom ≫ f :=
prod.map_fst _ _

@[reassoc]
lemma prod_right_unitor_inv_naturality [has_binary_products C] (f : X ⟶ Y) :
  (prod.right_unitor X).inv ≫ prod.map f (𝟙 _) = f ≫ (prod.right_unitor Y).inv :=
by rw [iso.inv_comp_eq, ← category.assoc, iso.eq_comp_inv, prod.right_unitor_hom_naturality]

lemma prod.triangle [has_binary_products C] (X Y : C) :
  (prod.associator X (⊤_ C) Y).hom ≫ prod.map (𝟙 X) ((prod.left_unitor Y).hom) =
    prod.map ((prod.right_unitor X).hom) (𝟙 Y) :=
by tidy

end

section

variables {C} [has_binary_coproducts C]

/-- The braiding isomorphism which swaps a binary coproduct. -/
@[simps] def coprod.braiding (P Q : C) : P ⨿ Q ≅ Q ⨿ P :=
{ hom := coprod.desc coprod.inr coprod.inl,
  inv := coprod.desc coprod.inr coprod.inl }

@[reassoc] lemma coprod.symmetry' (P Q : C) :
  coprod.desc coprod.inr coprod.inl ≫ coprod.desc coprod.inr coprod.inl = 𝟙 (P ⨿ Q) :=
(coprod.braiding _ _).hom_inv_id

/-- The braiding isomorphism is symmetric. -/
lemma coprod.symmetry (P Q : C) :
  (coprod.braiding P Q).hom ≫ (coprod.braiding Q P).hom = 𝟙 _ :=
coprod.symmetry' _ _

/-- The associator isomorphism for binary coproducts. -/
@[simps] def coprod.associator
  (P Q R : C) : (P ⨿ Q) ⨿ R ≅ P ⨿ (Q ⨿ R) :=
{ hom :=
  coprod.desc
    (coprod.desc coprod.inl (coprod.inl ≫ coprod.inr))
    (coprod.inr ≫ coprod.inr),
  inv :=
  coprod.desc
    (coprod.inl ≫ coprod.inl)
    (coprod.desc (coprod.inr ≫ coprod.inl) coprod.inr) }

lemma coprod.pentagon (W X Y Z : C) :
  coprod.map ((coprod.associator W X Y).hom) (𝟙 Z) ≫
      (coprod.associator W (X ⨿ Y) Z).hom ≫ coprod.map (𝟙 W) ((coprod.associator X Y Z).hom) =
    (coprod.associator (W ⨿ X) Y Z).hom ≫ (coprod.associator W X (Y ⨿ Z)).hom :=
by simp

lemma coprod.associator_naturality {X₁ X₂ X₃ Y₁ Y₂ Y₃ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂)
  (f₃ : X₃ ⟶ Y₃) :
  coprod.map (coprod.map f₁ f₂) f₃ ≫ (coprod.associator Y₁ Y₂ Y₃).hom =
    (coprod.associator X₁ X₂ X₃).hom ≫ coprod.map f₁ (coprod.map f₂ f₃) :=
by simp

variables [has_initial C]

/-- The left unitor isomorphism for binary coproducts with the initial object. -/
@[simps] def coprod.left_unitor
  (P : C) : ⊥_ C ⨿ P ≅ P :=
{ hom := coprod.desc (initial.to P) (𝟙 _),
  inv := coprod.inr }

/-- The right unitor isomorphism for binary coproducts with the initial object. -/
@[simps] def coprod.right_unitor
  (P : C) : P ⨿ ⊥_ C ≅ P :=
{ hom := coprod.desc (𝟙 _) (initial.to P),
  inv := coprod.inl }

lemma coprod.triangle (X Y : C) :
  (coprod.associator X (⊥_ C) Y).hom ≫ coprod.map (𝟙 X) ((coprod.left_unitor Y).hom) =
    coprod.map ((coprod.right_unitor X).hom) (𝟙 Y) :=
by tidy

end

section prod_functor
variables {C} [has_binary_products C]

/-- The binary product functor. -/
@[simps]
def prod.functor : C ⥤ C ⥤ C :=
{ obj := λ X, { obj := λ Y, X ⨯ Y, map := λ Y Z, prod.map (𝟙 X) },
  map := λ Y Z f, { app := λ T, prod.map f (𝟙 T) }}

/-- The product functor can be decomposed. -/
def prod.functor_left_comp (X Y : C) :
  prod.functor.obj (X ⨯ Y) ≅ prod.functor.obj Y ⋙ prod.functor.obj X :=
nat_iso.of_components (prod.associator _ _) (by tidy)

end prod_functor

section coprod_functor
variables {C} [has_binary_coproducts C]

/-- The binary coproduct functor. -/
@[simps]
def coprod.functor : C ⥤ C ⥤ C :=
{ obj := λ X, { obj := λ Y, X ⨿ Y, map := λ Y Z, coprod.map (𝟙 X) },
  map := λ Y Z f, { app := λ T, coprod.map f (𝟙 T) }}

/-- The coproduct functor can be decomposed. -/
def coprod.functor_left_comp (X Y : C) :
  coprod.functor.obj (X ⨿ Y) ≅ coprod.functor.obj Y ⋙ coprod.functor.obj X :=
nat_iso.of_components (coprod.associator _ _) (by tidy)

end coprod_functor

section prod_comparison

variables {C} {D : Type u₂} [category.{v} D]
variables (F : C ⥤ D) {A A' B B' : C}
variables [has_binary_product A B] [has_binary_product A' B']
variables [has_binary_product (F.obj A) (F.obj B)] [has_binary_product (F.obj A') (F.obj B')]
/--
The product comparison morphism.

In `category_theory/limits/preserves` we show this is always an iso iff F preserves binary products.
-/
def prod_comparison (F : C ⥤ D) (A B : C)
  [has_binary_product A B] [has_binary_product (F.obj A) (F.obj B)] :
  F.obj (A ⨯ B) ⟶ F.obj A ⨯ F.obj B :=
prod.lift (F.map prod.fst) (F.map prod.snd)

@[simp, reassoc]
lemma prod_comparison_fst :
  prod_comparison F A B ≫ prod.fst = F.map prod.fst :=
prod.lift_fst _ _

@[simp, reassoc]
lemma prod_comparison_snd :
  prod_comparison F A B ≫ prod.snd = F.map prod.snd :=
prod.lift_snd _ _

/-- Naturality of the prod_comparison morphism in both arguments. -/
@[reassoc] lemma prod_comparison_natural (f : A ⟶ A') (g : B ⟶ B') :
  F.map (prod.map f g) ≫ prod_comparison F A' B' =
    prod_comparison F A B ≫ prod.map (F.map f) (F.map g) :=
begin
  rw [prod_comparison, prod_comparison, prod.lift_map, ← F.map_comp, ← F.map_comp,
      prod.comp_lift, ← F.map_comp, prod.map_fst, ← F.map_comp, prod.map_snd]
end

/--
The product comparison morphism from `F(A ⨯ -)` to `FA ⨯ F-`, whose components are given by
`prod_comparison`.
-/
@[simps]
def prod_comparison_nat_trans [has_binary_products C] [has_binary_products D]
  (F : C ⥤ D) (A : C) :
  prod.functor.obj A ⋙ F ⟶ F ⋙ prod.functor.obj (F.obj A) :=
{ app := λ B, prod_comparison F A B,
  naturality' := λ B B' f, by simp [prod_comparison_natural] }

@[reassoc]
lemma inv_prod_comparison_map_fst [is_iso (prod_comparison F A B)] :
  inv (prod_comparison F A B) ≫ F.map prod.fst = prod.fst :=
by simp [is_iso.inv_comp_eq]

@[reassoc]
lemma inv_prod_comparison_map_snd [is_iso (prod_comparison F A B)] :
  inv (prod_comparison F A B) ≫ F.map prod.snd = prod.snd :=
by simp [is_iso.inv_comp_eq]

/-- If the product comparison morphism is an iso, its inverse is natural. -/
@[reassoc]
lemma prod_comparison_inv_natural (f : A ⟶ A') (g : B ⟶ B')
  [is_iso (prod_comparison F A B)] [is_iso (prod_comparison F A' B')] :
  inv (prod_comparison F A B) ≫ F.map (prod.map f g) =
    prod.map (F.map f) (F.map g) ≫ inv (prod_comparison F A' B') :=
by rw [is_iso.eq_comp_inv, category.assoc, is_iso.inv_comp_eq, prod_comparison_natural]

/--
The natural isomorphism `F(A ⨯ -) ≅ FA ⨯ F-`, provided each `prod_comparison F A B` is an
isomorphism (as `B` changes).
-/
@[simps {rhs_md := semireducible}]
def prod_comparison_nat_iso [has_binary_products C] [has_binary_products D]
  (A : C) [∀ B, is_iso (prod_comparison F A B)] :
  prod.functor.obj A ⋙ F ≅ F ⋙ prod.functor.obj (F.obj A) :=
{ hom := prod_comparison_nat_trans F A
  ..(@as_iso _ _ _ _ _ (nat_iso.is_iso_of_is_iso_app ⟨_, _⟩)) }

end prod_comparison

section coprod_comparison

variables {C} {D : Type u₂} [category.{v} D]
variables (F : C ⥤ D) {A A' B B' : C}
variables [has_binary_coproduct A B] [has_binary_coproduct A' B']
variables [has_binary_coproduct (F.obj A) (F.obj B)] [has_binary_coproduct (F.obj A') (F.obj B')]
/--
The coproduct comparison morphism.

In `category_theory/limits/preserves` we show
this is always an iso iff F preserves binary coproducts.
-/
def coprod_comparison (F : C ⥤ D) (A B : C)
  [has_binary_coproduct A B] [has_binary_coproduct (F.obj A) (F.obj B)] :
  F.obj A ⨿ F.obj B ⟶ F.obj (A ⨿ B) :=
coprod.desc (F.map coprod.inl) (F.map coprod.inr)

@[simp, reassoc]
lemma coprod_comparison_inl :
  coprod.inl ≫ coprod_comparison F A B  = F.map coprod.inl :=
coprod.inl_desc _ _

@[simp, reassoc]

/-- Naturality of the coprod_comparison morphism in both arguments. -/
@[reassoc] lemma coprod_comparison_natural (f : A ⟶ A') (g : B ⟶ B') :
  coprod_comparison F A B ≫ F.map (coprod.map f g) =
    coprod.map (F.map f) (F.map g) ≫ coprod_comparison F A' B' :=
begin
  rw [coprod_comparison, coprod_comparison, coprod.map_desc, ← F.map_comp, ← F.map_comp,
      coprod.desc_comp, ← F.map_comp, coprod.inl_map, ← F.map_comp, coprod.inr_map]
end

/--
The coproduct comparison morphism from `FA ⨿ F-` to `F(A ⨿ -)`, whose components are given by
`coprod_comparison`.
-/
@[simps]
def coprod_comparison_nat_trans [has_binary_coproducts C] [has_binary_coproducts D]
  (F : C ⥤ D) (A : C) :
  F ⋙ coprod.functor.obj (F.obj A) ⟶ coprod.functor.obj A ⋙ F :=
{ app := λ B, coprod_comparison F A B,
  naturality' := λ B B' f, by simp [coprod_comparison_natural] }

@[reassoc]
lemma map_inl_inv_coprod_comparison [is_iso (coprod_comparison F A B)] :
  F.map coprod.inl ≫ inv (coprod_comparison F A B) = coprod.inl :=
by simp [is_iso.inv_comp_eq]

@[reassoc]
lemma map_inr_inv_coprod_comparison [is_iso (coprod_comparison F A B)] :
  F.map coprod.inr ≫ inv (coprod_comparison F A B) = coprod.inr :=
by simp [is_iso.inv_comp_eq]

/-- If the coproduct comparison morphism is an iso, its inverse is natural. -/
@[reassoc]
lemma coprod_comparison_inv_natural (f : A ⟶ A') (g : B ⟶ B')
  [is_iso (coprod_comparison F A B)] [is_iso (coprod_comparison F A' B')] :
  inv (coprod_comparison F A B) ≫ coprod.map (F.map f) (F.map g) =
    F.map (coprod.map f g) ≫ inv (coprod_comparison F A' B') :=
by rw [is_iso.eq_comp_inv, category.assoc, is_iso.inv_comp_eq, coprod_comparison_natural]

/--
The natural isomorphism `FA ⨿ F- ≅ F(A ⨿ -)`, provided each `coprod_comparison F A B` is an
isomorphism (as `B` changes).
-/
@[simps {rhs_md := semireducible}]
def coprod_comparison_nat_iso [has_binary_coproducts C] [has_binary_coproducts D]
  (A : C) [∀ B, is_iso (coprod_comparison F A B)] :
  F ⋙ coprod.functor.obj (F.obj A) ≅ coprod.functor.obj A ⋙ F :=
{ hom := coprod_comparison_nat_trans F A
  ..(@as_iso _ _ _ _ _ (nat_iso.is_iso_of_is_iso_app ⟨_, _⟩)) }

end coprod_comparison

end category_theory.limits

open category_theory.limits

namespace category_theory

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

/-- Auxilliary definition for `over.coprod`. -/
@[simps]
def over.coprod_obj [has_binary_coproducts C] {A : C} : over A → over A ⥤ over A := λ f,
{ obj := λ g, over.mk (coprod.desc f.hom g.hom),
  map := λ g₁ g₂ k, over.hom_mk (coprod.map (𝟙 _) k.left) }

/-- A category with binary coproducts has a functorial `sup` operation on over categories. -/
@[simps]
def over.coprod [has_binary_coproducts C] {A : C} : over A ⥤ over A ⥤ over A :=
{ obj := λ f, over.coprod_obj f,
  map := λ f₁ f₂ k,
  { app := λ g, over.hom_mk (coprod.map k.left (𝟙 _))
      (by { dsimp, rw [coprod.map_desc, category.id_comp, over.w k] }),
    naturality' := λ f g k, by ext; { dsimp, simp, }, },
  map_id' := λ X, by ext; { dsimp, simp, },
  map_comp' := λ X Y Z f g, by ext; { dsimp, simp, }, }.

end category_theory


open Classical

theorem ex : if (fun x => x + 1) = (fun x => x + 2) then False else True := by
  have : (fun x => x + 1) ≠ (fun x => x + 2) := by
    intro h
    have : 1 = 2 := congrFun h 0
    contradiction
  rw [if_neg this]
  exact True.intro

def tst (x : Nat) : Bool :=
  if 1 < 2 then true else false