/-
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.monad.basic
import category_theory.adjunction.basic
import category_theory.reflects_isomorphisms

/-!
# Eilenberg-Moore (co)algebras for a (co)monad

This file defines Eilenberg-Moore (co)algebras for a (co)monad,
and provides the category instance for them.

Further it defines the adjoint pair of free and forgetful functors, respectively
from and to the original category, as well as the adjoint pair of forgetful and
cofree functors, respectively from and to the original category.

## References
* [Riehl, *Category theory in context*, Section 5.2.4][riehl2017]
-/

namespace category_theory
open category

universes v₁ u₁ -- morphism levels before object levels. See note [category_theory universes].

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

namespace monad

/-- An Eilenberg-Moore algebra for a monad `T`.
    cf Definition 5.2.3 in [Riehl][riehl2017]. -/
structure algebra (T : monad C) : Type (max u₁ v₁) :=
(A : C)
(a : (T : C ⥤ C).obj A ⟶ A)
(unit' : T.η.app A ≫ a = 𝟙 A . obviously)
(assoc' : T.μ.app A ≫ a = (T : C ⥤ C).map a ≫ a . obviously)

restate_axiom algebra.unit'
restate_axiom algebra.assoc'
attribute [reassoc] algebra.unit algebra.assoc

namespace algebra
variables {T : monad C}

/-- A morphism of Eilenberg–Moore algebras for the monad `T`. -/
@[ext] structure hom (A B : algebra T) :=
(f : A.A ⟶ B.A)
(h' : T.map f ≫ B.a = A.a ≫ f . obviously)

restate_axiom hom.h'
attribute [simp, reassoc] hom.h

namespace hom

/-- The identity homomorphism for an Eilenberg–Moore algebra. -/
def id (A : algebra T) : hom A A :=
{ f := 𝟙 A.A }

instance (A : algebra T) : inhabited (hom A A) := ⟨{ f := 𝟙 _ }⟩

/-- Composition of Eilenberg–Moore algebra homomorphisms. -/
def comp {P Q R : algebra T} (f : hom P Q) (g : hom Q R) : hom P R :=
{ f := f.f ≫ g.f }

end hom

instance : category_struct (algebra T) :=
{ hom := hom,
  id := hom.id,
  comp := @hom.comp _ _ _ }

@[simp] lemma comp_eq_comp {A A' A'' : algebra T} (f : A ⟶ A') (g : A' ⟶ A'') :
  algebra.hom.comp f g = f ≫ g := rfl
@[simp] lemma id_eq_id (A : algebra T) :
  algebra.hom.id A = 𝟙 A := rfl

@[simp]

/-- The category of Eilenberg-Moore algebras for a monad.
    cf Definition 5.2.4 in [Riehl][riehl2017]. -/
instance EilenbergMoore : category (algebra T) := {}.

/--
To construct an isomorphism of algebras, it suffices to give an isomorphism of the carriers which
commutes with the structure morphisms.
-/
@[simps]
def iso_mk {A B : algebra T} (h : A.A ≅ B.A) (w : T.map h.hom ≫ B.a = A.a ≫ h.hom) : A ≅ B :=
{ hom := { f := h.hom },
  inv :=
  { f := h.inv,
    h' := by { rw [h.eq_comp_inv, category.assoc, ←w, ←functor.map_comp_assoc], simp } } }

end algebra

variables (T : monad C)

/-- The forgetful functor from the Eilenberg-Moore category, forgetting the algebraic structure. -/
@[simps] def forget : algebra T ⥤ C :=
{ obj := λ A, A.A,
  map := λ A B f, f.f }

/-- The free functor from the Eilenberg-Moore category, constructing an algebra for any object. -/
@[simps] def free : C ⥤ algebra T :=
{ obj := λ X,
  { A := T.obj X,
    a := T.μ.app X,
    assoc' := (T.assoc _).symm },
  map := λ X Y f,
  { f := T.map f,
    h' := T.μ.naturality _ } }

instance [inhabited C] : inhabited (algebra T) :=
⟨(free T).obj (default C)⟩

/-- The adjunction between the free and forgetful constructions for Eilenberg-Moore algebras for
  a monad. cf Lemma 5.2.8 of [Riehl][riehl2017]. -/
-- The other two `simps` projection lemmas can be derived from these two, so `simp_nf` complains if
-- those are added too
@[simps unit counit {rhs_md := semireducible}]
def adj : T.free ⊣ T.forget :=
adjunction.mk_of_hom_equiv
{ hom_equiv := λ X Y,
  { to_fun := λ f, T.η.app X ≫ f.f,
    inv_fun := λ f,
    { f := T.map f ≫ Y.a,
      h' := by { dsimp, simp [←Y.assoc, ←T.μ.naturality_assoc] } },
    left_inv := λ f, by { ext, dsimp, simp },
    right_inv := λ f,
    begin
      dsimp only [forget_obj, monad_to_functor_eq_coe],
      rw [←T.η.naturality_assoc, Y.unit],
      apply category.comp_id,
    end }}

/--
Given an algebra morphism whose carrier part is an isomorphism, we get an algebra isomorphism.
-/
lemma algebra_iso_of_iso {A B : algebra T} (f : A ⟶ B) [is_iso f.f] : is_iso f :=
⟨⟨{ f := inv f.f,
    h' := by { rw [is_iso.eq_comp_inv f.f, category.assoc, ← f.h], dsimp, simp } }, by tidy⟩⟩

instance forget_reflects_iso : reflects_isomorphisms (forget T) :=
{ reflects := λ A B, algebra_iso_of_iso T }

instance forget_faithful : faithful (forget T) := {}

/--
Given a monad morphism from `T₂` to `T₁`, we get a functor from the algebras of `T₁` to algebras of
`T₂`.
-/
@[simps]
def algebra_functor_of_monad_hom {T₁ T₂ : monad C} (h : T₂ ⟶ T₁) :
  algebra T₁ ⥤ algebra T₂ :=
{ obj := λ A,
  { A := A.A,
    a := h.app A.A ≫ A.a,
    unit' := by { dsimp, simp [A.unit] },
    assoc' := by { dsimp, simp [A.assoc] } },
  map := λ A₁ A₂ f,
  { f := f.f } }

/--
The identity monad morphism induces the identity functor from the category of algebras to itself.
-/
@[simps {rhs_md := semireducible}]
def algebra_functor_of_monad_hom_id {T₁ : monad C} :
  algebra_functor_of_monad_hom (𝟙 T₁) ≅ 𝟭 _ :=
nat_iso.of_components
  (λ X, algebra.iso_mk (iso.refl _) (by { dsimp, simp, }))
  (λ X Y f, by { ext, dsimp, simp })

/--
A composition of monad morphisms gives the composition of corresponding functors.
-/
@[simps {rhs_md := semireducible}]
def algebra_functor_of_monad_hom_comp {T₁ T₂ T₃ : monad C} (f : T₁ ⟶ T₂) (g : T₂ ⟶ T₃) :
  algebra_functor_of_monad_hom (f ≫ g) ≅
    algebra_functor_of_monad_hom g ⋙ algebra_functor_of_monad_hom f :=
nat_iso.of_components
  (λ X, algebra.iso_mk (iso.refl _) (by { dsimp, simp }))
  (λ X Y f, by { ext, dsimp, simp })

/--
If `f` and `g` are two equal morphisms of monads, then the functors of algebras induced by them
are isomorphic.
We define it like this as opposed to using `eq_to_iso` so that the components are nicer to prove
lemmas about.
-/
@[simps {rhs_md := semireducible}]
def algebra_functor_of_monad_hom_eq {T₁ T₂ : monad C} {f g : T₁ ⟶ T₂} (h : f = g) :
  algebra_functor_of_monad_hom f ≅ algebra_functor_of_monad_hom g :=
nat_iso.of_components
  (λ X, algebra.iso_mk (iso.refl _) (by { dsimp, simp [h] }))
  (λ X Y f, by { ext, dsimp, simp })

/--
Isomorphic monads give equivalent categories of algebras. Furthermore, they are equivalent as
categories over `C`, that is, we have `algebra_equiv_of_iso_monads h ⋙ forget = forget`.
-/
@[simps]
def algebra_equiv_of_iso_monads {T₁ T₂ : monad C} (h : T₁ ≅ T₂) :
  algebra T₁ ≌ algebra T₂ :=
{ functor := algebra_functor_of_monad_hom h.inv,
  inverse := algebra_functor_of_monad_hom h.hom,
  unit_iso :=
    algebra_functor_of_monad_hom_id.symm ≪≫
    algebra_functor_of_monad_hom_eq (by simp) ≪≫
    algebra_functor_of_monad_hom_comp _ _,
  counit_iso :=
    (algebra_functor_of_monad_hom_comp _ _).symm ≪≫
    algebra_functor_of_monad_hom_eq (by simp) ≪≫
    algebra_functor_of_monad_hom_id }

@[simp] lemma algebra_equiv_of_iso_monads_comp_forget {T₁ T₂ : monad C} (h : T₁ ⟶ T₂) :
  algebra_functor_of_monad_hom h ⋙ forget _ = forget _ :=
rfl

end monad

namespace comonad

/-- An Eilenberg-Moore coalgebra for a comonad `T`. -/
@[nolint has_inhabited_instance]
structure coalgebra (G : comonad C) : Type (max u₁ v₁) :=
(A : C)
(a : A ⟶ G.obj A)
(counit' : a ≫ G.ε.app A = 𝟙 A . obviously)
(coassoc' : a ≫ G.δ.app A = a ≫ G.map a . obviously)

restate_axiom coalgebra.counit'
restate_axiom coalgebra.coassoc'
attribute [reassoc] coalgebra.counit coalgebra.coassoc

namespace coalgebra
variables {G : comonad C}

/-- A morphism of Eilenberg-Moore coalgebras for the comonad `G`. -/
@[ext, nolint has_inhabited_instance] structure hom (A B : coalgebra G) :=
(f : A.A ⟶ B.A)
(h' : A.a ≫ G.map f = f ≫ B.a . obviously)

restate_axiom hom.h'
attribute [simp, reassoc] hom.h

namespace hom

/-- The identity homomorphism for an Eilenberg–Moore coalgebra. -/
def id (A : coalgebra G) : hom A A :=
{ f := 𝟙 A.A }

/-- Composition of Eilenberg–Moore coalgebra homomorphisms. -/
def comp {P Q R : coalgebra G} (f : hom P Q) (g : hom Q R) : hom P R :=
{ f := f.f ≫ g.f }

end hom

/-- The category of Eilenberg-Moore coalgebras for a comonad. -/
instance : category_struct (coalgebra G) :=
{ hom := hom,
  id := hom.id,
  comp := @hom.comp _ _ _ }

@[simp] lemma comp_eq_comp {A A' A'' : coalgebra G} (f : A ⟶ A') (g : A' ⟶ A'') :
  coalgebra.hom.comp f g = f ≫ g := rfl
@[simp] lemma id_eq_id (A : coalgebra G) :
  coalgebra.hom.id A = 𝟙 A := rfl

@[simp] lemma id_f (A : coalgebra G) : (𝟙 A : A ⟶ A).f = 𝟙 A.A := rfl
@[simp] lemma comp_f {A A' A'' : coalgebra G} (f : A ⟶ A') (g : A' ⟶ A'') :
  (f ≫ g).f = f.f ≫ g.f := rfl

/-- The category of Eilenberg-Moore coalgebras for a comonad. -/
instance EilenbergMoore : category (coalgebra G) := {}.

/--
To construct an isomorphism of coalgebras, it suffices to give an isomorphism of the carriers which
commutes with the structure morphisms.
-/
@[simps]
def iso_mk {A B : coalgebra G} (h : A.A ≅ B.A) (w : A.a ≫ G.map h.hom = h.hom ≫ B.a) : A ≅ B :=
{ hom := { f := h.hom },
  inv :=
  { f := h.inv,
    h' := by { rw [h.eq_inv_comp, ←reassoc_of w, ←functor.map_comp], simp } } }

end coalgebra

variables (G : comonad C)

/-- The forgetful functor from the Eilenberg-Moore category, forgetting the coalgebraic
structure. -/
@[simps] def forget : coalgebra G ⥤ C :=
{ obj := λ A, A.A,
  map := λ A B f, f.f }

/--
Given a coalgebra morphism whose carrier part is an isomorphism, we get a coalgebra isomorphism.
-/
lemma coalgebra_iso_of_iso {A B : coalgebra G} (f : A ⟶ B) [is_iso f.f] : is_iso f :=
⟨⟨{ f := inv f.f,
    h' := by { rw [is_iso.eq_inv_comp f.f, ←f.h_assoc], dsimp, simp } }, by tidy⟩⟩

instance forget_reflects_iso : reflects_isomorphisms (forget G) :=
{ reflects := λ A B, coalgebra_iso_of_iso G }

/-- The cofree functor from the Eilenberg-Moore category, constructing a coalgebra for any
object. -/
@[simps] def cofree : C ⥤ coalgebra G :=
{ obj := λ X,
  { A := G.obj X,
    a := G.δ.app X,
    coassoc' := (G.coassoc _).symm },
  map := λ X Y f,
  { f := G.map f,
    h' := (G.δ.naturality _).symm } }

/--
The adjunction between the cofree and forgetful constructions for Eilenberg-Moore coalgebras
for a comonad.
-/
-- The other two `simps` projection lemmas can be derived from these two, so `simp_nf` complains if
-- those are added too
@[simps unit counit]
def adj : forget G ⊣ cofree G :=
adjunction.mk_of_hom_equiv
{ hom_equiv := λ X Y,
  { to_fun := λ f,
    { f := X.a ≫ G.map f,
      h' := by { dsimp, simp [←coalgebra.coassoc_assoc] } },
    inv_fun := λ g, g.f ≫ G.ε.app Y,
    left_inv := λ f,
      by { dsimp, rw [category.assoc, G.ε.naturality, functor.id_map, X.counit_assoc] },
    right_inv := λ g,
    begin
      ext1, dsimp,
      rw [functor.map_comp, g.h_assoc, cofree_obj_a, comonad.right_counit],
      apply comp_id,
    end }}

instance forget_faithful : faithful (forget G) := {}

end comonad

end category_theory


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import tactic.simp_result
import tactic.clear
import control.equiv_functor.instances

/-!
# The `equiv_rw` tactic transports goals or hypotheses along equivalences.

The basic syntax is `equiv_rw e`, where `e : α ≃ β` is an equivalence.
This will try to replace occurrences of `α` in the goal with `β`, for example
transforming
* `⊢ α` to `⊢ β`,
* `⊢ option α` to `⊢ option β`
* `⊢ {a // P}` to `{b // P (⇑(equiv.symm e) b)}`

The tactic can also be used to rewrite hypotheses, using the syntax `equiv_rw e at h`.

## Implementation details

The main internal function is `equiv_rw_type e t`,
which attempts to turn an expression `e : α ≃ β` into a new equivalence with left hand side `t`.
As an example, with `t = option α`, it will generate `functor.map_equiv option e`.

This is achieved by generating a new synthetic goal `%%t ≃ _`,
and calling `solve_by_elim` with an appropriate set of congruence lemmas.
To avoid having to specify the relevant congruence lemmas by hand,
we mostly rely on `equiv_functor.map_equiv` and `bifunctor.map_equiv`
along with some structural congruence lemmas such as
* `equiv.arrow_congr'`,
* `equiv.subtype_equiv_of_subtype'`,
* `equiv.sigma_congr_left'`, and
* `equiv.Pi_congr_left'`.

The main `equiv_rw` function, when operating on the goal, simply generates a new equivalence `e'`
with left hand side matching the target, and calls `apply e'.inv_fun`.

When operating on a hypothesis `x : α`, we introduce a new fact `h : x = e.symm (e x)`, revert this,
and then attempt to `generalize`, replacing all occurrences of `e x` with a new constant `y`, before
`intro`ing and `subst`ing `h`, and renaming `y` back to `x`.

## Future improvements
In a future PR I anticipate that `derive equiv_functor` should work on many examples,
(internally using `transport`, which is in turn based on `equiv_rw`)
and we can incrementally bootstrap the strength of `equiv_rw`.

An ambitious project might be to add `equiv_rw!`,
a tactic which, when failing to find appropriate `equiv_functor` instances,
attempts to `derive` them on the spot.

For now `equiv_rw` is entirely based on `equiv`,
but the framework can readily be generalised to also work with other types of equivalences,
for example specific notations such as ring equivalence (`≃+*`),
or general categorical isomorphisms (`≅`).

This will allow us to transport across more general types of equivalences,
but this will wait for another subsequent PR.
-/

namespace tactic

/-- A list of lemmas used for constructing congruence equivalences. -/

-- Although this looks 'hard-coded', in fact the lemma `equiv_functor.map_equiv`
-- allows us to extend `equiv_rw` simply by constructing new instance so `equiv_functor`.

-- TODO: We should also use `category_theory.functorial` and `category_theory.hygienic` instances.
-- (example goal: we could rewrite along an isomorphism of rings (either as `R ≅ S` or `R ≃+* S`)
-- and turn an `x : mv_polynomial σ R` into an `x : mv_polynomial σ S`.).

meta def equiv_congr_lemmas : list (tactic expr) :=
[ `equiv.of_iff,
  -- TODO decide what to do with this; it's an equiv_bifunctor?
  `equiv.equiv_congr,
  -- The function arrow is technically a bifunctor `Typeᵒᵖ → Type → Type`,
  -- but the pattern matcher will never see this.
  `equiv.arrow_congr',
  -- Allow rewriting in subtypes:
  `equiv.subtype_equiv_of_subtype',
  -- Allow rewriting in the first component of a sigma-type:
  `equiv.sigma_congr_left',
  -- Allow rewriting ∀s:
  -- (You might think that repeated application of `equiv.forall_congr'
  -- would handle the higher arity cases, but unfortunately unification is not clever enough.)
  `equiv.forall₃_congr',
  `equiv.forall₂_congr',
  `equiv.forall_congr',
  -- Allow rewriting in argument of Pi types:
   `equiv.Pi_congr_left',
  -- Handles `sum` and `prod`, and many others:
  `bifunctor.map_equiv,
  -- Handles `list`, `option`, `unique`, and many others:
  `equiv_functor.map_equiv,
  -- We have to filter results to ensure we don't cheat and use exclusively
  -- `equiv.refl` and `iff.refl`!
  `equiv.refl,
  `iff.refl
  ].map (λ n, mk_const n)

declare_trace equiv_rw_type

/--
Configuration structure for `equiv_rw`.

* `max_depth` bounds the search depth for equivalences to rewrite along.
  The default value is 10.
  (e.g., if you're rewriting along `e : α ≃ β`, and `max_depth := 2`,
  you can rewrite `option (option α))` but not `option (option (option α))`.
-/
meta structure equiv_rw_cfg :=
(max_depth : ℕ := 10)

/--
Implementation of `equiv_rw_type`, using `solve_by_elim`.
Expects a goal of the form `t ≃ _`,
and tries to solve it using `eq : α ≃ β` and congruence lemmas.
-/
meta def equiv_rw_type_core (eq : expr) (cfg : equiv_rw_cfg) : tactic unit :=
do
  /-
    We now call `solve_by_elim` to try to generate the requested equivalence.
    There are a few subtleties!
    * We make sure that `eq` is the first lemma, so it is applied whenever possible.
    * In `equiv_congr_lemmas`, we put `equiv.refl` last so it is only used when it is not possible
      to descend further.
    * Since some congruence lemmas generate subgoals with `∀` statements,
      we use the `pre_apply` subtactic of `solve_by_elim` to preprocess each new goal with `intros`.
  -/
  solve_by_elim
  { use_symmetry := false,
    use_exfalso := false,
    lemma_thunks := some (pure eq :: equiv_congr_lemmas),
    ctx_thunk := pure [],
    max_depth := cfg.max_depth,
    -- Subgoals may contain function types,
    -- and we want to continue trying to construct equivalences after the binders.
    pre_apply := tactic.intros >> skip,
    backtrack_all_goals := tt,
    -- If solve_by_elim gets stuck, make sure it isn't because there's a later `≃` or `↔` goal
    -- that we should still attempt.
    discharger :=
      `[success_if_fail { match_target _ ≃ _ }] >> `[success_if_fail { match_target _ ↔ _ }] >>
      (`[show _ ≃ _] <|> `[show _ ↔ _]) <|>
      trace_if_enabled `equiv_rw_type "Failed, no congruence lemma applied!" >> failed,
    -- We use the `accept` tactic in `solve_by_elim` to provide tracing.
    accept := λ goals, lock_tactic_state (do
      when_tracing `equiv_rw_type (do
        goals.mmap pp >>= λ goals, trace format!"So far, we've built: {goals}"),
      done <|>
      when_tracing `equiv_rw_type (do
        gs ← get_goals,
        gs ← gs.mmap (λ g, infer_type g >>= pp),
        trace format!"Attempting to adapt to {gs}")) }

/--
`equiv_rw_type e t` rewrites the type `t` using the equivalence `e : α ≃ β`,
returning a new equivalence `t ≃ t'`.
-/
meta def equiv_rw_type (eqv : expr) (ty : expr) (cfg : equiv_rw_cfg) : tactic expr :=
do
  when_tracing `equiv_rw_type (do
    ty_pp ← pp ty,
    eqv_pp ← pp eqv,
    eqv_ty_pp ← infer_type eqv >>= pp,
    trace format!"Attempting to rewrite the type `{ty_pp}` using `{eqv_pp} : {eqv_ty_pp}`."),
  `(_ ≃ _) ← infer_type eqv | fail format!"{eqv} must be an `equiv`",
  -- We prepare a synthetic goal of type `(%%ty ≃ _)`, for some placeholder right hand side.
  equiv_ty ← to_expr ``(%%ty ≃ _),
  -- Now call `equiv_rw_type_core`.
  new_eqv ← prod.snd <$> (solve_aux equiv_ty $ equiv_rw_type_core eqv cfg),
  -- Check that we actually used the equivalence `eq`
  -- (`equiv_rw_type_core` will always find `equiv.refl`,
  -- but hopefully only after all other possibilities)
  new_eqv ← instantiate_mvars new_eqv,
  -- We previously had `guard (eqv.occurs new_eqv)` here, but `kdepends_on` is more reliable.
  kdepends_on new_eqv eqv >>= guardb <|> (do
    eqv_pp ← pp eqv,
    ty_pp ← pp ty,
    fail format!"Could not construct an equivalence from {eqv_pp} of the form: {ty_pp} ≃ _"),
  -- Finally we simplify the resulting equivalence,
  -- to compress away some `map_equiv equiv.refl` subexpressions.
  prod.fst <$> new_eqv.simp {fail_if_unchanged := ff}

mk_simp_attribute equiv_rw_simp "The simpset `equiv_rw_simp` is used by the tactic `equiv_rw` to
simplify applications of equivalences and their inverses."

attribute [equiv_rw_simp] equiv.symm_symm equiv.apply_symm_apply equiv.symm_apply_apply

/--
Attempt to replace the hypothesis with name `x`
by transporting it along the equivalence in `e : α ≃ β`.
-/
meta def equiv_rw_hyp (x : name) (e : expr) (cfg : equiv_rw_cfg := {}) : tactic unit :=
-- We call `dsimp_result` to perform the beta redex introduced by `revert`
dsimp_result (do
  x' ← get_local x,
  x_ty ← infer_type x',
  -- Adapt `e` to an equivalence with left-hand-side `x_ty`.
  e ← equiv_rw_type e x_ty cfg,
  eq ← to_expr ``(%%x' = equiv.symm %%e (equiv.to_fun %%e %%x')),
  prf ← to_expr ``((equiv.symm_apply_apply %%e %%x').symm),
  h ← note_anon eq prf,
  -- Revert the new hypothesis, so it is also part of the goal.
  revert h,
  ex ← to_expr ``(equiv.to_fun %%e %%x'),
  -- Now call `generalize`,
  -- attempting to replace all occurrences of `e x`,
  -- calling it for now `j : β`, with `k : x = e.symm j`.
  generalize ex (by apply_opt_param) transparency.none,
  -- Reintroduce `x` (now of type `b`), and the hypothesis `h`.
  intro x,
  h ← intro1,
  -- Finally, if we're working on properties, substitute along `h`, then do some cleanup,
  -- and if we're working on data, just throw out the old `x`.
  b ← target >>= is_prop,
  if b then do
    subst h,
    `[try { simp only with equiv_rw_simp }]
  else
    -- We may need to unfreeze `x` before we can `clear` it.
    unfreezing_hyp x' (clear' tt [x']) <|> fail
      format!"equiv_rw expected to be able to clear the original hypothesis {x}, but couldn't.",
  skip)
  {fail_if_unchanged := ff} tt -- call `dsimp_result` with `no_defaults := tt`.

/-- Rewrite the goal using an equiv `e`. -/
meta def equiv_rw_target (e : expr) (cfg : equiv_rw_cfg := {}) : tactic unit :=
do
  t ← target,
  e ← equiv_rw_type e t cfg,
  s ← to_expr ``(equiv.inv_fun %%e),
  tactic.eapply s,
  skip

end tactic

namespace tactic.interactive
open lean.parser
open interactive interactive.types
open tactic

local postfix `?`:9001 := optional

/--
`equiv_rw e at h`, where `h : α` is a hypothesis, and `e : α ≃ β`,
will attempt to transport `h` along `e`, producing a new hypothesis `h : β`,
with all occurrences of `h` in other hypotheses and the goal replaced with `e.symm h`.

`equiv_rw e` will attempt to transport the goal along an equivalence `e : α ≃ β`.
In its minimal form it replaces the goal `⊢ α` with `⊢ β` by calling `apply e.inv_fun`.

`equiv_rw` will also try rewriting under (equiv_)functors, so can turn
a hypothesis `h : list α` into `h : list β` or
a goal `⊢ unique α` into `⊢ unique β`.

The maximum search depth for rewriting in subexpressions is controlled by
`equiv_rw e {max_depth := n}`.
-/
meta def equiv_rw (e : parse texpr) (loc : parse $ (tk "at" *> ident)?) (cfg : equiv_rw_cfg := {}) :
  itactic :=
do e ← to_expr e,
   match loc with
   | (some hyp) := equiv_rw_hyp hyp e cfg
   | none := equiv_rw_target e cfg
   end

add_tactic_doc
{ name        := "equiv_rw",
  category    := doc_category.tactic,
  decl_names  := [`tactic.interactive.equiv_rw],
  tags        := ["rewriting", "equiv", "transport"] }

/--
Solve a goal of the form `t ≃ _`,
by constructing an equivalence from `e : α ≃ β`.
This is the same equivalence that `equiv_rw` would use to rewrite a term of type `t`.

A typical usage might be:
```
have e' : option α ≃ option β := by equiv_rw_type e
```
-/
meta def equiv_rw_type (e : parse texpr) (cfg : equiv_rw_cfg := {}) : itactic :=
do
 `(%%t ≃ _) ← target | fail "`equiv_rw_type` solves goals of the form `t ≃ _`.",
 e ← to_expr e,
 tactic.equiv_rw_type e t cfg >>= tactic.exact

add_tactic_doc
{ name        := "equiv_rw_type",
  category    := doc_category.tactic,
  decl_names  := [`tactic.interactive.equiv_rw_type],
  tags        := ["rewriting", "equiv", "transport"] }

end tactic.interactive


/-
Copyright (c) 2021 Adam Topaz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adam Topaz
-/
import category_theory.limits.shapes.products
import category_theory.limits.shapes.equalizers
import category_theory.limits.cone_category
import category_theory.adjunction

/-!

# Multi-(co)equalizers

A *multiequalizer* is an equalizer of two morphisms between two products.
Since both products and equalizers are limits, such an object is again a limit.
This file provides the diagram whose limit is indeed such an object.
In fact, it is well-known that any limit can be obtained as a multiequalizer.
The dual construction (multicoequalizers) is also provided.

## Projects

Prove that a multiequalizer can be identified with
an equalizer between products (and analogously for multicoequalizers).

Prove that the limit of any diagram is a multiequalizer (and similarly for colimits).

-/

namespace category_theory.limits

open category_theory

universes w v u

/-- The type underlying the multiequalizer diagram. -/
@[nolint unused_arguments]
inductive walking_multicospan {L R : Type w} (fst snd : R → L) : Type w
| left : L → walking_multicospan
| right : R → walking_multicospan

/-- The type underlying the multiecoqualizer diagram. -/
@[nolint unused_arguments]
inductive walking_multispan {L R : Type w} (fst snd : L → R) : Type w
| left : L → walking_multispan
| right : R → walking_multispan

namespace walking_multicospan

variables {L R : Type w} {fst snd : R → L}

instance [inhabited L] : inhabited (walking_multicospan fst snd) :=
⟨left default⟩

/-- Morphisms for `walking_multicospan`. -/
inductive hom : Π (a b : walking_multicospan fst snd), Type w
| id (A)  : hom A A
| fst (b) : hom (left (fst b)) (right b)
| snd (b) : hom (left (snd b)) (right b)

instance {a : walking_multicospan fst snd} : inhabited (hom a a) :=
⟨hom.id _⟩

/-- Composition of morphisms for `walking_multicospan`. -/
def hom.comp : Π {A B C : walking_multicospan fst snd} (f : hom A B) (g : hom B C),
  hom A C
| _ _ _ (hom.id X) f := f
| _ _ _ (hom.fst b) (hom.id X) := hom.fst b
| _ _ _ (hom.snd b) (hom.id X) := hom.snd b

instance : small_category (walking_multicospan fst snd) :=
{ hom := hom,
  id := hom.id,
  comp := λ X Y Z, hom.comp,
  id_comp' := by { rintro (_|_) (_|_) (_|_|_), tidy },
  comp_id' := by { rintro (_|_) (_|_) (_|_|_), tidy },
  assoc' := by { rintro (_|_) (_|_) (_|_) (_|_) (_|_|_) (_|_|_) (_|_|_), tidy } }

end walking_multicospan

namespace walking_multispan

variables {L R : Type v} {fst snd : L → R}

instance [inhabited L] : inhabited (walking_multispan fst snd) :=
⟨left default⟩

/-- Morphisms for `walking_multispan`. -/
inductive hom : Π (a b : walking_multispan fst snd), Type v
| id (A)  : hom A A
| fst (a) : hom (left a) (right (fst a))
| snd (a) : hom (left a) (right (snd a))

instance {a : walking_multispan fst snd} : inhabited (hom a a) :=
⟨hom.id _⟩

/-- Composition of morphisms for `walking_multispan`. -/
def hom.comp : Π {A B C : walking_multispan fst snd} (f : hom A B) (g : hom B C),
  hom A C
| _ _ _ (hom.id X) f := f
| _ _ _ (hom.fst a) (hom.id X) := hom.fst a
| _ _ _ (hom.snd a) (hom.id X) := hom.snd a

instance : small_category (walking_multispan fst snd) :=
{ hom := hom,
  id := hom.id,
  comp := λ X Y Z, hom.comp,
  id_comp' := by { rintro (_|_) (_|_) (_|_|_), tidy },
  comp_id' := by { rintro (_|_) (_|_) (_|_|_), tidy },
  assoc' := by { rintro (_|_) (_|_) (_|_) (_|_) (_|_|_) (_|_|_) (_|_|_), tidy } }

end walking_multispan

/-- This is a structure encapsulating the data necessary to define a `multicospan`. -/
@[nolint has_inhabited_instance]
structure multicospan_index (C : Type u) [category.{v} C] :=
(L R : Type w)
(fst_to snd_to : R → L)
(left : L → C)
(right : R → C)
(fst : Π b, left (fst_to b) ⟶ right b)
(snd : Π b, left (snd_to b) ⟶ right b)

/-- This is a structure encapsulating the data necessary to define a `multispan`. -/
@[nolint has_inhabited_instance]
structure multispan_index (C : Type u) [category.{v} C] :=
(L R : Type w)
(fst_from snd_from : L → R)
(left : L → C)
(right : R → C)
(fst : Π a, left a ⟶ right (fst_from a))
(snd : Π a, left a ⟶ right (snd_from a))

namespace multicospan_index

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

/-- The multicospan associated to `I : multicospan_index`. -/
def multicospan : walking_multicospan I.fst_to I.snd_to ⥤ C :=
{ obj := λ x,
  match x with
  | walking_multicospan.left a := I.left a
  | walking_multicospan.right b := I.right b
  end,
  map := λ x y f,
  match x, y, f with
  | _, _, walking_multicospan.hom.id x := 𝟙 _
  | _, _, walking_multicospan.hom.fst b := I.fst _
  | _, _, walking_multicospan.hom.snd b := I.snd _
  end,
  map_id' := by { rintros (_|_), tidy },
  map_comp' := by { rintros (_|_) (_|_) (_|_) (_|_|_) (_|_|_), tidy } }

@[simp] lemma multicospan_obj_left (a) :
  I.multicospan.obj (walking_multicospan.left a) = I.left a := rfl

@[simp] lemma multicospan_obj_right (b) :
  I.multicospan.obj (walking_multicospan.right b) = I.right b := rfl

@[simp] lemma multicospan_map_fst (b) :
  I.multicospan.map (walking_multicospan.hom.fst b) = I.fst b := rfl

@[simp] lemma multicospan_map_snd (b) :
  I.multicospan.map (walking_multicospan.hom.snd b) = I.snd b := rfl

variables [has_product I.left] [has_product I.right]

/-- The induced map `∏ I.left ⟶ ∏ I.right` via `I.fst`. -/
noncomputable
def fst_pi_map : ∏ I.left ⟶ ∏ I.right := pi.lift (λ b, pi.π I.left (I.fst_to b) ≫ I.fst b)

/-- The induced map `∏ I.left ⟶ ∏ I.right` via `I.snd`. -/
noncomputable
def snd_pi_map : ∏ I.left ⟶ ∏ I.right := pi.lift (λ b, pi.π I.left (I.snd_to b) ≫ I.snd b)

@[simp, reassoc]
lemma fst_pi_map_π (b) : I.fst_pi_map ≫ pi.π I.right b = pi.π I.left _ ≫ I.fst b :=
by simp [fst_pi_map]

@[simp, reassoc]
lemma snd_pi_map_π (b) : I.snd_pi_map ≫ pi.π I.right b = pi.π I.left _ ≫ I.snd b :=
by simp [snd_pi_map]

/--
Taking the multiequalizer over the multicospan index is equivalent to taking the equalizer over
the two morphsims `∏ I.left ⇉ ∏ I.right`. This is the diagram of the latter.
-/
@[simps] protected noncomputable
def parallel_pair_diagram := parallel_pair I.fst_pi_map I.snd_pi_map

end multicospan_index

namespace multispan_index

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

/-- The multispan associated to `I : multispan_index`. -/
def multispan : walking_multispan I.fst_from I.snd_from ⥤ C :=
{ obj := λ x,
  match x with
  | walking_multispan.left a := I.left a
  | walking_multispan.right b := I.right b
  end,
  map := λ x y f,
  match x, y, f with
  | _, _, walking_multispan.hom.id x := 𝟙 _
  | _, _, walking_multispan.hom.fst b := I.fst _
  | _, _, walking_multispan.hom.snd b := I.snd _
  end,
  map_id' := by { rintros (_|_), tidy },
  map_comp' := by { rintros (_|_) (_|_) (_|_) (_|_|_) (_|_|_), tidy } }

@[simp] lemma multispan_obj_left (a) :
  I.multispan.obj (walking_multispan.left a) = I.left a := rfl

@[simp] lemma multispan_obj_right (b) :
  I.multispan.obj (walking_multispan.right b) = I.right b := rfl

@[simp] lemma multispan_map_fst (a) :
  I.multispan.map (walking_multispan.hom.fst a) = I.fst a := rfl

@[simp] lemma multispan_map_snd (a) :
  I.multispan.map (walking_multispan.hom.snd a) = I.snd a := rfl

variables [has_coproduct I.left] [has_coproduct I.right]

/-- The induced map `∐ I.left ⟶ ∐ I.right` via `I.fst`. -/
noncomputable
def fst_sigma_map : ∐ I.left ⟶ ∐ I.right := sigma.desc (λ b, I.fst b ≫ sigma.ι _ (I.fst_from b))

/-- The induced map `∐ I.left ⟶ ∐ I.right` via `I.snd`. -/
noncomputable
def snd_sigma_map : ∐ I.left ⟶ ∐ I.right := sigma.desc (λ b, I.snd b ≫ sigma.ι _ (I.snd_from b))

@[simp, reassoc]
lemma ι_fst_sigma_map (b) : sigma.ι I.left b ≫ I.fst_sigma_map = I.fst b ≫ sigma.ι I.right _ :=
by simp [fst_sigma_map]

@[simp, reassoc]
lemma ι_snd_sigma_map (b) : sigma.ι I.left b ≫ I.snd_sigma_map = I.snd b ≫ sigma.ι I.right _ :=
by simp [snd_sigma_map]

/--
Taking the multicoequalizer over the multispan index is equivalent to taking the coequalizer over
the two morphsims `∐ I.left ⇉ ∐ I.right`. This is the diagram of the latter.
-/
protected noncomputable
abbreviation parallel_pair_diagram := parallel_pair I.fst_sigma_map I.snd_sigma_map

end multispan_index

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

/-- A multifork is a cone over a multicospan. -/
@[nolint has_inhabited_instance]
abbreviation multifork (I : multicospan_index C) := cone I.multicospan

/-- A multicofork is a cocone over a multispan. -/
@[nolint has_inhabited_instance]
abbreviation multicofork (I : multispan_index C) := cocone I.multispan

namespace multifork

variables {I : multicospan_index C} (K : multifork I)

/-- The maps from the cone point of a multifork to the objects on the left. -/
def ι (a : I.L) : K.X ⟶ I.left a := K.π.app (walking_multicospan.left _)

@[simp] lemma app_left_eq_ι (a) : K.π.app (walking_multicospan.left a) = K.ι a := rfl

@[simp] lemma app_right_eq_ι_comp_fst (b) :
  K.π.app (walking_multicospan.right b) = K.ι (I.fst_to b) ≫ I.fst b :=
by { rw ← K.w (walking_multicospan.hom.fst b), refl }

@[reassoc] lemma app_right_eq_ι_comp_snd (b) :
  K.π.app (walking_multicospan.right b) =  K.ι (I.snd_to b) ≫ I.snd b :=
by { rw ← K.w (walking_multicospan.hom.snd b), refl }

@[simp, reassoc] lemma hom_comp_ι (K₁ K₂ : multifork I) (f : K₁ ⟶ K₂) (j : I.L) :
  f.hom ≫ K₂.ι j = K₁.ι j := f.w (walking_multicospan.left j)

/-- Construct a multifork using a collection `ι` of morphisms. -/
@[simps]
def of_ι (I : multicospan_index C) (P : C) (ι : Π a, P ⟶ I.left a)
  (w : ∀ b, ι (I.fst_to b) ≫ I.fst b = ι (I.snd_to b) ≫ I.snd b) :
  multifork I :=
{ X := P,
  π :=
  { app := λ x,
    match x with
    | walking_multicospan.left a := ι _
    | walking_multicospan.right b := ι (I.fst_to b) ≫ I.fst b
    end,
    naturality' := begin
      rintros (_|_) (_|_) (_|_|_),
      any_goals { symmetry, dsimp, rw category.id_comp, apply category.comp_id },
      { dsimp, rw category.id_comp, refl },
      { dsimp, rw category.id_comp, apply w }
    end } }

@[simp, reassoc]
lemma condition (b) :
  K.ι (I.fst_to b) ≫ I.fst b = K.ι (I.snd_to b) ≫ I.snd b :=
by rw [←app_right_eq_ι_comp_fst, ←app_right_eq_ι_comp_snd]

/-- This definition provides a convenient way to show that a multifork is a limit. -/
@[simps]
def is_limit.mk
  (lift : Π (E : multifork I), E.X ⟶ K.X)
  (fac : ∀ (E : multifork I) (i : I.L), lift E ≫ K.ι i = E.ι i)
  (uniq : ∀ (E : multifork I) (m : E.X ⟶ K.X),
    (∀ i : I.L, m ≫ K.ι i = E.ι i) → m = lift E) : is_limit K :=
{ lift := lift,
  fac' := begin
    rintros E (a|b),
    { apply fac },
    { rw [← E.w (walking_multicospan.hom.fst b), ← K.w (walking_multicospan.hom.fst b),
        ← category.assoc],
      congr' 1,
      apply fac }
  end,
  uniq' := begin
    rintros E m hm,
    apply uniq,
    intros i,
    apply hm,
  end }

variables [has_product I.left] [has_product I.right]

@[simp, reassoc]
lemma pi_condition : pi.lift K.ι ≫ I.fst_pi_map = pi.lift K.ι ≫ I.snd_pi_map :=
by { ext, discrete_cases, simp, }

/-- Given a multifork, we may obtain a fork over `∏ I.left ⇉ ∏ I.right`. -/
@[simps X] noncomputable
def to_pi_fork (K : multifork I) : fork I.fst_pi_map I.snd_pi_map :=
{ X := K.X,
  π :=
  { app := λ x,
    match x with
    | walking_parallel_pair.zero := pi.lift K.ι
    | walking_parallel_pair.one := pi.lift K.ι ≫ I.fst_pi_map
    end,
    naturality' :=
    begin
      rintros (_|_) (_|_) (_|_|_),
      any_goals { symmetry, dsimp, rw category.id_comp, apply category.comp_id },
      all_goals { change 𝟙 _ ≫ _ ≫ _ = pi.lift _ ≫ _, simp }
    end } }

@[simp] lemma to_pi_fork_π_app_zero : K.to_pi_fork.ι = pi.lift K.ι := rfl

@[simp] lemma to_pi_fork_π_app_one :
  K.to_pi_fork.π.app walking_parallel_pair.one = pi.lift K.ι ≫ I.fst_pi_map := rfl

variable (I)

/-- Given a fork over `∏ I.left ⇉ ∏ I.right`, we may obtain a multifork. -/
@[simps X] noncomputable
def of_pi_fork (c : fork I.fst_pi_map I.snd_pi_map) : multifork I :=
{ X := c.X,
  π :=
  { app := λ x,
    match x with
    | walking_multicospan.left a := c.ι ≫ pi.π _ _
    | walking_multicospan.right b := c.ι ≫ I.fst_pi_map ≫ pi.π _ _
    end,
    naturality' :=
    begin
      rintros (_|_) (_|_) (_|_|_),
      any_goals { symmetry, dsimp, rw category.id_comp, apply category.comp_id },
      { change 𝟙 _ ≫ _ ≫ _ = (_ ≫ _) ≫ _, simp },
      { change 𝟙 _ ≫ _ ≫ _ = (_ ≫ _) ≫ _, rw c.condition_assoc, simp }
    end } }

@[simp] lemma of_pi_fork_π_app_left (c : fork I.fst_pi_map I.snd_pi_map) (a) :
  (of_pi_fork I c).ι a = c.ι ≫ pi.π _ _ := rfl

@[simp] lemma of_pi_fork_π_app_right (c : fork I.fst_pi_map I.snd_pi_map) (a) :
  (of_pi_fork I c).π.app (walking_multicospan.right a) = c.ι ≫ I.fst_pi_map ≫ pi.π _ _ := rfl

end multifork

namespace multicospan_index

variables (I : multicospan_index C) [has_product I.left] [has_product I.right]

local attribute [tidy] tactic.case_bash

/-- `multifork.to_pi_fork` is functorial. -/
@[simps] noncomputable
def to_pi_fork_functor : multifork I ⥤ fork I.fst_pi_map I.snd_pi_map :=
{ obj := multifork.to_pi_fork,
  map := λ K₁ K₂ f,
  { hom := f.hom,
    w' := begin
      rintro (_|_),
      { ext, dsimp, simp },
      { ext,
        simp only [multifork.to_pi_fork_π_app_one, multifork.pi_condition, category.assoc],
        dsimp [snd_pi_map],
        simp },
    end } }

/-- `multifork.of_pi_fork` is functorial. -/
@[simps] noncomputable
def of_pi_fork_functor : fork I.fst_pi_map I.snd_pi_map ⥤ multifork I :=
{ obj := multifork.of_pi_fork I, map := λ K₁ K₂ f, { hom := f.hom, w' := by rintros (_|_); simp } }

/--
The category of multiforks is equivalent to the category of forks over `∏ I.left ⇉ ∏ I.right`.
It then follows from `category_theory.is_limit_of_preserves_cone_terminal` (or `reflects`) that it
preserves and reflects limit cones.
-/
@[simps] noncomputable
def multifork_equiv_pi_fork : multifork I ≌ fork I.fst_pi_map I.snd_pi_map :=
{ functor := to_pi_fork_functor I,
  inverse := of_pi_fork_functor I,
  unit_iso := nat_iso.of_components (λ K, cones.ext (iso.refl _)
    (by { rintros (_|_); dsimp; simp[←fork.app_one_eq_ι_comp_left, -fork.app_one_eq_ι_comp_left] }))
    (λ K₁ K₂ f, by { ext, simp }),
  counit_iso := nat_iso.of_components (λ K, fork.ext (iso.refl _) (by { ext ⟨j⟩, dsimp, simp }))
    (λ K₁ K₂ f, by { ext, simp }) }

end multicospan_index

namespace multicofork

variables {I : multispan_index C} (K : multicofork I)

/-- The maps to the cocone point of a multicofork from the objects on the right. -/
def π (b : I.R) : I.right b ⟶ K.X :=
K.ι.app (walking_multispan.right _)

@[simp] lemma π_eq_app_right (b) : K.ι.app (walking_multispan.right _) = K.π b := rfl

@[simp] lemma fst_app_right (a) :
  K.ι.app (walking_multispan.left a) = I.fst a ≫ K.π _ :=
by { rw ← K.w (walking_multispan.hom.fst a), refl }

@[reassoc] lemma snd_app_right (a) :
  K.ι.app (walking_multispan.left a) = I.snd a ≫ K.π _ :=
by { rw ← K.w (walking_multispan.hom.snd a), refl }

/-- Construct a multicofork using a collection `π` of morphisms. -/
@[simps]
def of_π (I : multispan_index C) (P : C) (π : Π b, I.right b ⟶ P)
  (w : ∀ a, I.fst a ≫ π (I.fst_from a) = I.snd a ≫ π (I.snd_from a)) :
  multicofork I :=
{ X := P,
  ι :=
  { app := λ x,
    match x with
    | walking_multispan.left a := I.fst a ≫ π _
    | walking_multispan.right b := π _
    end,
    naturality' := begin
      rintros (_|_) (_|_) (_|_|_),
      any_goals { dsimp, rw category.comp_id, apply category.id_comp },
      { dsimp, rw category.comp_id, refl },
      { dsimp, rw category.comp_id, apply (w _).symm }
    end } }

@[simp, reassoc]
lemma condition (a) : I.fst a ≫ K.π (I.fst_from a) = I.snd a ≫ K.π (I.snd_from a) :=
by rw [←K.snd_app_right, ←K.fst_app_right]

/-- This definition provides a convenient way to show that a multicofork is a colimit. -/
@[simps]
def is_colimit.mk
  (desc : Π (E : multicofork I), K.X ⟶ E.X)
  (fac : ∀ (E : multicofork I) (i : I.R), K.π i ≫ desc E = E.π i)
  (uniq : ∀ (E : multicofork I) (m : K.X ⟶ E.X),
    (∀ i : I.R, K.π i ≫ m = E.π i) → m = desc E) : is_colimit K :=
{ desc := desc,
  fac' := begin
    rintros S (a|b),
    { rw [← K.w (walking_multispan.hom.fst a), ← S.w (walking_multispan.hom.fst a),
        category.assoc],
      congr' 1,
      apply fac },
    { apply fac },
  end,
  uniq' := begin
    intros S m hm,
    apply uniq,
    intros i,
    apply hm
  end }

variables [has_coproduct I.left] [has_coproduct I.right]

@[simp, reassoc]
lemma sigma_condition :
  I.fst_sigma_map ≫ sigma.desc K.π = I.snd_sigma_map ≫ sigma.desc K.π :=
by { ext, discrete_cases, simp, }

/-- Given a multicofork, we may obtain a cofork over `∐ I.left ⇉ ∐ I.right`. -/
@[simps X] noncomputable
def to_sigma_cofork (K : multicofork I) : cofork I.fst_sigma_map I.snd_sigma_map :=
{ X := K.X,
  ι :=
  { app := λ x,
    match x with
    | walking_parallel_pair.zero := I.fst_sigma_map ≫ sigma.desc K.π
    | walking_parallel_pair.one := sigma.desc K.π
    end,
    naturality' :=
    begin
      rintros (_|_) (_|_) (_|_|_),
      any_goals { dsimp, rw category.comp_id, apply category.id_comp },
      all_goals { change _ ≫ sigma.desc _ = (_ ≫ _) ≫ 𝟙 _, simp }
    end } }

@[simp] lemma to_sigma_cofork_π : K.to_sigma_cofork.π = sigma.desc K.π := rfl

variable (I)

/-- Given a cofork over `∐ I.left ⇉ ∐ I.right`, we may obtain a multicofork. -/
@[simps X] noncomputable
def of_sigma_cofork (c : cofork I.fst_sigma_map I.snd_sigma_map) : multicofork I :=
{ X := c.X,
  ι :=
  { app := λ x,
    match x with
    | walking_multispan.left a := (sigma.ι I.left a : _) ≫ I.fst_sigma_map ≫ c.π
    | walking_multispan.right b := (sigma.ι I.right b : _) ≫ c.π
    end,
    naturality' :=
    begin
      rintros (_|_) (_|_) (_|_|_),
      any_goals { dsimp, rw category.comp_id, apply category.id_comp },
      { change _ ≫ _ ≫ _ = (_ ≫ _) ≫ _, dsimp,
        simp only [cofork.condition, category.comp_id],
        rw [←I.ι_fst_sigma_map_assoc, c.condition] },
      { change _ ≫ _ ≫ _ = (_ ≫ _) ≫ 𝟙 _,
        rw c.condition, simp }
    end } }

@[simp] lemma of_sigma_cofork_ι_app_left (c : cofork I.fst_sigma_map I.snd_sigma_map) (a) :
  (of_sigma_cofork I c).ι.app (walking_multispan.left a) =
    (sigma.ι I.left a : _) ≫ I.fst_sigma_map ≫ c.π := rfl

@[simp] lemma of_sigma_cofork_ι_app_right (c : cofork I.fst_sigma_map I.snd_sigma_map) (b) :
  (of_sigma_cofork I c).ι.app (walking_multispan.right b) = (sigma.ι I.right b : _) ≫ c.π := rfl

end multicofork

namespace multispan_index

variables (I : multispan_index C) [has_coproduct I.left] [has_coproduct I.right]

local attribute [tidy] tactic.case_bash

/-- `multicofork.to_sigma_cofork` is functorial. -/
@[simps] noncomputable
def to_sigma_cofork_functor : multicofork I ⥤ cofork I.fst_sigma_map I.snd_sigma_map :=
{ obj := multicofork.to_sigma_cofork, map := λ K₁ K₂ f, { hom := f.hom } }

/-- `multicofork.of_sigma_cofork` is functorial. -/
@[simps] noncomputable
def of_sigma_cofork_functor : cofork I.fst_sigma_map I.snd_sigma_map ⥤ multicofork I :=
{ obj := multicofork.of_sigma_cofork I,
  map := λ K₁ K₂ f, { hom := f.hom, w' := by rintros (_|_); simp } }

/--
The category of multicoforks is equivalent to the category of coforks over `∐ I.left ⇉ ∐ I.right`.
It then follows from `category_theory.is_colimit_of_preserves_cocone_initial` (or `reflects`) that
it preserves and reflects colimit cocones.
-/
@[simps] noncomputable
def multicofork_equiv_sigma_cofork : multicofork I ≌ cofork I.fst_sigma_map I.snd_sigma_map :=
{ functor := to_sigma_cofork_functor I,
  inverse := of_sigma_cofork_functor I,
  unit_iso := nat_iso.of_components (λ K, cocones.ext (iso.refl _)
      (by { rintros (_|_); dsimp; simp }))
    (λ K₁ K₂ f, by { ext, simp }),
  counit_iso := nat_iso.of_components (λ K, cofork.ext (iso.refl _)
      (by { ext ⟨j⟩, dsimp, simp only [category.comp_id, colimit.ι_desc, cofan.mk_ι_app], refl }))
    (λ K₁ K₂ f, by { ext, dsimp, simp, }) }

end multispan_index

/-- For `I : multicospan_index C`, we say that it has a multiequalizer if the associated
  multicospan has a limit. -/
abbreviation has_multiequalizer (I : multicospan_index C) :=
  has_limit I.multicospan

noncomputable theory

/-- The multiequalizer of `I : multicospan_index C`. -/
abbreviation multiequalizer (I : multicospan_index C) [has_multiequalizer I] : C :=
  limit I.multicospan

/-- For `I : multispan_index C`, we say that it has a multicoequalizer if
  the associated multicospan has a limit. -/
abbreviation has_multicoequalizer (I : multispan_index C) :=
  has_colimit I.multispan

/-- The multiecoqualizer of `I : multispan_index C`. -/
abbreviation multicoequalizer (I : multispan_index C) [has_multicoequalizer I] : C :=
  colimit I.multispan

namespace multiequalizer

variables (I : multicospan_index C) [has_multiequalizer I]

/-- The canonical map from the multiequalizer to the objects on the left. -/
abbreviation ι (a : I.L) : multiequalizer I ⟶ I.left a :=
limit.π _ (walking_multicospan.left a)

/-- The multifork associated to the multiequalizer. -/
abbreviation multifork : multifork I :=
limit.cone _

@[simp]
lemma multifork_ι (a) :
  (multiequalizer.multifork I).ι a = multiequalizer.ι I a := rfl

@[simp]
lemma multifork_π_app_left (a) :
  (multiequalizer.multifork I).π.app (walking_multicospan.left a) =
  multiequalizer.ι I a := rfl

@[reassoc]
lemma condition (b) :
  multiequalizer.ι I (I.fst_to b) ≫ I.fst b =
  multiequalizer.ι I (I.snd_to b) ≫ I.snd b :=
multifork.condition _ _

/-- Construct a morphism to the multiequalizer from its universal property. -/
abbreviation lift (W : C) (k : Π a, W ⟶ I.left a)
  (h : ∀ b, k (I.fst_to b) ≫ I.fst b = k (I.snd_to b) ≫ I.snd b) :
  W ⟶ multiequalizer I :=
limit.lift _ (multifork.of_ι I _ k h)

@[simp, reassoc]
lemma lift_ι (W : C) (k : Π a, W ⟶ I.left a)
  (h : ∀ b, k (I.fst_to b) ≫ I.fst b = k (I.snd_to b) ≫ I.snd b) (a) :
  multiequalizer.lift I _ k h ≫ multiequalizer.ι I a = k _ :=
limit.lift_π _ _

@[ext]
lemma hom_ext {W : C} (i j : W ⟶ multiequalizer I)
  (h : ∀ a, i ≫ multiequalizer.ι I a =
  j ≫ multiequalizer.ι I a) :
  i = j :=
limit.hom_ext
begin
  rintro (a|b),
  { apply h },
  simp_rw [← limit.w I.multicospan (walking_multicospan.hom.fst b),
    ← category.assoc, h],
end

variables [has_product I.left] [has_product I.right]

instance : has_equalizer I.fst_pi_map I.snd_pi_map :=
⟨⟨⟨_,is_limit.of_preserves_cone_terminal
  I.multifork_equiv_pi_fork.functor (limit.is_limit _)⟩⟩⟩

/-- The multiequalizer is isomorphic to the equalizer of `∏ I.left ⇉ ∏ I.right`. -/
def iso_equalizer : multiequalizer I ≅ equalizer I.fst_pi_map I.snd_pi_map :=
limit.iso_limit_cone ⟨_, is_limit.of_preserves_cone_terminal
  I.multifork_equiv_pi_fork.inverse (limit.is_limit _)⟩

/-- The canonical injection `multiequalizer I ⟶ ∏ I.left`. -/
def ι_pi : multiequalizer I ⟶ ∏ I.left :=
  (iso_equalizer I).hom ≫ equalizer.ι I.fst_pi_map I.snd_pi_map

@[simp, reassoc]
lemma ι_pi_π (a) : ι_pi I ≫ pi.π I.left a = ι I a :=
by { rw [ι_pi, category.assoc, ← iso.eq_inv_comp, iso_equalizer], simpa }

instance : mono (ι_pi I) := @@mono_comp _ _ _ _ equalizer.ι_mono

end multiequalizer

namespace multicoequalizer

variables (I : multispan_index C) [has_multicoequalizer I]

/-- The canonical map from the multiequalizer to the objects on the left. -/
abbreviation π (b : I.R) : I.right b ⟶ multicoequalizer I :=
colimit.ι I.multispan (walking_multispan.right _)

/-- The multicofork associated to the multicoequalizer. -/
abbreviation multicofork : multicofork I :=
colimit.cocone _

@[simp]
lemma multicofork_π (b) :
  (multicoequalizer.multicofork I).π b = multicoequalizer.π I b := rfl

@[simp]
lemma multicofork_ι_app_right (b) :
  (multicoequalizer.multicofork I).ι.app (walking_multispan.right b) =
  multicoequalizer.π I b := rfl

@[reassoc]
lemma condition (a) :
  I.fst a ≫ multicoequalizer.π I (I.fst_from a) =
  I.snd a ≫ multicoequalizer.π I (I.snd_from a) :=
multicofork.condition _ _

/-- Construct a morphism from the multicoequalizer from its universal property. -/
abbreviation desc (W : C) (k : Π b, I.right b ⟶ W)
  (h : ∀ a, I.fst a ≫  k (I.fst_from a) = I.snd a ≫ k (I.snd_from a)) :
  multicoequalizer I ⟶ W :=
colimit.desc _ (multicofork.of_π I _ k h)

@[simp, reassoc]
lemma π_desc (W : C) (k : Π b, I.right b ⟶ W)
  (h : ∀ a, I.fst a ≫  k (I.fst_from a) = I.snd a ≫ k (I.snd_from a)) (b) :
  multicoequalizer.π I b ≫ multicoequalizer.desc I _ k h = k _ :=
colimit.ι_desc _ _

@[ext]
lemma hom_ext {W : C} (i j : multicoequalizer I ⟶ W)
  (h : ∀ b, multicoequalizer.π I b ≫ i = multicoequalizer.π I b ≫ j) :
  i = j :=
colimit.hom_ext
begin
  rintro (a|b),
  { simp_rw [← colimit.w I.multispan (walking_multispan.hom.fst a),
    category.assoc, h] },
  { apply h },
end

variables [has_coproduct I.left] [has_coproduct I.right]

instance : has_coequalizer I.fst_sigma_map I.snd_sigma_map :=
⟨⟨⟨_,is_colimit.of_preserves_cocone_initial
  I.multicofork_equiv_sigma_cofork.functor (colimit.is_colimit _)⟩⟩⟩

/-- The multicoequalizer is isomorphic to the coequalizer of `∐ I.left ⇉ ∐ I.right`. -/
def iso_coequalizer : multicoequalizer I ≅ coequalizer I.fst_sigma_map I.snd_sigma_map :=
colimit.iso_colimit_cocone ⟨_, is_colimit.of_preserves_cocone_initial
  I.multicofork_equiv_sigma_cofork.inverse (colimit.is_colimit _)⟩

/-- The canonical projection `∐ I.right ⟶ multicoequalizer I`. -/
def sigma_π : ∐ I.right ⟶ multicoequalizer I :=
  coequalizer.π I.fst_sigma_map I.snd_sigma_map ≫ (iso_coequalizer I).inv

@[simp, reassoc]
lemma ι_sigma_π (b) : sigma.ι I.right b ≫ sigma_π I = π I b :=
by { rw [sigma_π, ← category.assoc, iso.comp_inv_eq, iso_coequalizer], simpa }

instance : epi (sigma_π I) := @@epi_comp _ _ coequalizer.π_epi _ _

end multicoequalizer

end category_theory.limits