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

! This file was ported from Lean 3 source module algebra.euclidean_domain.basic
! leanprover-community/mathlib commit 655994e298904d7e5bbd1e18c95defd7b543eb94
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.EuclideanDomain.Defs
import Mathlib.Algebra.Ring.Divisibility
import Mathlib.Algebra.Ring.Regular
import Mathlib.Algebra.GroupWithZero.Divisibility
import Mathlib.Algebra.Ring.Basic

/-!
# Lemmas about Euclidean domains

## Main statements

* `gcd_eq_gcd_ab`: states Bézout's lemma for Euclidean domains.

-/

universe u

namespace EuclideanDomain

variable {R : Type u}

variable [EuclideanDomain R]

/-- The well founded relation in a Euclidean Domain satisfying `a % b ≺ b` for `b ≠ 0`  -/
local infixl:50 " ≺ " => EuclideanDomain.R

theorem mul_div_cancel_left {a : R} (b) (a0 : a ≠ 0) : a * b / a = b :=
  Eq.symm <|
    eq_of_sub_eq_zero <|
      by_contradiction fun h => by
        have := mul_left_not_lt a h
        rw [mul_sub, sub_eq_iff_eq_add'.2 (div_add_mod (a * b) a).symm] at this
        exact this (mod_lt _ a0)
#align euclidean_domain.mul_div_cancel_left EuclideanDomain.mul_div_cancel_left

theorem mul_div_cancel (a) {b : R} (b0 : b ≠ 0) : a * b / b = a := by
  rw [mul_comm]
  exact mul_div_cancel_left a b0
#align euclidean_domain.mul_div_cancel EuclideanDomain.mul_div_cancel

@[simp]
theorem mod_eq_zero {a b : R} : a % b = 0 ↔ b ∣ a :=
  ⟨fun h => by
    rw [← div_add_mod a b, h, add_zero]
    exact dvd_mul_right _ _, fun ⟨c, e⟩ => by
    rw [e, ← add_left_cancel_iff, div_add_mod, add_zero]
    haveI := Classical.dec
    by_cases b0 : b = 0
     --Porting note: `simp` doesn't prove `True` here for some reason
    · simp only [b0, zero_mul] ; trivial
    · rw [mul_div_cancel_left _ b0]⟩
#align euclidean_domain.mod_eq_zero EuclideanDomain.mod_eq_zero

@[simp]
theorem mod_self (a : R) : a % a = 0 :=
  mod_eq_zero.2 dvd_rfl
#align euclidean_domain.mod_self EuclideanDomain.mod_self

theorem dvd_mod_iff {a b c : R} (h : c ∣ b) : c ∣ a % b ↔ c ∣ a := by
  rw [dvd_add_iff_right (h.mul_right _), div_add_mod]
#align euclidean_domain.dvd_mod_iff EuclideanDomain.dvd_mod_iff

@[simp]
theorem mod_one (a : R) : a % 1 = 0 :=
  mod_eq_zero.2 (one_dvd _)
#align euclidean_domain.mod_one EuclideanDomain.mod_one

@[simp]
theorem zero_mod (b : R) : 0 % b = 0 :=
  mod_eq_zero.2 (dvd_zero _)
#align euclidean_domain.zero_mod EuclideanDomain.zero_mod

@[simp]
theorem zero_div {a : R} : 0 / a = 0 :=
  by_cases (fun a0 : a = 0 => a0.symm ▸ div_zero 0) fun a0 => by
    simpa only [zero_mul] using mul_div_cancel 0 a0
#align euclidean_domain.zero_div EuclideanDomain.zero_div

@[simp]
theorem div_self {a : R} (a0 : a ≠ 0) : a / a = 1 := by
  simpa only [one_mul] using mul_div_cancel 1 a0
#align euclidean_domain.div_self EuclideanDomain.div_self

theorem eq_div_of_mul_eq_right {a b c : R} (ha : a ≠ 0) (h : a * b = c) : b = c / a := by
  rw [← h, mul_div_cancel_left _ ha]
#align euclidean_domain.eq_div_of_mul_eq_right EuclideanDomain.eq_div_of_mul_eq_right

theorem mul_div_assoc (x : R) {y z : R} (h : z ∣ y) : x * y / z = x * (y / z) := by
  by_cases hz : z = 0
  · subst hz
    rw [div_zero, div_zero, mul_zero]
  rcases h with ⟨p, rfl⟩
  rw [mul_div_cancel_left _ hz, mul_left_comm, mul_div_cancel_left _ hz]
#align euclidean_domain.mul_div_assoc EuclideanDomain.mul_div_assoc

-- This generalizes `Int.div_one`, see note [simp-normal form]
@[simp]
theorem div_one (p : R) : p / 1 = p :=
  (EuclideanDomain.eq_div_of_mul_eq_left (one_ne_zero' R) (mul_one p)).symm
#align euclidean_domain.div_one EuclideanDomain.div_one

theorem div_dvd_of_dvd {p q : R} (hpq : q ∣ p) : p / q ∣ p := by
  by_cases hq : q = 0
  · rw [hq, zero_dvd_iff] at hpq
    rw [hpq]
    exact dvd_zero _
  use q
  rw [mul_comm, ← EuclideanDomain.mul_div_assoc _ hpq, mul_comm,
    EuclideanDomain.mul_div_cancel _ hq]
#align euclidean_domain.div_dvd_of_dvd EuclideanDomain.div_dvd_of_dvd

theorem dvd_div_of_mul_dvd {a b c : R} (h : a * b ∣ c) : b ∣ c / a := by
  rcases eq_or_ne a 0 with (rfl | ha)
  · simp only [div_zero, dvd_zero]
  rcases h with ⟨d, rfl⟩
  refine' ⟨d, _⟩
  rw [mul_assoc, mul_div_cancel_left _ ha]
#align euclidean_domain.dvd_div_of_mul_dvd EuclideanDomain.dvd_div_of_mul_dvd

section GCD

variable [DecidableEq R]

@[simp]
theorem gcd_zero_right (a : R) : gcd a 0 = a := by
  rw [gcd]
  split_ifs with h <;> simp only [h, zero_mod, gcd_zero_left]
#align euclidean_domain.gcd_zero_right EuclideanDomain.gcd_zero_right

theorem gcd_val (a b : R) : gcd a b = gcd (b % a) a := by
  rw [gcd]
  split_ifs with h <;> [simp only [h, mod_zero, gcd_zero_right], rfl]
#align euclidean_domain.gcd_val EuclideanDomain.gcd_val

theorem gcd_dvd (a b : R) : gcd a b ∣ a ∧ gcd a b ∣ b :=
  GCD.induction a b
    (fun b => by
      rw [gcd_zero_left]
      exact ⟨dvd_zero _, dvd_rfl⟩)
    fun a b _ ⟨IH₁, IH₂⟩ => by
    rw [gcd_val]
    exact ⟨IH₂, (dvd_mod_iff IH₂).1 IH₁⟩
#align euclidean_domain.gcd_dvd EuclideanDomain.gcd_dvd

theorem gcd_dvd_left (a b : R) : gcd a b ∣ a :=
  (gcd_dvd a b).left
#align euclidean_domain.gcd_dvd_left EuclideanDomain.gcd_dvd_left

theorem gcd_dvd_right (a b : R) : gcd a b ∣ b :=
  (gcd_dvd a b).right
#align euclidean_domain.gcd_dvd_right EuclideanDomain.gcd_dvd_right

protected theorem gcd_eq_zero_iff {a b : R} : gcd a b = 0 ↔ a = 0 ∧ b = 0 :=
  ⟨fun h => by simpa [h] using gcd_dvd a b, by
    rintro ⟨rfl, rfl⟩
    exact gcd_zero_right _⟩
#align euclidean_domain.gcd_eq_zero_iff EuclideanDomain.gcd_eq_zero_iff

theorem dvd_gcd {a b c : R} : c ∣ a → c ∣ b → c ∣ gcd a b :=
  GCD.induction a b (fun _ _ H => by simpa only [gcd_zero_left] using H) fun a b _ IH ca cb => by
    rw [gcd_val]
    exact IH ((dvd_mod_iff ca).2 cb) ca
#align euclidean_domain.dvd_gcd EuclideanDomain.dvd_gcd

theorem gcd_eq_left {a b : R} : gcd a b = a ↔ a ∣ b :=
  ⟨fun h => by
    rw [← h]
    apply gcd_dvd_right, fun h => by rw [gcd_val, mod_eq_zero.2 h, gcd_zero_left]⟩
#align euclidean_domain.gcd_eq_left EuclideanDomain.gcd_eq_left

@[simp]
theorem gcd_one_left (a : R) : gcd 1 a = 1 :=
  gcd_eq_left.2 (one_dvd _)
#align euclidean_domain.gcd_one_left EuclideanDomain.gcd_one_left

@[simp]
theorem gcd_self (a : R) : gcd a a = a :=
  gcd_eq_left.2 dvd_rfl
#align euclidean_domain.gcd_self EuclideanDomain.gcd_self

@[simp]
theorem xgcdAux_fst (x y : R) : ∀ s t s' t', (xgcdAux x s t y s' t').1 = gcd x y :=
  GCD.induction x y
    (by
      intros
      rw [xgcd_zero_left, gcd_zero_left])
    fun x y h IH s t s' t' => by
    simp only [xgcdAux_rec h, if_neg h, IH]
    rw [← gcd_val]
#align euclidean_domain.xgcd_aux_fst EuclideanDomain.xgcdAux_fst

theorem xgcdAux_val (x y : R) : xgcdAux x 1 0 y 0 1 = (gcd x y, xgcd x y) := by
  rw [xgcd, ← xgcdAux_fst x y 1 0 0 1, Prod.mk.eta]
#align euclidean_domain.xgcd_aux_val EuclideanDomain.xgcdAux_val

private def P (a b : R) : R × R × R → Prop
  | (r, s, t) => (r : R) = a * s + b * t

theorem xgcdAux_P (a b : R) {r r' : R} {s t s' t'} (p : P a b (r, s, t))
    (p' : P a b (r', s', t')) : P a b (xgcdAux r s t r' s' t') := by
  induction r, r' using GCD.induction generalizing s t s' t' with
  | H0 n => simpa only [xgcd_zero_left]
  | H1 _ _ h IH =>
    rw [xgcdAux_rec h]
    refine' IH _ p
    unfold P at p p'⊢
    dsimp
    rw [mul_sub, mul_sub, add_sub, sub_add_eq_add_sub, ← p', sub_sub, mul_comm _ s, ← mul_assoc,
      mul_comm _ t, ← mul_assoc, ← add_mul, ← p, mod_eq_sub_mul_div]
set_option linter.uppercaseLean3 false in
#align euclidean_domain.xgcd_aux_P EuclideanDomain.xgcdAux_P

/-- An explicit version of **Bézout's lemma** for Euclidean domains. -/
theorem gcd_eq_gcd_ab (a b : R) : (gcd a b : R) = a * gcdA a b + b * gcdB a b := by
  have :=
    @xgcdAux_P _ _ _ a b a b 1 0 0 1 (by dsimp [P]; rw [mul_one, mul_zero, add_zero])
      (by dsimp [P]; rw [mul_one, mul_zero, zero_add])
  rwa [xgcdAux_val, xgcd_val] at this
#align euclidean_domain.gcd_eq_gcd_ab EuclideanDomain.gcd_eq_gcd_ab

-- see Note [lower instance priority]
instance (priority := 70) (R : Type _) [e : EuclideanDomain R] : NoZeroDivisors R :=
  haveI := Classical.decEq R
  { eq_zero_or_eq_zero_of_mul_eq_zero := fun {a b} h =>
      or_iff_not_and_not.2 fun h0 => h0.1 <| by rw [← mul_div_cancel a h0.2, h, zero_div] }

-- see Note [lower instance priority]
instance (priority := 70) (R : Type _) [e : EuclideanDomain R] : IsDomain R :=
  { e, NoZeroDivisors.to_isDomain R with }

end GCD

section LCM

variable [DecidableEq R]

theorem dvd_lcm_left (x y : R) : x ∣ lcm x y :=
  by_cases
    (fun hxy : gcd x y = 0 => by
      rw [lcm, hxy, div_zero]
      exact dvd_zero _)
    fun hxy =>
    let ⟨z, hz⟩ := (gcd_dvd x y).2
    ⟨z, Eq.symm <| eq_div_of_mul_eq_left hxy <| by rw [mul_right_comm, mul_assoc, ← hz]⟩
#align euclidean_domain.dvd_lcm_left EuclideanDomain.dvd_lcm_left

theorem dvd_lcm_right (x y : R) : y ∣ lcm x y :=
  by_cases
    (fun hxy : gcd x y = 0 => by
      rw [lcm, hxy, div_zero]
      exact dvd_zero _)
    fun hxy =>
    let ⟨z, hz⟩ := (gcd_dvd x y).1
    ⟨z, Eq.symm <| eq_div_of_mul_eq_right hxy <| by rw [← mul_assoc, mul_right_comm, ← hz]⟩
#align euclidean_domain.dvd_lcm_right EuclideanDomain.dvd_lcm_right

theorem lcm_dvd {x y z : R} (hxz : x ∣ z) (hyz : y ∣ z) : lcm x y ∣ z := by
  rw [lcm]
  by_cases hxy : gcd x y = 0
  · rw [hxy, div_zero]
    rw [EuclideanDomain.gcd_eq_zero_iff] at hxy
    rwa [hxy.1] at hxz
  rcases gcd_dvd x y with ⟨⟨r, hr⟩, ⟨s, hs⟩⟩
  suffices x * y ∣ z * gcd x y by
    cases' this with p hp
    use p
    generalize gcd x y = g at hxy hs hp⊢
    subst hs
    rw [mul_left_comm, mul_div_cancel_left _ hxy, ← mul_left_inj' hxy, hp]
    rw [← mul_assoc]
    simp only [mul_right_comm]
  rw [gcd_eq_gcd_ab, mul_add]
  apply dvd_add
  · rw [mul_left_comm]
    exact mul_dvd_mul_left _ (hyz.mul_right _)
  · rw [mul_left_comm, mul_comm]
    exact mul_dvd_mul_left _ (hxz.mul_right _)
#align euclidean_domain.lcm_dvd EuclideanDomain.lcm_dvd

@[simp]
theorem lcm_dvd_iff {x y z : R} : lcm x y ∣ z ↔ x ∣ z ∧ y ∣ z :=
  ⟨fun hz => ⟨(dvd_lcm_left _ _).trans hz, (dvd_lcm_right _ _).trans hz⟩, fun ⟨hxz, hyz⟩ =>
    lcm_dvd hxz hyz⟩
#align euclidean_domain.lcm_dvd_iff EuclideanDomain.lcm_dvd_iff

@[simp]
theorem lcm_zero_left (x : R) : lcm 0 x = 0 := by rw [lcm, zero_mul, zero_div]
#align euclidean_domain.lcm_zero_left EuclideanDomain.lcm_zero_left

@[simp]
theorem lcm_zero_right (x : R) : lcm x 0 = 0 := by rw [lcm, mul_zero, zero_div]
#align euclidean_domain.lcm_zero_right EuclideanDomain.lcm_zero_right

@[simp]
theorem lcm_eq_zero_iff {x y : R} : lcm x y = 0 ↔ x = 0 ∨ y = 0 := by
  constructor
  · intro hxy
    rw [lcm, mul_div_assoc _ (gcd_dvd_right _ _), mul_eq_zero] at hxy
    apply Or.imp_right _ hxy
    intro hy
    by_cases hgxy : gcd x y = 0
    · rw [EuclideanDomain.gcd_eq_zero_iff] at hgxy
      exact hgxy.2
    · rcases gcd_dvd x y with ⟨⟨r, hr⟩, ⟨s, hs⟩⟩
      generalize gcd x y = g at hr hs hy hgxy⊢
      subst hs
      rw [mul_div_cancel_left _ hgxy] at hy
      rw [hy, mul_zero]
  rintro (hx | hy)
  · rw [hx, lcm_zero_left]
  · rw [hy, lcm_zero_right]
#align euclidean_domain.lcm_eq_zero_iff EuclideanDomain.lcm_eq_zero_iff

@[simp]
theorem gcd_mul_lcm (x y : R) : gcd x y * lcm x y = x * y := by
  rw [lcm]; by_cases h : gcd x y = 0
  · rw [h, zero_mul]
    rw [EuclideanDomain.gcd_eq_zero_iff] at h
    rw [h.1, zero_mul]
  rcases gcd_dvd x y with ⟨⟨r, hr⟩, ⟨s, hs⟩⟩
  generalize gcd x y = g at h hr⊢; subst hr
  rw [mul_assoc, mul_div_cancel_left _ h]
#align euclidean_domain.gcd_mul_lcm EuclideanDomain.gcd_mul_lcm

end LCM

section Div

theorem mul_div_mul_cancel {a b c : R} (ha : a ≠ 0) (hcb : c ∣ b) : a * b / (a * c) = b / c := by
  by_cases hc : c = 0; · simp [hc]
  refine' eq_div_of_mul_eq_right hc (mul_left_cancel₀ ha _)
  rw [← mul_assoc, ← mul_div_assoc _ (mul_dvd_mul_left a hcb),
    mul_div_cancel_left _ (mul_ne_zero ha hc)]
#align euclidean_domain.mul_div_mul_cancel EuclideanDomain.mul_div_mul_cancel

theorem mul_div_mul_comm_of_dvd_dvd {a b c d : R} (hac : c ∣ a) (hbd : d ∣ b) :
    a * b / (c * d) = a / c * (b / d) := by
  rcases eq_or_ne c 0 with (rfl | hc0); · simp
  rcases eq_or_ne d 0 with (rfl | hd0); · simp
  obtain ⟨k1, rfl⟩ := hac
  obtain ⟨k2, rfl⟩ := hbd
  rw [mul_div_cancel_left _ hc0, mul_div_cancel_left _ hd0, mul_mul_mul_comm,
    mul_div_cancel_left _ (mul_ne_zero hc0 hd0)]
#align euclidean_domain.mul_div_mul_comm_of_dvd_dvd EuclideanDomain.mul_div_mul_comm_of_dvd_dvd

end Div

end EuclideanDomain


/- -----------------------------------------------------------------------
Products and co-products.
----------------------------------------------------------------------- -/

import .s1_limits

namespace qp

open stdaux

universe variables ℓ ℓobj ℓhom ℓobj₁ ℓhom₁ ℓobj₂ ℓhom₂

/- -----------------------------------------------------------------------
Products.
----------------------------------------------------------------------- -/

/-! #brief The product diagram.
-/
definition ProductDrgm (C : Cat.{ℓobj ℓhom}) {A : Type ℓ}
    (factor : A → C^.obj)
    : Fun (ObjCat A) C
:= { obj := λ a, factor a
   , hom := λ a₁ a₂ f, begin cases f, exact C^.id (factor a₁) end
   , hom_id := λ a, rfl
   , hom_circ := λ a₁ a₂ a₃ g f
                 , begin
                     cases g, cases f, exact eq.symm C^.circ_id_left
                   end
   }

/-! #brief The product diagram turns heterogeneous equality into natural isomorphisms.
-/
definition ProductDrgm.heq (C : Cat.{ℓobj ℓhom})
    : ∀ {A₁ A₂ : Type ℓ} (ωA : A₁ = A₂)
        {factor₁ : A₁ → C^.obj} {factor₂ : A₂ → C^.obj}
        (ωfactor : factor₁ == factor₂)
      , ProductDrgm C factor₁ == ProductDrgm C factor₂
| A .(A) (eq.refl .(A)) factor .(factor) (heq.refl .(factor)) := heq.refl _

/-! #brief A handy identity.
-/
theorem ProductDrgm.on_Fun {C : Cat.{ℓobj ℓhom}} {A : Type ℓ}
    (F : Fun (ObjCat A) C)
    : ProductDrgm C F^.obj = F
:= Fun.eq (λ x, rfl)
    (λ ω x y f
     , begin
         dsimp [ObjCat, PreorderCat] at f,
         subst f,
         apply heq_of_eq,
         apply eq.symm,
         apply F^.hom_id
       end)

/-! #brief A cone over a product.
-/
definition ProductCone (C : Cat.{ℓobj ℓhom}) {A : Type ℓ}
    (factor : A → C^.obj)
    : Type (max ℓ ℓobj ℓhom)
:= Cone (ProductDrgm C factor)

/-! #brief Helper for making a product cone.
-/
definition ProductCone.mk {C : Cat.{ℓobj ℓhom}} {A : Type ℓ}
    {factor : A → C^.obj}
    (c : C^.obj)
    (proj : ∀ (a : A), C^.hom c (factor a))
    : ProductCone C factor
:= { obj := c
   , hom := proj
   , comm := λ a₁ a₂ f, begin cases f, exact eq.symm C^.circ_id_left end
   }

/-! #brief A product in a category.
-/
@[class] definition HasProduct (C : Cat.{ℓobj ℓhom}) {A : Type ℓ}
    (factor : A → C^.obj)
:= HasLimit (ProductDrgm C factor)

instance HasProduct.HasLimit {C : Cat.{ℓobj ℓhom}} {A : Type ℓ}
    (factor : A → C^.obj)
    [factor_HasProduct : HasProduct C factor]
    : HasLimit (ProductDrgm C factor)
:= factor_HasProduct

/-! #brief A category with all products.
-/
class HasAllProducts (C : Cat.{ℓobj ℓhom})
:= (has_product : ∀ {A : Type ℓ} (factor : A → C^.obj)
                  , HasProduct C factor)

instance HasAllProducts.HasProduct (C : Cat.{ℓobj ℓhom})
    [C_HasAllProducts : HasAllProducts.{ℓ} C]
    {A : Type ℓ} (factor : A → C^.obj)
    : HasProduct C factor
:= HasAllProducts.has_product factor

instance HasAllProducts.HasAllLimitsFrom.ObjCat (C : Cat.{ℓobj ℓhom})
    [C_HasAllProducts : HasAllProducts.{ℓ} C]
    (A : Type ℓ)
    : HasAllLimitsFrom C (ObjCat A)
:= { has_limit := λ L, let l := HasAllProducts.HasProduct C L^.obj
                       in cast (congr_arg HasLimit (ProductDrgm.on_Fun L)) l
   }

/-! #brief Helper for showing a category has a product.
-/
definition HasProduct.show (C : Cat.{ℓobj ℓhom}) {A : Type ℓ}
    (factor : A → C^.obj)
    (p : C^.obj)
    (proj : ∀ (a : A), C^.hom p (factor a))
    (univ
      : ∀ (c : C^.obj) (hom : ∀ (a : A), C^.hom c (factor a))
        , C^.hom c p)
    (ωuniv
      : ∀ (c : C^.obj) (hom : ∀ (a : A), C^.hom c (factor a))
           (a : A)
        , hom a = C^.circ (proj a) (univ c hom))
    (ωuniq
      : ∀ (c : C^.obj) (hom : ∀ (a : A), C^.hom c (factor a))
           (h : C^.hom c p) (ωh : ∀ {a : A}, hom a = C^.circ (proj a) h)
        , h = univ c hom)
    : HasProduct C factor
:= HasLimit.show p proj (λ x₁ x₂ f, begin cases f, exact eq.symm C^.circ_id_left end)
    (λ c hom ωcomm, univ c hom)
    (λ c hom ωcomm a, ωuniv c hom a)
    (λ c hom ωcomm h ωh, ωuniq c hom h @ωh)

/-! #brief Products are cones.
-/
definition product.cone (C : Cat.{ℓobj ℓhom}) {A : Type ℓ}
    (factor : A → C^.obj)
    [factor_HasProduct : HasProduct C factor]
    : ProductCone C factor
:= limit.cone (ProductDrgm C factor)

/-! #brief The product of a collection of objects.
-/
definition product (C : Cat.{ℓobj ℓhom}) {A : Type ℓ}
    (factor : A → C^.obj)
    [factor_HasProduct : HasProduct C factor]
    : C^.obj
:= limit (ProductDrgm C factor)

/-! #brief Projection out of a product.
-/
definition product.π (C : Cat.{ℓobj ℓhom}) {A : Type ℓ}
    (factor : A → C^.obj)
    [factor_HasProduct : HasProduct C factor]
    (a : A)
    : C^.hom (product C factor) (factor a)
:= limit.out (ProductDrgm C factor) a

/-! #brief Every cone is mediated through the product.
-/
definition product.univ (C : Cat.{ℓobj ℓhom}) {A : Type ℓ}
    (factor : A → C^.obj)
    [factor_HasProduct : HasProduct C factor]
    (c : ProductCone C factor)
    : C^.hom c^.obj (product C factor)
:= limit.univ _ c

/-! #brief Every cone is mediated through the product.
-/
definition product.univ.mediates (C : Cat.{ℓobj ℓhom}) {A : Type ℓ}
    (factor : A → C^.obj)
    {factor_HasProduct : HasProduct C factor}
    (c : ProductCone C factor)
    (a : A)
    : c^.hom a = C^.circ (@product.π C A factor factor_HasProduct a) (product.univ C factor c)
:= limit.univ.mediates c a

/-! #brief The mediating map from the cone to the product is unique.
-/
definition product.univ.uniq (C : Cat.{ℓobj ℓhom}) {A : Type ℓ}
    (factor : A → C^.obj)
    {factor_HasProduct : HasProduct C factor}
    (c : ProductCone C factor)
    (m : C^.hom c^.obj (product C factor))
    (ω : ∀ (a : A), c^.hom a = (@product.π C A factor factor_HasProduct a) ∘∘ m)
    : m = product.univ C factor c
:= limit.univ.uniq c m ω

/-! #brief The unique iso between two products of the same factors.
-/
definition product.iso {C : Cat.{ℓobj ℓhom}} {A : Type ℓ}
    {factor : A → C^.obj}
    (factor_HasProduct₁ factor_HasProduct₂ : HasProduct C factor)
    : C^.hom (@product C A factor factor_HasProduct₁)
             (@product C A factor factor_HasProduct₂)
:= limit.iso factor_HasProduct₁ factor_HasProduct₂

/-! #brief Products are unique up-to unique isomorphism.
-/
definition product.uniq {C : Cat.{ℓobj ℓhom}} {A : Type ℓ}
    {factor : A → C^.obj}
    (factor_HasProduct₁ factor_HasProduct₂ : HasProduct C factor)
    : Iso (product.iso factor_HasProduct₁ factor_HasProduct₂)
          (product.iso factor_HasProduct₂ factor_HasProduct₁)
:= limit.uniq factor_HasProduct₁ factor_HasProduct₂

/- -----------------------------------------------------------------------
Products in functor categories.
----------------------------------------------------------------------- -/

/-! #brief Products in functor categories can be computed pointwise.
-/
instance FunCat.HasProduct {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    [D_HasAllProducts : HasAllProducts.{ℓ} D]
    {A : Type ℓ} (factor : A → Fun C D)
    : HasProduct (FunCat C D) factor
:= FunCat.HasLimit (ProductDrgm _ factor)

/-! #brief Products in functor categories can be computed pointwise.
-/
instance FunCat.HasAllProducts {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    [D_HasAllProducts : HasAllProducts.{ℓ} D]
    : HasAllProducts.{ℓ} (FunCat C D)
:= { has_product := λ A factor, FunCat.HasProduct factor
   }

/- -----------------------------------------------------------------------
Finite products.
----------------------------------------------------------------------- -/

/-! #brief A cone over a finite product.
-/
definition FinProductCone (C : Cat.{ℓobj ℓhom})
    (factor : list C^.obj)
    : Type (max ℓobj ℓhom)
:= ProductCone C (list.get factor)

/-! #brief Every finite product cone comes with projections.
-/
definition FinProductCone.Proj {C : Cat.{ℓobj ℓhom}}
    {factor : list C^.obj}
    (c : FinProductCone C factor)
    : HomsOut c^.obj factor
:= dlist.enum (Cone.hom c)

/-! #brief Helper for making a finite product cone.
-/
definition FinProductCone.mk {C : Cat.{ℓobj ℓhom}}
    {factor : list C^.obj}
    (c : C^.obj)
    (proj : HomsOut c factor)
    : FinProductCone C factor
:= ProductCone.mk c (HomsOut.get proj)

/-! #brief A finite product in a category.
-/
@[class] definition HasFinProduct (C : Cat.{ℓobj ℓhom})
    (factor : list C^.obj)
:= HasProduct C (list.get factor)

instance HasFinProduct.HasProduct (C : Cat.{ℓobj ℓhom})
    (factor : list C^.obj)
    [factor_HasProduct : HasFinProduct C factor]
    : HasProduct C (list.get factor)
:= factor_HasProduct

/-! #brief A category with all finite products.
-/
class HasAllFinProducts (C : Cat.{ℓobj ℓhom})
:= (has_product : ∀ (factor : list C^.obj), HasFinProduct C factor)

instance HasAllFinProducts.HasFinProduct (C : Cat.{ℓobj ℓhom})
    [C_HasAllFinProducts : HasAllFinProducts C]
    (factor : list C^.obj)
    : HasFinProduct C factor
:= HasAllFinProducts.has_product factor

instance HasAllFinProducts.HasAllLimitsFrom.ObjCat (C : Cat.{ℓobj ℓhom})
    [C_HasAllFinProducts : HasAllFinProducts C]
    (N : ℕ)
    : HasAllLimitsFrom C (ObjCat (fin N))
:= { has_limit
      := λ L, let l := HasAllFinProducts.HasFinProduct C (fin.enum L^.obj)
           in let ω₁ : ObjCat (fin (list.length (fin.enum (L^.obj)))) = ObjCat (fin N)
                    := by rw list.length_enum
           in let ω₂ : ProductDrgm C (list.get (fin.enum L^.obj)) == L
                   := by calc ProductDrgm C (list.get (fin.enum L^.obj))
                                  == ProductDrgm C L^.obj : ProductDrgm.heq _ (congr_arg fin (list.length_enum _))
                                                             list.get_enum'
                              ... = L                     : ProductDrgm.on_Fun L
              in cast (HasLimit.heq (by rw list.length_enum) rfl ω₂) l
   }

/-! #brief Helper for showing a category has a finite product.
-/
definition HasFinProduct.show {C : Cat.{ℓobj ℓhom}}
    (factor : list C^.obj)
    (p : C^.obj)
    (proj : HomsOut p factor)
    (univ : ∀ (c : C^.obj) (hom : HomsOut c factor)
            , C^.hom c p)
    (ωuniv : ∀ (c : C^.obj) (hom : HomsOut c factor)
             , hom = HomsOut.comp proj (univ c hom))
    (ωuniq : ∀ (c : C^.obj) (hom : HomsOut c factor) (h : C^.hom c p)
               (ωcomm : hom = HomsOut.comp proj h)
             , h = univ c hom)
    : HasFinProduct C factor
:= HasProduct.show C _ p (HomsOut.get proj)
    (λ c hom, univ c (HomsOut.enum hom))
    (λ c hom n, let hom' : HomsOut c factor := HomsOut.enum hom in
                let f := (λ a j, @Cat.circ C _ _ a j (univ c hom'))
                in begin
                     refine eq.trans (eq.symm (dlist.get_enum hom n)) _,
                     refine eq.trans _ (dlist.get_map f proj n),
                     exact congr_arg (λ bb, HomsOut.get bb n) (ωuniv c _)
                 end)
    (λ c hom h ωcomm, let hom' : HomsOut c factor := HomsOut.enum hom in
                      let f := (λ a j, @Cat.circ C _ _ a j h)
                      in ωuniq c _ h (dlist.enum_eq_map f proj hom @ωcomm))

/-! #brief Finite products are cones.
-/
definition finproduct.cone (C : Cat.{ℓobj ℓhom})
    (factor : list C^.obj)
    [factor_HasFinProduct : HasFinProduct C factor]
    : FinProductCone C factor
:= product.cone C (list.get factor)

/-! #brief The product of a finite collection of objects.
-/
definition finproduct (C : Cat.{ℓobj ℓhom})
    (factor : list C^.obj)
    [factor_HasFinProduct : HasFinProduct C factor]
    : C^.obj
:= (finproduct.cone C factor)^.obj

/-! #brief Projection out of a product.
-/
definition finproduct.π (C : Cat.{ℓobj ℓhom})
    (factor : list C^.obj)
    [factor_HasFinProduct : HasFinProduct C factor]
    (n : fin (list.length factor))
    : C^.hom (finproduct C factor) (list.get factor n)
:= product.π C (list.get factor) n

/-! #brief Every cone is mediated through the product.
-/
definition finproduct.univ (C : Cat.{ℓobj ℓhom})
    (factor : list C^.obj)
    [factor_HasFinProduct : HasFinProduct C factor]
    {c : C^.obj} (hom : HomsOut c factor)
    : C^.hom c (finproduct C factor)
:= product.univ C (list.get factor) (FinProductCone.mk c hom)

/-! #brief Every cone is mediated through the product.
-/
definition finproduct.univ.mediates (C : Cat.{ℓobj ℓhom})
    (factor : list C^.obj)
    [factor_HasFinProduct : HasFinProduct C factor]
    {c : C^.obj} (hom : HomsOut c factor)
    (n : fin (list.length factor))
    : HomsOut.get hom n = C^.circ (finproduct.π C factor n) (finproduct.univ C factor hom)
:= product.univ.mediates C (list.get factor) (FinProductCone.mk c hom) n

/-! #brief The mediating map from the cone to the product is unique.
-/
definition finproduct.univ.uniq (C : Cat.{ℓobj ℓhom})
    (factor : list C^.obj)
    [factor_HasFinProduct : HasFinProduct C factor]
    {c : C^.obj} (hom : HomsOut c factor)
    (m : C^.hom c (finproduct C factor))
    (ω : hom = HomsOut.comp (finproduct.cone C factor)^.Proj m)
    : m = finproduct.univ C factor hom
:= product.univ.uniq C (list.get factor) (FinProductCone.mk c hom) m
    begin
      intro n,
      rw ω,
      refine eq.trans (dlist.get_map _ _ n) _,
      apply congr_arg (λ j, C^.circ j m),
      apply dlist.get_enum
    end

/-! #brief The unique iso between two products of the same factors.
-/
definition finproduct.iso {C : Cat.{ℓobj ℓhom}}
    {factor : list C^.obj}
    (factor_HasFinProduct₁ factor_HasFinProduct₂ : HasFinProduct C factor)
    : C^.hom (@finproduct C factor factor_HasFinProduct₁)
             (@finproduct C factor factor_HasFinProduct₂)
:= product.iso factor_HasFinProduct₁ factor_HasFinProduct₂

/-! #brief Finite products are unique up-to unique isomorphism.
-/
definition finproduct.uniq {C : Cat.{ℓobj ℓhom}}
    {factor : list C^.obj}
    (factor_HasFinProduct₁ factor_HasFinProduct₂ : HasFinProduct C factor)
    : Iso (finproduct.iso factor_HasFinProduct₁ factor_HasFinProduct₂)
          (finproduct.iso factor_HasFinProduct₂ factor_HasFinProduct₁)
:= product.uniq factor_HasFinProduct₁ factor_HasFinProduct₂

/- -----------------------------------------------------------------------
Finite products in functor categories.
----------------------------------------------------------------------- -/

/-! #brief Finite products in functor categories can be computed pointwise.
-/
definition FunCat.HasFinProduct {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    [D_HasAllFinProducts : HasAllFinProducts D]
    (factor : list (Fun C D))
    : HasFinProduct (FunCat C D) factor
:= FunCat.HasLimit (ProductDrgm _ (list.get factor))

/-! #brief Finite products in functor categories can be computed pointwise.
-/
instance FunCat.HasAllFinProducts {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    [D_HasAllFinProducts : HasAllFinProducts D]
    : HasAllFinProducts (FunCat C D)
:= { has_product := λ factor, FunCat.HasFinProduct factor
   }

/- -----------------------------------------------------------------------
Finite products of homs.
----------------------------------------------------------------------- -/

/-! #brief The product of a list of homs.
-/
definition finproduct.hom {C : Cat.{ℓobj ℓhom}}
    {ccs : list (prod C^.obj C^.obj)}
    (fns : HomsList C ccs)
    [ccs_domFinProduct : HasFinProduct C (list.map prod.fst ccs)]
    [ccs_codomFinProduct : HasFinProduct C (list.map prod.snd ccs)]
    : C^.hom (finproduct C (list.map prod.fst ccs))
             (finproduct C (list.map prod.snd ccs))
:= finproduct.univ _ _ (homs_comp_out fns (finproduct.cone C (list.map prod.fst ccs))^.Proj)

example (C : Cat) {x₁ x₂ y₁ y₂ : ⟦C⟧}
        [x_HasFinProduct : HasFinProduct C [x₁, x₂] ]
        [y_HasFinProduct : HasFinProduct C [y₁, y₂] ]
        (f₁ : ⟦C: x₁ →→ y₁⟧)
        (f₂ : ⟦C: x₂ →→ y₂⟧)
        : ⟦C: finproduct C [x₁, x₂] →→ finproduct C [y₁, y₂] ⟧
:= finproduct.hom (f₁ ↗ f₂ ↗↗)

theorem finproduct.hom₂.id {C : Cat} {x₁ x₂ : ⟦C⟧}
        [x_HasFinProduct : HasFinProduct C [x₁, x₂] ]
        : @finproduct.hom _ _ (⟨⟨x₁⟩⟩ ↗ ⟨⟨x₂⟩⟩ ↗↗) x_HasFinProduct x_HasFinProduct
            = C^.id (finproduct C [x₁, x₂])
:= sorry

theorem finproduct.hom₂.circ {C : Cat} {x₁ x₂ y₁ y₂ z₁ z₂ : ⟦C⟧}
        [x_HasFinProduct : HasFinProduct C [x₁, x₂] ]
        [y_HasFinProduct : HasFinProduct C [y₁, y₂] ]
        [z_HasFinProduct : HasFinProduct C [z₁, z₂] ]
        (g₁ : C^.hom y₁ z₁) (g₂ : C^.hom y₂ z₂)
        (f₁ : C^.hom x₁ y₁) (f₂ : C^.hom x₂ y₂)
        : @finproduct.hom _ _ ((g₁ ∘∘ f₁) ↗ (g₂ ∘∘ f₂) ↗↗) x_HasFinProduct z_HasFinProduct
           = @finproduct.hom _ _ (g₁ ↗ g₂ ↗↗) y_HasFinProduct z_HasFinProduct
              ∘∘ @finproduct.hom _ _ (f₁ ↗ f₂ ↗↗) x_HasFinProduct y_HasFinProduct
:= sorry

/- -----------------------------------------------------------------------
Isos between finite products.
----------------------------------------------------------------------- -/

/-! #brief Singleton products are trivial.
-/
instance HasFinProduct.singleton {C : Cat.{ℓobj ℓhom}}
    (c : C^.obj)
    : HasFinProduct C [c]
:= HasFinProduct.show _ c
    (dlist.cons c (C^.id c) [] (dlist.nil _))
    (λ c' proj, begin cases proj, exact b end)
    (λ c' hom, begin
                 cases hom, apply dlist.eq,
                 { exact eq.symm C^.circ_id_left },
                 cases bb, trivial
               end)
    (λ c' hom h ωh, begin cases hom, cases ωh, exact eq.symm C^.circ_id_left end)

definition finproduct.singleton.un {C : Cat.{ℓobj ℓhom}}
    (c : C^.obj)
    [c_HasFinProduct : HasFinProduct C [c]]
    : C^.hom (finproduct C [c]) c
:= finproduct.iso c_HasFinProduct (HasFinProduct.singleton c)

definition finproduct.singleton.to {C : Cat.{ℓobj ℓhom}}
    (c : C^.obj)
    [c_HasFinProduct : HasFinProduct C [c]]
    : C^.hom c (finproduct C [c])
:= finproduct.iso (HasFinProduct.singleton c) c_HasFinProduct

definition finproduct.singleton.Iso {C : Cat.{ℓobj ℓhom}}
    (c : C^.obj)
    [c_HasFinProduct : HasFinProduct C [c]]
    : Iso  (finproduct.singleton.to c) (finproduct.singleton.un c)
:= finproduct.uniq (HasFinProduct.singleton c) c_HasFinProduct

/-! #brief Projections for the (right) flattened product.
-/
definition HasFinProduct.flatten_right.Proj {C : Cat.{ℓobj ℓhom}}
    (factor₁ factor₂ : list C^.obj)
    [factor₂_HasFinProduct : HasFinProduct C factor₂]
    [factor₁₂_HasFinProduct : HasFinProduct C (factor₁ ++ [finproduct C factor₂])]
    : HomsOut (finproduct C (factor₁ ++ [finproduct C factor₂]))
                     (factor₁ ++ factor₂)
:= let prj₁₂ : HomsOut (finproduct C (factor₁ ++ [finproduct C factor₂]))
                       (factor₁ ++ [finproduct C factor₂])
           := (@finproduct.cone _ _ factor₁₂_HasFinProduct)^.Proj in
   let f₁ : HomsOut (finproduct C (factor₁ ++ [finproduct C factor₂])) factor₁
         := HomsOut.split_left prj₁₂ in
   let f₂ : HomsOut (finproduct C (factor₁ ++ [finproduct C factor₂])) [finproduct C factor₂]
         := HomsOut.split_right prj₁₂ in
   let f₂' := HomsOut.comp (@finproduct.cone _ _ factor₂_HasFinProduct)^.Proj (HomsOut.get f₂ fin.zero)
   in HomsOut.append f₁ f₂'

/-! #brief The projections used by the universal map for the (right) flattened product.
-/
definition HasFinProduct.flatten_right.univ.Proj {C : Cat.{ℓobj ℓhom}}
    (factor₁ factor₂ : list C^.obj)
    [factor₂_HasFinProduct : HasFinProduct C factor₂]
    [factor₁₂_HasFinProduct : HasFinProduct C (factor₁ ++ [finproduct C factor₂])]
    (c : C^.obj)
    (homs : HomsOut c (factor₁ ++ factor₂))
    : HomsOut c (factor₁ ++ [finproduct C factor₂])
:= let f₁ : HomsOut c factor₁
         := HomsOut.split_left homs in
   let f₂ : HomsOut c [finproduct C factor₂]
         := dlist.cons _
               (finproduct.univ C factor₂
                 (HomsOut.split_right homs))
               _ (dlist.nil _)
   in HomsOut.append f₁ f₂

/-! #brief Universal map for the (right) flattened product.
-/
definition HasFinProduct.flatten_right.univ {C : Cat.{ℓobj ℓhom}}
    (factor₁ factor₂ : list C^.obj)
    [factor₂_HasFinProduct : HasFinProduct C factor₂]
    [factor₁₂_HasFinProduct : HasFinProduct C (factor₁ ++ [finproduct C factor₂])]
    (c : C^.obj)
    (hom : HomsOut c (factor₁ ++ factor₂))
    : C^.hom c (finproduct C (factor₁ ++ [finproduct C factor₂]))
:= finproduct.univ C (factor₁ ++ [finproduct C factor₂])
                     (HasFinProduct.flatten_right.univ.Proj factor₁ factor₂ c hom)

/-! #brief Flattening of products on the right.
-/
definition HasFinProduct.flatten_right {C : Cat.{ℓobj ℓhom}}
    (factor₁ factor₂ : list C^.obj)
    [factor₂_HasFinProduct : HasFinProduct C factor₂]
    [factor₁₂_HasFinProduct : HasFinProduct C (factor₁ ++ [finproduct C factor₂])]
    : HasFinProduct C (factor₁ ++ factor₂)
:= HasFinProduct.show _
    (finproduct C (factor₁ ++ [finproduct C factor₂]))
    (HasFinProduct.flatten_right.Proj factor₁ factor₂)
    (HasFinProduct.flatten_right.univ factor₁ factor₂)
    sorry
    sorry

definition finproduct.flatten_right {C : Cat.{ℓobj ℓhom}}
    (factor₁ factor₂ : list C^.obj)
    [factor₂_HasFinProduct : HasFinProduct C factor₂]
    [factor₁₂_HasFinProduct : HasFinProduct C (factor₁ ++ [finproduct C factor₂])]
    [factor₁₂_flat_HasFinProduct : HasFinProduct C (factor₁ ++ factor₂)]
    : C^.hom (finproduct C (factor₁ ++ [finproduct C factor₂]))
             (finproduct C (factor₁ ++ factor₂))
:= finproduct.iso (HasFinProduct.flatten_right factor₁ factor₂) factor₁₂_flat_HasFinProduct

definition finproduct.unflatten_right {C : Cat.{ℓobj ℓhom}}
    (factor₁ factor₂ : list C^.obj)
    [factor₂_HasFinProduct : HasFinProduct C factor₂]
    [factor₁₂_HasFinProduct : HasFinProduct C (factor₁ ++ [finproduct C factor₂])]
    [factor₁₂_flat_HasFinProduct : HasFinProduct C (factor₁ ++ factor₂)]
    : C^.hom (finproduct C (factor₁ ++ factor₂))
             (finproduct C (factor₁ ++ [finproduct C factor₂]))
:= finproduct.iso factor₁₂_flat_HasFinProduct (HasFinProduct.flatten_right factor₁ factor₂)

definition finproduct.flatten_right.Iso {C : Cat.{ℓobj ℓhom}}
    (factor₁ factor₂ : list C^.obj)
    [factor₂_HasFinProduct : HasFinProduct C factor₂]
    [factor₁₂_HasFinProduct : HasFinProduct C (factor₁ ++ [finproduct C factor₂])]
    [factor₁₂_flat_HasFinProduct : HasFinProduct C (factor₁ ++ factor₂)]
    : Iso  (finproduct.flatten_right factor₁ factor₂)
           (finproduct.unflatten_right factor₁ factor₂)
:= finproduct.uniq (HasFinProduct.flatten_right factor₁ factor₂) factor₁₂_flat_HasFinProduct

/-! #brief Projections for the flattened product.
-/
definition HasFinProduct.flatten.Proj {C : Cat.{ℓobj ℓhom}}
    (factor₁ factor₂ factor₃ : list C^.obj)
    [factor₂_HasFinProduct : HasFinProduct C factor₂]
    [factor₁₂₃_HasFinProduct : HasFinProduct C (factor₁ ++ [finproduct C factor₂] ++ factor₃)]
    : HomsOut (finproduct C (factor₁ ++ [finproduct C factor₂] ++ factor₃))
                     (factor₁ ++ factor₂ ++ factor₃)
:= let prj₁₂₃ : HomsOut (finproduct C (factor₁ ++ [finproduct C factor₂] ++ factor₃))
                              (factor₁ ++ [finproduct C factor₂] ++ factor₃)
           := (@finproduct.cone _ _ factor₁₂₃_HasFinProduct)^.Proj in
   let f₁ : HomsOut (finproduct C (factor₁ ++ [finproduct C factor₂] ++ factor₃)) factor₁
         := HomsOut.split_left (HomsOut.split_left prj₁₂₃) in
   let f₂ : HomsOut (finproduct C (factor₁ ++ [finproduct C factor₂] ++ factor₃)) [finproduct C factor₂]
         := HomsOut.split_right (HomsOut.split_left prj₁₂₃) in
   let f₂' := HomsOut.comp (@finproduct.cone _ _ factor₂_HasFinProduct)^.Proj (HomsOut.get f₂ fin.zero) in
   let f₃ : HomsOut (finproduct C (factor₁ ++ [finproduct C factor₂] ++ factor₃)) factor₃
         := HomsOut.split_right prj₁₂₃
   in HomsOut.append (HomsOut.append f₁ f₂') f₃

/-! #brief The projections used by the universal map for the flattened product.
-/
definition HasFinProduct.flatten.univ.Proj {C : Cat.{ℓobj ℓhom}}
    (factor₁ factor₂ factor₃ : list C^.obj)
    [factor₂_HasFinProduct : HasFinProduct C factor₂]
    [factor₁₂₃_HasFinProduct : HasFinProduct C (factor₁ ++ [finproduct C factor₂] ++ factor₃)]
    (c : C^.obj)
    (hom : HomsOut c (factor₁ ++ factor₂ ++ factor₃))
    : HomsOut c (factor₁ ++ [finproduct C factor₂] ++ factor₃)
:= let f₁ : HomsOut c factor₁
         := HomsOut.split_left (HomsOut.split_left hom) in
   let f₂ : HomsOut c [finproduct C factor₂]
         := dlist.cons _
               (finproduct.univ C factor₂
                 (HomsOut.split_right (HomsOut.split_left hom)))
               _ (dlist.nil _) in
   let f₃ : HomsOut c factor₃
         := HomsOut.split_right hom
   in HomsOut.append (HomsOut.append f₁ f₂) f₃

/-! #brief Universal map for the flattened product.
-/
definition HasFinProduct.flatten.univ {C : Cat.{ℓobj ℓhom}}
    (factor₁ factor₂ factor₃ : list C^.obj)
    [factor₂_HasFinProduct : HasFinProduct C factor₂]
    [factor₁₂₃_HasFinProduct : HasFinProduct C (factor₁ ++ [finproduct C factor₂] ++ factor₃)]
    (c : C^.obj)
    (hom : HomsOut c (factor₁ ++ factor₂ ++ factor₃))
    : C^.hom c (finproduct C (factor₁ ++ [finproduct C factor₂] ++ factor₃))
:= finproduct.univ C (factor₁ ++ [finproduct C factor₂] ++ factor₃)
                     (HasFinProduct.flatten.univ.Proj factor₁ factor₂ factor₃ c hom)

/-! #brief Flattening of products.
-/
definition HasFinProduct.flatten {C : Cat.{ℓobj ℓhom}}
    (factor₁ factor₂ factor₃ : list C^.obj)
    [factor₂_HasFinProduct : HasFinProduct C factor₂]
    [factor₁₂₃_HasFinProduct : HasFinProduct C (factor₁ ++ [finproduct C factor₂] ++ factor₃)]
    : HasFinProduct C (factor₁ ++ factor₂ ++ factor₃)
:= HasFinProduct.show _
    (finproduct C (factor₁ ++ [finproduct C factor₂] ++ factor₃))
    (HasFinProduct.flatten.Proj factor₁ factor₂ factor₃)
    (HasFinProduct.flatten.univ factor₁ factor₂ factor₃)
    begin
      intros c hom,
      apply HomsOut.append_eq,
      apply HomsOut.append_eq,
      { repeat { rw HomsOut.split_left_comp },
        unfold HasFinProduct.flatten.Proj,
        repeat { rw HomsOut.split_left_append },
        apply HomsOut.get.inj,
        apply funext, intro n, cases n with n ωn,
        rw HomsOut.get_comp,
        repeat { rw HomsOut.get_split_left },
        repeat { rw C^.circ_assoc },
        repeat { rw cast_hom.circ },
        rw -C^.circ_assoc,
        apply cast_hom.circ.congr_right,
        unfold HasFinProduct.flatten.univ,
        refine heq.trans _ (heq_of_eq (Cat.circ.congr_left (eq.symm (HomsOut.get_enum _ _)))),
        refine heq.trans _ (heq_of_eq (finproduct.univ.mediates C
                                        (factor₁ ++ [finproduct C factor₂] ++ factor₃)
                                        (HasFinProduct.flatten.univ.Proj factor₁ factor₂ factor₃ c hom)
                                        {val := n, is_lt := list.length.grow_left (list.length.grow_left ωn)})),
        unfold HasFinProduct.flatten.univ.Proj,
        refine heq.trans _ (heq.symm (HomsOut.get_append _ _ _ _)),
        refine heq.trans _ (heq.symm (HomsOut.get_append _ _ _ _)),
        repeat { rw HomsOut.get_split_left },
        rw [C^.circ_assoc, cast_hom.circ],
        refine heq.trans _ (heq.symm (cast_hom.circ_left_heq _ _)),
        apply heq.refl
      },
      { exact sorry
      },
      { exact sorry
      }
    end
    begin
      intros c hom h ωh,
      exact sorry
    end

definition finproduct.unflatten {C : Cat.{ℓobj ℓhom}}
    (factor₁ factor₂ factor₃ : list C^.obj)
    [factor₂_HasFinProduct : HasFinProduct C factor₂]
    [factor₁₂₃_HasFinProduct : HasFinProduct C (factor₁ ++ [finproduct C factor₂] ++ factor₃)]
    [factor₁₂₃_flat_HasFinProduct : HasFinProduct C (factor₁ ++ factor₂ ++ factor₃)]
    : C^.hom (finproduct C (factor₁ ++ factor₂ ++ factor₃))
             (finproduct C (factor₁ ++ [finproduct C factor₂] ++ factor₃))
:= finproduct.iso factor₁₂₃_flat_HasFinProduct (HasFinProduct.flatten factor₁ factor₂ factor₃)

definition finproduct.flatten {C : Cat.{ℓobj ℓhom}}
    (factor₁ factor₂ factor₃ : list C^.obj)
    [factor₂_HasFinProduct : HasFinProduct C factor₂]
    [factor₁₂₃_HasFinProduct : HasFinProduct C (factor₁ ++ [finproduct C factor₂] ++ factor₃)]
    [factor₁₂₃_flat_HasFinProduct : HasFinProduct C (factor₁ ++ factor₂ ++ factor₃)]
    : C^.hom (finproduct C (factor₁ ++ [finproduct C factor₂] ++ factor₃))
             (finproduct C (factor₁ ++ factor₂ ++ factor₃))
:= finproduct.iso (HasFinProduct.flatten factor₁ factor₂ factor₃) factor₁₂₃_flat_HasFinProduct

definition finproduct.flatten.Iso {C : Cat.{ℓobj ℓhom}}
    (factor₁ factor₂ factor₃ : list C^.obj)
    [factor₂_HasFinProduct : HasFinProduct C factor₂]
    [factor₁₂₃_HasFinProduct : HasFinProduct C (factor₁ ++ [finproduct C factor₂] ++ factor₃)]
    [factor₁₂₃_flat_HasFinProduct : HasFinProduct C (factor₁ ++ factor₂ ++ factor₃)]
    : Iso  (finproduct.flatten factor₁ factor₂ factor₃)
           (finproduct.unflatten factor₁ factor₂ factor₃)
:= finproduct.uniq (HasFinProduct.flatten factor₁ factor₂ factor₃) factor₁₂₃_flat_HasFinProduct

example (C : Cat) (x y z : ⟦C⟧)
        [xy_HasFinProduct : HasFinProduct C [x, y]]
        [xy_z_HasFinProduct : HasFinProduct C [finproduct C [x, y], z]]
        [yz_HasFinProduct : HasFinProduct C [y, z]]
        [x_yz_HasFinProduct : HasFinProduct C [x, finproduct C [y, z]]]
        : ⟦C : finproduct C [finproduct C [x, y], z] →→ finproduct C [x, finproduct C [y, z]]⟧
 := finproduct.iso (@HasFinProduct.flatten C [] [x, y] [z] xy_HasFinProduct xy_z_HasFinProduct)
                   (@HasFinProduct.flatten C [x] [y,z] [] yz_HasFinProduct x_yz_HasFinProduct)

/- -----------------------------------------------------------------------
Co-products.
----------------------------------------------------------------------- -/

/-! #brief A cone over a co-product.
-/
definition CoProductCone (C : Cat.{ℓobj ℓhom}) {A : Type ℓ}
    (factor : A → C^.obj)
    : Type (max ℓ ℓobj ℓhom)
:= CoCone (ProductDrgm C factor)

/-! #brief Helper for making a product cone.
-/
definition CoProductCone.mk {C : Cat.{ℓobj ℓhom}} {A : Type ℓ}
    {factor : A → C^.obj}
    (c : C^.obj)
    (incl : ∀ (a : A), C^.hom (factor a) c)
    : CoProductCone C factor
:= CoCone.mk c incl
    (λ a₁ a₂ f, begin cases f, exact eq.symm C^.circ_id_right end)

/-! #brief A co-product in a category.
-/
@[class] definition HasCoProduct (C : Cat.{ℓobj ℓhom}) {A : Type ℓ}
    (factor : A → C^.obj)
:= HasCoLimit (ProductDrgm C factor)

instance HasCoProduct.HasCoLimit {C : Cat.{ℓobj ℓhom}} {A : Type ℓ}
    (factor : A → C^.obj)
    [factor_HasCoProduct : HasCoProduct C factor]
    : HasCoLimit (ProductDrgm C factor)
:= factor_HasCoProduct

/-! #brief A category with all co-products.
-/
class HasAllCoProducts (C : Cat.{ℓobj ℓhom})
:= (has_coproduct : ∀ {A : Type ℓ} (factor : A → C^.obj)
                    , HasCoProduct C factor)

instance HasAllCoProducts.HasCoProduct (C : Cat.{ℓobj ℓhom})
    [C_HasAllCoProducts : HasAllCoProducts.{ℓ} C]
    {A : Type ℓ} (factor : A → C^.obj)
    : HasCoProduct C factor
:= HasAllCoProducts.has_coproduct factor

instance HasAllCoProducts.HasAllCoLimitsFrom.ObjCat (C : Cat.{ℓobj ℓhom})
    [C_HasAllCoProducts : HasAllCoProducts.{ℓ} C]
    (A : Type ℓ)
    : HasAllCoLimitsFrom C (ObjCat A)
:= { has_colimit := λ L, let l := HasAllCoProducts.HasCoProduct C L^.obj
                         in cast (congr_arg HasCoLimit (ProductDrgm.on_Fun L)) l
   }

/-! #brief Helper for showing a category has a co-product.
-/
definition HasCoProduct.show (C : Cat.{ℓobj ℓhom}) {A : Type ℓ}
    (factor : A → C^.obj)
    (p : C^.obj)
    (incl : ∀ (a : A), C^.hom (factor a) p)
    (univ
      : ∀ (c : C^.obj) (hom : ∀ (a : A), C^.hom (factor a) c)
        , C^.hom p c)
    (ωuniv
      : ∀ (c : C^.obj) (hom : ∀ (a : A), C^.hom (factor a) c)
           (a : A)
        , hom a = C^.circ (univ c hom) (incl a))
    (ωuniq
      : ∀ (c : C^.obj) (hom : ∀ (a : A), C^.hom (factor a) c)
           (h : C^.hom p c) (ωh : ∀ {a : A}, hom a = C^.circ h (incl a))
        , h = univ c hom)
    : HasCoProduct C factor
:= HasCoLimit.show p incl
    (λ a₁ a₂ f, begin cases f, exact eq.symm C^.circ_id_right end)
    (λ c hom ωhom, univ c hom)
    (λ c hom ωhom a, ωuniv c hom a)
    (λ c hom ωhom h ωh, ωuniq c hom h ωh)

/-! #brief Co-products are cones.
-/
definition coproduct.cone (C : Cat.{ℓobj ℓhom}) {A : Type ℓ}
    (factor : A → C^.obj)
    [factor_HasCoProduct : HasCoProduct C factor]
    : CoProductCone C factor
:= colimit.cocone (ProductDrgm C factor)

/-! #brief The co-product of a collection of objects.
-/
definition coproduct (C : Cat.{ℓobj ℓhom}) {A : Type ℓ}
    (factor : A → C^.obj)
    [factor_HasCoProduct : HasCoProduct C factor]
    : C^.obj
:= (coproduct.cone C factor)^.obj

/-! #brief Inclusion into a co-product.
-/
definition coproduct.ι (C : Cat.{ℓobj ℓhom}) {A : Type ℓ}
    (factor : A → C^.obj)
    [factor_HasCoProduct : HasCoProduct C factor]
    (a : A)
    : C^.hom (factor a) (coproduct C factor)
:= colimit.in (ProductDrgm C factor) a

/-! #brief Every cone is mediated through the co-product.
-/
definition coproduct.univ (C : Cat.{ℓobj ℓhom}) {A : Type ℓ}
    (factor : A → C^.obj)
    [factor_HasCoProduct : HasCoProduct C factor]
    (c : CoProductCone C factor)
    : C^.hom (coproduct C factor) c^.obj
:= colimit.univ (ProductDrgm C factor) c

/-! #brief Every cone is mediated through the co-product.
-/
definition coproduct.univ.mediates (C : Cat.{ℓobj ℓhom}) {A : Type ℓ}
    (factor : A → C^.obj)
    {factor_HasCoProduct : HasCoProduct C factor}
    (c : CoProductCone C factor)
    (a : A)
    : c^.hom a = C^.circ (coproduct.univ C factor c) (@coproduct.ι C A factor factor_HasCoProduct a)
:= colimit.univ.mediates c a

/-! #brief The mediating map from the co-product to the cone unique.
-/
definition coproduct.univ.uniq (C : Cat.{ℓobj ℓhom}) {A : Type ℓ}
    (factor : A → C^.obj)
    {factor_HasCoProduct : HasCoProduct C factor}
    (c : CoProductCone C factor)
    (m : C^.hom (coproduct C factor) c^.obj)
    (ω : ∀ (a : A), c^.hom a = m ∘∘ (@coproduct.ι C A factor factor_HasCoProduct a))
    : m = coproduct.univ C factor c
:= colimit.univ.uniq c m ω

/-! #brief The unique iso between two coproducts of the same factors.
-/
definition coproduct.iso {C : Cat.{ℓobj ℓhom}} {A : Type ℓ}
    {factor : A → C^.obj}
    (factor_HasCoProduct₁ factor_HasCoProduct₂ : HasCoProduct C factor)
    : C^.hom (@coproduct C A factor factor_HasCoProduct₁)
             (@coproduct C A factor factor_HasCoProduct₂)
:= colimit.iso factor_HasCoProduct₁ factor_HasCoProduct₂

/-! #brief Co-products are unique up-to unique isomorphism.
-/
definition coproduct.uniq {C : Cat.{ℓobj ℓhom}} {A : Type ℓ}
    {factor : A → C^.obj}
    (factor_HasCoProduct₁ factor_HasCoProduct₂ : HasCoProduct C factor)
    : Iso (coproduct.iso factor_HasCoProduct₁ factor_HasCoProduct₂)
          (coproduct.iso factor_HasCoProduct₂ factor_HasCoProduct₁)
:= { id₁ := (colimit.uniq factor_HasCoProduct₂ factor_HasCoProduct₁)^.id₂
   , id₂ := (colimit.uniq factor_HasCoProduct₂ factor_HasCoProduct₁)^.id₁
   }

/-! #brief Factor-projection out of a certain kind of coproduct.
-/
definition coproduct.factor_out {C : Cat.{ℓobj (ℓhom + 1)}}
    [C_HasFinal : HasFinal C]
    {A : C^.obj}
    (factor : C^.hom (final C) A → C^.obj)
    [factor_HasCoProduct : HasCoProduct C factor]
    : C^.hom (coproduct C factor) A
:= coproduct.univ C factor
    (CoProductCone.mk A (λ a, C^.circ a (final_hom (factor a))))

/- -----------------------------------------------------------------------
Co-products in functor categories.
----------------------------------------------------------------------- -/

/-! #brief Co-products in functor categories can be computed pointwise.
-/
instance FunCat.HasCoProduct {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    [D_HasAllCoProducts : HasAllCoProducts.{ℓ} D]
    {A : Type ℓ} (factor : A → Fun C D)
    : HasCoProduct (FunCat C D) factor
:= @FunCat.HasCoLimit C D _ (HasAllCoProducts.HasAllCoLimitsFrom.ObjCat D A)
      (ProductDrgm (FunCat C D) factor)

/-! #brief Co-products in functor categories can be computed pointwise.
-/
instance FunCat.HasAllCoProducts {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    [D_HasAllCoProducts : HasAllCoProducts.{ℓ} D]
    : HasAllCoProducts.{ℓ} (FunCat C D)
:= { has_coproduct := λ A factor, FunCat.HasCoProduct factor
   }

/- -----------------------------------------------------------------------
Finite co-products.
----------------------------------------------------------------------- -/

/-! #brief A cone over a finite co-product.
-/
definition FinCoProductCone (C : Cat.{ℓobj ℓhom})
    (factor : list C^.obj)
    : Type (max ℓobj ℓhom)
:= CoProductCone C (list.get factor)

/-! #brief Every finite co-product cone comes with inclusions.
-/
definition FinCoProductCone.Proj {C : Cat.{ℓobj ℓhom}}
    {factor : list C^.obj}
    (c : FinCoProductCone C factor)
    : HomsIn factor c^.obj
:= dlist.enum (Cone.hom c)

/-! #brief Helper for making a finite co-product cone.
-/
definition FinCoProductCone.mk {C : Cat.{ℓobj ℓhom}}
    {factor : list C^.obj}
    (c : C^.obj)
    (incl : HomsIn factor c)
    : FinCoProductCone C factor
:= CoProductCone.mk c (HomsIn.get incl)

/-! #brief A finite co-product in a category.
-/
@[class] definition HasFinCoProduct (C : Cat.{ℓobj ℓhom})
    (factor : list C^.obj)
:= HasCoProduct C (list.get factor)

instance HasFinCoProduct.HasCoProduct (C : Cat.{ℓobj ℓhom})
    (factor : list C^.obj)
    [factor_HasCoProduct : HasFinCoProduct C factor]
    : HasCoProduct C (list.get factor)
:= factor_HasCoProduct

/-! #brief A category with all finite co-products.
-/
class HasAllFinCoProducts (C : Cat.{ℓobj ℓhom})
:= (has_coproduct : ∀ (factor : list C^.obj), HasFinCoProduct C factor)

instance HasAllFinCoProducts.HasFinCoProduct (C : Cat.{ℓobj ℓhom})
    [C_HasAllFinCoProducts : HasAllFinCoProducts C]
    (factor : list C^.obj)
    : HasFinCoProduct C factor
:= HasAllFinCoProducts.has_coproduct factor

instance HasAllFinCoProducts.HasAllCoLimitsFrom.ObjCat (C : Cat.{ℓobj ℓhom})
    [C_HasAllFinCoProducts : HasAllFinCoProducts C]
    (N : ℕ)
    : HasAllCoLimitsFrom C (ObjCat (fin N))
:= { has_colimit
      := λ L, let l := HasAllFinCoProducts.HasFinCoProduct C (fin.enum L^.obj)
           in let ω₁ : ObjCat (fin (list.length (fin.enum (L^.obj)))) = ObjCat (fin N)
                    := by rw list.length_enum
           in let ω₂ : ProductDrgm C (list.get (fin.enum L^.obj)) == L
                   := by calc ProductDrgm C (list.get (fin.enum L^.obj))
                                  == ProductDrgm C L^.obj : ProductDrgm.heq _ (congr_arg fin (list.length_enum _))
                                                             list.get_enum'
                              ... = L                     : ProductDrgm.on_Fun L
              in cast (HasCoLimit.heq (by rw list.length_enum) rfl ω₂) l
   }

/-! #brief Helper for showing a category has a finite co-product.
-/
definition HasFinCoProduct.show {C : Cat.{ℓobj ℓhom}}
    (factor : list C^.obj)
    (p : C^.obj)
    (incl : HomsIn factor p)
    (univ : ∀ (c : C^.obj) (hom : HomsIn factor c)
            , C^.hom p c)
    (ωuniv : ∀ (c : C^.obj) (hom : HomsIn factor c)
             , hom = HomsIn.comp (univ c hom) incl)
    (ωuniq : ∀ (c : C^.obj) (hom : HomsIn factor c) (h : C^.hom p c)
               (ωcomm : hom = HomsIn.comp h incl)
             , h = univ c hom)
    : HasFinCoProduct C factor
:= HasCoProduct.show C _ p
    (HomsIn.get incl)
    (λ c homs, univ c (HomsIn.enum homs))
    (λ c homs n, sorry)
    (λ c homs h ωh, sorry)

/-! #brief Finite co-products are cones.
-/
definition fincoproduct.cone (C : Cat.{ℓobj ℓhom})
    (factor : list C^.obj)
    [factor_HasFinCoProduct : HasFinCoProduct C factor]
    : FinCoProductCone C factor
:= coproduct.cone C (list.get factor)

/-! #brief The co-product of a finite collection of objects.
-/
definition fincoproduct (C : Cat.{ℓobj ℓhom})
    (factor : list C^.obj)
    [factor_HasFinCoProduct : HasFinCoProduct C factor]
    : C^.obj
:= (fincoproduct.cone C factor)^.obj

/-! #brief An esoteric but useful equality helper.
-/
theorem fincoproduct.eq {C : Cat.{ℓobj ℓhom}}
    [C_HasAllFinCoProducts : HasAllFinCoProducts C]
    : ∀ (factor₁ factor₂ : list C^.obj)
        (ωfactor : factor₁ = factor₂)
      , @fincoproduct C factor₁ (HasAllFinCoProducts.HasFinCoProduct C factor₁)
          = @fincoproduct C factor₂ (HasAllFinCoProducts.HasFinCoProduct C factor₂)
| factor .(factor) (eq.refl .(factor)) := rfl

/-! #brief Inclusion into a finite co-product.
-/
definition fincoproduct.ι (C : Cat.{ℓobj ℓhom})
    (factor : list C^.obj)
    [factor_HasFinCoProduct : HasFinCoProduct C factor]
    (n : fin (list.length factor))
    : C^.hom (list.get factor n) (fincoproduct C factor)
:= coproduct.ι C (list.get factor) n

/-! #brief Every cone is mediated through the co-product.
-/
definition fincoproduct.univ (C : Cat.{ℓobj ℓhom})
    (factor : list C^.obj)
    [factor_HasFinCoProduct : HasFinCoProduct C factor]
    {c : C^.obj} (hom : HomsIn factor c)
    : C^.hom (fincoproduct C factor) c
:= coproduct.univ C (list.get factor) (FinCoProductCone.mk c hom)

/-! #brief Every cone is mediated through the co-product.
-/
definition fincoproduct.univ.mediates (C : Cat.{ℓobj ℓhom})
    (factor : list C^.obj)
    [factor_HasFinCoProduct : HasFinCoProduct C factor]
    {c : C^.obj} (hom : HomsIn factor c)
    (n : fin (list.length factor))
    : HomsIn.get hom n = C^.circ (fincoproduct.univ C factor hom) (fincoproduct.ι C factor n)
:= coproduct.univ.mediates C (list.get factor) (FinCoProductCone.mk c hom) n

/-! #brief The mediating map from the cone to the product is unique.
-/
definition fincoproduct.univ.uniq (C : Cat.{ℓobj ℓhom})
    (factor : list C^.obj)
    [factor_HasFinCoProduct : HasFinCoProduct C factor]
    {c : C^.obj} (hom : HomsIn factor c)
    (m : C^.hom (fincoproduct C factor) c)
    (ω : hom = HomsIn.comp m (fincoproduct.cone C factor)^.Proj)
    : m = fincoproduct.univ C factor hom
:= coproduct.univ.uniq C (list.get factor)
    (CoProductCone.mk c (HomsIn.get hom))
    m
    (λ n, sorry)

/-! #brief The unique iso between two co-products of the same factors.
-/
definition fincoproduct.iso {C : Cat.{ℓobj ℓhom}}
    {factor : list C^.obj}
    (factor_HasFinCoProduct₁ factor_HasFinCoProduct₂ : HasFinCoProduct C factor)
    : C^.hom (@fincoproduct C factor factor_HasFinCoProduct₁)
             (@fincoproduct C factor factor_HasFinCoProduct₂)
:= coproduct.iso factor_HasFinCoProduct₁ factor_HasFinCoProduct₂

/-! #brief Finite products are unique up-to unique isomorphism.
-/
definition fincoproduct.uniq {C : Cat.{ℓobj ℓhom}}
    {factor : list C^.obj}
    (factor_HasFinCoProduct₁ factor_HasFinCoProduct₂ : HasFinCoProduct C factor)
    : Iso (fincoproduct.iso factor_HasFinCoProduct₁ factor_HasFinCoProduct₂)
          (fincoproduct.iso factor_HasFinCoProduct₂ factor_HasFinCoProduct₁)
:= coproduct.uniq factor_HasFinCoProduct₁ factor_HasFinCoProduct₂

/- -----------------------------------------------------------------------
Finite co-products in functor categories.
----------------------------------------------------------------------- -/

/-! #brief Finite co-products in functor categories can be computed pointwise.
-/
instance FunCat.HasFinCoProduct {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    [D_HasAllFinCoProducts : HasAllFinCoProducts D]
    (factor : list (Fun C D))
    : HasFinCoProduct (FunCat C D) factor
:= @FunCat.HasCoLimit C D _ (HasAllFinCoProducts.HasAllCoLimitsFrom.ObjCat D _)
      (ProductDrgm (FunCat C D) (list.get factor))

/-! #brief Co-products in functor categories can be computed pointwise.
-/
instance FunCat.HasAllCoFinProducts {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    [D_HasAllFinCoProducts : HasAllFinCoProducts D]
    : HasAllFinCoProducts (FunCat C D)
:= { has_coproduct := λ factor, FunCat.HasFinCoProduct factor
   }

/- -----------------------------------------------------------------------
Finite co-products of homs.
----------------------------------------------------------------------- -/

/-! #brief The product of a list of homs.
-/
definition fincoproduct.hom {C : Cat.{ℓobj ℓhom}}
    {ccs : list (prod C^.obj C^.obj)}
    (fns : HomsList C ccs)
    [ccs_domFinCoProduct : HasFinCoProduct C (list.map prod.fst ccs)]
    [ccs_codomFinCoProduct : HasFinCoProduct C (list.map prod.snd ccs)]
    : C^.hom (fincoproduct C (list.map prod.fst ccs))
             (fincoproduct C (list.map prod.snd ccs))
:= fincoproduct.univ _ _ (homs_comp_in (fincoproduct.cone C (list.map prod.snd ccs))^.Proj fns)

end qp


/-
Copyright (c) 2021 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import algebra.group_power.basic
import algebra.ring.opposite
import group_theory.group_action.opposite
import group_theory.group_action.prod

/-!
# Introduce `smul_with_zero`

In analogy with the usual monoid action on a Type `M`, we introduce an action of a
`monoid_with_zero` on a Type with `0`.

In particular, for Types `R` and `M`, both containing `0`, we define `smul_with_zero R M` to
be the typeclass where the products `r • 0` and `0 • m` vanish for all `r : R` and all `m : M`.

Moreover, in the case in which `R` is a `monoid_with_zero`, we introduce the typeclass
`mul_action_with_zero R M`, mimicking group actions and having an absorbing `0` in `R`.
Thus, the action is required to be compatible with

* the unit of the monoid, acting as the identity;
* the zero of the monoid_with_zero, acting as zero;
* associativity of the monoid.

We also add an `instance`:

* any `monoid_with_zero` has a `mul_action_with_zero R R` acting on itself.

## Main declarations

* `smul_monoid_with_zero_hom`: Scalar multiplication bundled as a morphism of monoids with zero.
-/

variables {R R' M M' : Type*}

section has_zero

variables (R M)
/--  `smul_with_zero` is a class consisting of a Type `R` with `0 ∈ R` and a scalar multiplication
of `R` on a Type `M` with `0`, such that the equality `r • m = 0` holds if at least one among `r`
or `m` equals `0`. -/
class smul_with_zero [has_zero R] [has_zero M] extends has_smul R M :=
(smul_zero : ∀ r : R, r • (0 : M) = 0)
(zero_smul : ∀ m : M, (0 : R) • m = 0)

instance mul_zero_class.to_smul_with_zero [mul_zero_class R] : smul_with_zero R R :=
{ smul := (*),
  smul_zero := mul_zero,
  zero_smul := zero_mul }

/-- Like `mul_zero_class.to_smul_with_zero`, but multiplies on the right. -/
instance mul_zero_class.to_opposite_smul_with_zero [mul_zero_class R] : smul_with_zero Rᵐᵒᵖ R :=
{ smul := (•),
  smul_zero := λ r, zero_mul _,
  zero_smul := mul_zero }

variables (R) {M} [has_zero R] [has_zero M] [smul_with_zero R M]

@[simp] lemma zero_smul (m : M) : (0 : R) • m = 0 := smul_with_zero.zero_smul m

variables {R} (M)
/-- Note that this lemma has different typeclass assumptions to `smul_zero`. -/
@[simp] lemma smul_zero' (r : R) : r • (0 : M) = 0 := smul_with_zero.smul_zero r

variables {R M} [has_zero R'] [has_zero M'] [has_smul R M']

/-- Pullback a `smul_with_zero` structure along an injective zero-preserving homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.smul_with_zero
  (f : zero_hom M' M) (hf : function.injective f) (smul : ∀ (a : R) b, f (a • b) = a • f b) :
  smul_with_zero R M' :=
{ smul := (•),
  zero_smul := λ a, hf $ by simp [smul],
  smul_zero := λ a, hf $ by simp [smul]}

/-- Pushforward a `smul_with_zero` structure along a surjective zero-preserving homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.surjective.smul_with_zero
  (f : zero_hom M M') (hf : function.surjective f) (smul : ∀ (a : R) b, f (a • b) = a • f b) :
  smul_with_zero R M' :=
{ smul := (•),
  zero_smul := λ m, by { rcases hf m with ⟨x, rfl⟩, simp [←smul] },
  smul_zero := λ c, by simp only [← f.map_zero, ← smul, smul_zero'] }

variables (M)

/-- Compose a `smul_with_zero` with a `zero_hom`, with action `f r' • m` -/
def smul_with_zero.comp_hom (f : zero_hom R' R) : smul_with_zero R' M :=
{ smul := (•) ∘ f,
  smul_zero := λ m, by simp,
  zero_smul := λ m, by simp }

end has_zero

instance add_monoid.nat_smul_with_zero [add_monoid M] : smul_with_zero ℕ M :=
{ smul_zero := nsmul_zero,
  zero_smul := zero_nsmul }

instance add_group.int_smul_with_zero [add_group M] : smul_with_zero ℤ M :=
{ smul_zero := zsmul_zero,
  zero_smul := zero_zsmul }

section monoid_with_zero

variables [monoid_with_zero R] [monoid_with_zero R'] [has_zero M]

variables (R M)
/--  An action of a monoid with zero `R` on a Type `M`, also with `0`, extends `mul_action` and
is compatible with `0` (both in `R` and in `M`), with `1 ∈ R`, and with associativity of
multiplication on the monoid `M`. -/
class mul_action_with_zero extends mul_action R M :=
-- these fields are copied from `smul_with_zero`, as `extends` behaves poorly
(smul_zero : ∀ r : R, r • (0 : M) = 0)
(zero_smul : ∀ m : M, (0 : R) • m = 0)

@[priority 100] -- see Note [lower instance priority]
instance mul_action_with_zero.to_smul_with_zero [m : mul_action_with_zero R M] :
  smul_with_zero R M :=
{..m}

/-- See also `semiring.to_module` -/
instance monoid_with_zero.to_mul_action_with_zero : mul_action_with_zero R R :=
{ ..mul_zero_class.to_smul_with_zero R,
  ..monoid.to_mul_action R }

/-- Like `monoid_with_zero.to_mul_action_with_zero`, but multiplies on the right. See also
`semiring.to_opposite_module` -/
instance monoid_with_zero.to_opposite_mul_action_with_zero : mul_action_with_zero Rᵐᵒᵖ R :=
{ ..mul_zero_class.to_opposite_smul_with_zero R,
  ..monoid.to_opposite_mul_action R }

variables {R M} [mul_action_with_zero R M] [has_zero M'] [has_smul R M']

/-- Pullback a `mul_action_with_zero` structure along an injective zero-preserving homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.mul_action_with_zero
  (f : zero_hom M' M) (hf : function.injective f) (smul : ∀ (a : R) b, f (a • b) = a • f b) :
  mul_action_with_zero R M' :=
{ ..hf.mul_action f smul, ..hf.smul_with_zero f smul }

/-- Pushforward a `mul_action_with_zero` structure along a surjective zero-preserving homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.surjective.mul_action_with_zero
  (f : zero_hom M M') (hf : function.surjective f) (smul : ∀ (a : R) b, f (a • b) = a • f b) :
  mul_action_with_zero R M' :=
{ ..hf.mul_action f smul, ..hf.smul_with_zero f smul }

variables (M)

/-- Compose a `mul_action_with_zero` with a `monoid_with_zero_hom`, with action `f r' • m` -/
def mul_action_with_zero.comp_hom (f : R' →*₀ R) : mul_action_with_zero R' M :=
{ smul := (•) ∘ f,
  mul_smul := λ r s m, by simp [mul_smul],
  one_smul := λ m, by simp,
  .. smul_with_zero.comp_hom M f.to_zero_hom}

end monoid_with_zero

section group_with_zero
variables {α β : Type*} [group_with_zero α] [group_with_zero β] [mul_action_with_zero α β]

lemma smul_inv₀ [smul_comm_class α β β] [is_scalar_tower α β β] (c : α) (x : β) :
  (c • x)⁻¹ = c⁻¹ • x⁻¹ :=
begin
  obtain rfl | hc := eq_or_ne c 0,
  { simp only [inv_zero, zero_smul] },
  obtain rfl | hx := eq_or_ne x 0,
  { simp only [inv_zero, smul_zero'] },
  { refine inv_eq_of_mul_eq_one_left _,
    rw [smul_mul_smul, inv_mul_cancel hc, inv_mul_cancel hx, one_smul] }
end

end group_with_zero

/-- Scalar multiplication as a monoid homomorphism with zero. -/
@[simps]
def smul_monoid_with_zero_hom {α β : Type*} [monoid_with_zero α] [mul_zero_one_class β]
  [mul_action_with_zero α β] [is_scalar_tower α β β] [smul_comm_class α β β] :
  α × β →*₀ β :=
{ map_zero' := smul_zero' _ _,
  .. smul_monoid_hom }


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.int.basic
import order.succ_pred

/-!
# Successors and predecessors of integers

In this file, we show that `ℤ` is both an archimedean `succ_order` and an archimedean `pred_order`.
-/

open function int

@[reducible] -- so that Lean reads `int.succ` through `succ_order.succ`
instance : succ_order ℤ :=
{ succ := succ,
  ..succ_order.of_succ_le_iff succ (λ a b, iff.rfl) }

@[reducible] -- so that Lean reads `int.pred` through `pred_order.pred`
instance : pred_order ℤ :=
{ pred := pred,
  pred_le := λ a, (sub_one_lt_of_le le_rfl).le,
  minimal_of_le_pred := λ a ha, ((sub_one_lt_of_le le_rfl).not_le ha).elim,
  le_pred_of_lt := λ a b, le_sub_one_of_lt,
  le_of_pred_lt := λ a b, le_of_sub_one_lt }

lemma int.succ_iterate (a : ℤ) : ∀ n, succ^[n] a = a + n
| 0       := (add_zero a).symm
| (n + 1) := by { rw [function.iterate_succ', int.coe_nat_succ, ←add_assoc],
    exact congr_arg _ (int.succ_iterate n) }

lemma int.pred_iterate (a : ℤ) : ∀ n, pred^[n] a = a - n
| 0       := (sub_zero a).symm
| (n + 1) := by { rw [function.iterate_succ', int.coe_nat_succ, ←sub_sub],
    exact congr_arg _ (int.pred_iterate n) }

instance : is_succ_archimedean ℤ :=
⟨λ a b h, ⟨(b - a).to_nat,
  by rw [int.succ_iterate, int.to_nat_sub_of_le h, ←add_sub_assoc, add_sub_cancel']⟩⟩

instance : is_pred_archimedean ℤ :=
⟨λ a b h, ⟨(b - a).to_nat, by rw [int.pred_iterate, int.to_nat_sub_of_le h, sub_sub_cancel]⟩⟩