/-
Copyright (c) 2016 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.

Authors: Floris van Doorn

The pushout of categories

The morphisms in the pushout of two categories is defined as a quotient on lists of composable
morphisms. We first define a general notion of indexed lists, such that each element in the list has two endpoints, and the endpoints between adjacent members of the list have to be the same.
-/

import ..category ..nat_trans hit.set_quotient algebra.relation ..groupoid

open eq is_trunc functor trunc sum set_quotient relation iso category sigma nat

inductive indexed_list {A : Type} (R : A → A → Type) : A → A → Type :=
| nil {} : Π{a : A}, indexed_list R a a
| cons   : Π{a₁ a₂ a₃ : A} (r : R a₂ a₃), indexed_list R a₁ a₂ → indexed_list R a₁ a₃

namespace indexed_list

  notation h :: t  := cons h t
  notation `[` l:(foldr `, ` (h t, cons h t) nil `]`) := l

  variables {A : Type} {R : A → A → Type} {a a' a₁ a₂ a₃ a₄ : A}

  definition concat (r : R a₁ a₂) (l : indexed_list R a₂ a₃) : indexed_list R a₁ a₃ :=
  begin
    induction l with a a₂ a₃ a₄ r' l IH,
    { exact [r]},
    { exact r' :: IH r}
  end

  theorem concat_nil (r : R a₁ a₂) : concat r (@nil A R a₂) = [r] := idp

  theorem concat_cons (r : R a₁ a₂) (r' : R a₃ a₄) (l : indexed_list R a₂ a₃)
    : concat r (r'::l)  = r'::(concat r l) := idp

  definition append (l₂ : indexed_list R a₂ a₃) (l₁ : indexed_list R a₁ a₂) :
    indexed_list R a₁ a₃ :=
  begin
    induction l₂,
    { exact l₁},
    { exact cons r (v_0 l₁)}
  end

  infix ` ++ ` := append

  definition nil_append (l : indexed_list R a₁ a₂) : nil ++ l = l := idp
  definition cons_append (r : R a₃ a₄) (l₂ : indexed_list R a₂ a₃) (l₁ : indexed_list R a₁ a₂) :
    (r :: l₂) ++ l₁ = r :: (l₂ ++ l₁) := idp

  definition singleton_append (r : R a₂ a₃) (l : indexed_list R a₁ a₂) : [r] ++ l = r :: l := idp
  definition append_singleton (l : indexed_list R a₂ a₃) (r : R a₁ a₂) : l ++ [r] = concat r l :=
  begin
    induction l,
    { reflexivity},
    { exact ap (cons r) !v_0}
  end

  definition append_nil (l : indexed_list R a₁ a₂) : l ++ nil = l :=
  begin
    induction l,
    { reflexivity},
    { exact ap (cons r) v_0}
  end

  definition append_assoc (l₃ : indexed_list R a₃ a₄) (l₂ : indexed_list R a₂ a₃)
    (l₁ : indexed_list R a₁ a₂) : (l₃ ++ l₂) ++ l₁ = l₃ ++ (l₂ ++ l₁) :=
  begin
    induction l₃,
    { reflexivity},
    { refine ap (cons r) !v_0}
  end

  theorem append_concat (l₂ : indexed_list R a₃ a₄) (l₁ : indexed_list R a₂ a₃) (r : R a₁ a₂) :
    l₂ ++ concat r l₁ = concat r (l₂ ++ l₁) :=
  begin
    induction l₂,
    { reflexivity},
    { exact ap (cons r_1) !v_0}
  end

  theorem concat_append (l₂ : indexed_list R a₃ a₄) (r : R a₂ a₃) (l₁ : indexed_list R a₁ a₂) :
    concat r l₂ ++ l₁ = l₂ ++ r :: l₁ :=
  begin
    induction l₂,
    { reflexivity},
    { exact ap (cons r) !v_0}
  end

  definition indexed_list.rec_tail {C : Π⦃a a' : A⦄, indexed_list R a a' → Type}
  (H0 : Π {a : A}, @C a a nil)
  (H1 : Π {a₁ a₂ a₃ : A} (r : R a₁ a₂) (l : indexed_list R a₂ a₃), C l → C (concat r l)) :
  Π{a a' : A} (l : indexed_list R a a'), C l :=
  begin
    have Π{a₁ a₂ a₃ : A} (l₂ : indexed_list R a₂ a₃) (l₁ : indexed_list R a₁ a₂) (c : C l₂),
      C (l₂ ++ l₁),
    begin
      intros, revert a₃ l₂ c, induction l₁: intros a₃ l₂ c,
      { rewrite append_nil, exact c},
      { rewrite [-concat_append], apply v_0, apply H1, exact c}
    end,
    intros, rewrite [-nil_append], apply this, apply H0
  end

  definition cons_eq_concat (r : R a₂ a₃) (l : indexed_list R a₁ a₂) :
    Σa (r' : R a₁ a) (l' : indexed_list R a a₃), r :: l = concat r' l' :=
  begin
    revert a₃ r, induction l: intros a₃' r',
    { exact ⟨a₃', r', nil, idp⟩},
    { cases (v_0 a₃ r) with a₄ w, cases w with r₂ w, cases w with l p, clear v_0,
      exact ⟨a₄, r₂, r' :: l, ap (cons r') p⟩}
  end

  definition length (l : indexed_list R a₁ a₂) : ℕ :=
  begin
    induction l,
    { exact 0},
    { exact succ v_0}
  end

  definition reverse (rev : Π⦃a a'⦄, R a a' → R a' a) (l : indexed_list R a₁ a₂) :
    indexed_list R a₂ a₁ :=
  begin
    induction l,
    { exact nil},
    { exact concat (rev r) v_0}
  end

  theorem reverse_nil (rev : Π⦃a a'⦄, R a a' → R a' a) : reverse rev (@nil A R a₁) = [] := idp

  theorem reverse_cons (rev : Π⦃a a'⦄, R a a' → R a' a) (r : R a₂ a₃) (l : indexed_list R a₁ a₂) :
    reverse rev (r::l) = concat (rev r) (reverse rev l) := idp

  theorem reverse_singleton (rev : Π⦃a a'⦄, R a a' → R a' a) (r : R a₁ a₂) :
    reverse rev [r] = [rev r] := idp

  theorem reverse_pair (rev : Π⦃a a'⦄, R a a' → R a' a) (r₂ : R a₂ a₃) (r₁ : R a₁ a₂) :
    reverse rev [r₂, r₁] = [rev r₁, rev r₂] := idp

  theorem reverse_concat (rev : Π⦃a a'⦄, R a a' → R a' a) (r : R a₁ a₂) (l : indexed_list R a₂ a₃) :
    reverse rev (concat r l) = rev r :: (reverse rev l) :=
  begin
    induction l,
    { reflexivity},
    { rewrite [concat_cons, reverse_cons, v_0]}
  end

  theorem reverse_append (rev : Π⦃a a'⦄, R a a' → R a' a) (l₂ : indexed_list R a₂ a₃)
    (l₁ : indexed_list R a₁ a₂) : reverse rev (l₂ ++ l₁) = reverse rev l₁ ++ reverse rev l₂ :=
  begin
    induction l₂,
    { exact !append_nil⁻¹},
    { rewrite [cons_append, +reverse_cons, append_concat, v_0]}
  end

  definition realize (P : A → A → Type) (f : Π⦃a a'⦄, R a a' → P a a') (ρ : Πa, P a a)
    (c : Π⦃a₁ a₂ a₃⦄, P a₁ a₂ → P a₂ a₃ → P a₁ a₃)
    ⦃a a' : A⦄ (l : indexed_list R a a') : P a a' :=
  begin
    induction l,
    { exact ρ a},
    { exact c v_0 (f r)}
  end

  definition realize_nil (P : A → A → Type) (f : Π⦃a a'⦄, R a a' → P a a') (ρ : Πa, P a a)
    (c : Π⦃a₁ a₂ a₃⦄, P a₁ a₂ → P a₂ a₃ → P a₁ a₃) (a : A) :
    realize P f ρ c nil = ρ a :=
  idp

  definition realize_cons (P : A → A → Type) (f : Π⦃a a'⦄, R a a' → P a a') (ρ : Πa, P a a)
    (c : Π⦃a₁ a₂ a₃⦄, P a₁ a₂ → P a₂ a₃ → P a₁ a₃)
    ⦃a₁ a₂ a₃ : A⦄ (r : R a₂ a₃) (l : indexed_list R a₁ a₂) :
    realize P f ρ c (r :: l) = c (realize P f ρ c l) (f r) :=
  idp

  theorem realize_singleton {P : A → A → Type} {f : Π⦃a a'⦄, R a a' → P a a'} {ρ : Πa, P a a}
    {c : Π⦃a₁ a₂ a₃⦄, P a₁ a₂ → P a₂ a₃ → P a₁ a₃}
    (id_left : Π⦃a₁ a₂⦄ (p : P a₁ a₂), c (ρ a₁) p = p)
    ⦃a₁ a₂ : A⦄ (r : R a₁ a₂) :
    realize P f ρ c [r] = f r :=
  id_left (f r)

  theorem realize_pair {P : A → A → Type} {f : Π⦃a a'⦄, R a a' → P a a'} {ρ : Πa, P a a}
    {c : Π⦃a₁ a₂ a₃⦄, P a₁ a₂ → P a₂ a₃ → P a₁ a₃}
    (id_left : Π⦃a₁ a₂⦄ (p : P a₁ a₂), c (ρ a₁) p = p)
    ⦃a₁ a₂ a₃ : A⦄ (r₂ : R a₂ a₃) (r₁ : R a₁ a₂) :
    realize P f ρ c [r₂, r₁] = c (f r₁) (f r₂) :=
  ap (λx, c x (f r₂)) (realize_singleton id_left r₁)

  theorem realize_append {P : A → A → Type} {f : Π⦃a a'⦄, R a a' → P a a'} {ρ : Πa, P a a}
    {c : Π⦃a₁ a₂ a₃⦄, P a₁ a₂ → P a₂ a₃ → P a₁ a₃}
    (assoc : Π⦃a₁ a₂ a₃ a₄⦄ (p : P a₁ a₂) (q : P a₂ a₃) (r : P a₃ a₄), c (c p q) r = c p (c q r))
    (id_right : Π⦃a₁ a₂⦄ (p : P a₁ a₂), c p (ρ a₂) = p)
    ⦃a₁ a₂ a₃ : A⦄ (l₂ : indexed_list R a₂ a₃) (l₁ : indexed_list R a₁ a₂) :
    realize P f ρ c (l₂ ++ l₁) = c (realize P f ρ c l₁) (realize P f ρ c l₂) :=
  begin
    induction l₂,
    { exact !id_right⁻¹},
    { rewrite [cons_append, +realize_cons, v_0, assoc]}
  end

  inductive indexed_list_rel {A : Type} {R : A → A → Type}
    (Q : Π⦃a a' : A⦄, indexed_list R a a' → indexed_list R a a' → Type)
    : Π⦃a a' : A⦄, indexed_list R a a' → indexed_list R a a' → Type :=
  | rrefl  : Π{a a' : A} (l : indexed_list R a a'), indexed_list_rel Q l l
  | rel    : Π{a₁ a₂ a₃ : A} {l₂ l₃ : indexed_list R a₂ a₃} (l : indexed_list R a₁ a₂) (q : Q l₂ l₃),
      indexed_list_rel Q (l₂ ++ l) (l₃ ++ l)
  | rcons  : Π{a₁ a₂ a₃ : A} {l₁ l₂ : indexed_list R a₁ a₂} (r : R a₂ a₃),
      indexed_list_rel Q l₁ l₂ → indexed_list_rel Q (cons r l₁) (cons r l₂)
  | rtrans : Π{a₁ a₂ : A} {l₁ l₂ l₃ : indexed_list R a₁ a₂},
      indexed_list_rel Q l₁ l₂ → indexed_list_rel Q l₂ l₃ → indexed_list_rel Q l₁ l₃

  open indexed_list_rel
  attribute rrefl [refl]
  attribute rtrans [trans]
  variables {Q : Π⦃a a' : A⦄, indexed_list R a a' → indexed_list R a a' → Type}

  definition indexed_list_rel_of_Q {l₁ l₂ : indexed_list R a₁ a₂} (q : Q l₁ l₂) :
    indexed_list_rel Q l₁ l₂ :=
  begin
    rewrite [-append_nil l₁, -append_nil l₂], exact rel nil q,
  end

  theorem rel_respect_append_left (l : indexed_list R a₂ a₃) {l₃ l₄ : indexed_list R a₁ a₂}
    (H : indexed_list_rel Q l₃ l₄) : indexed_list_rel Q (l ++ l₃) (l ++ l₄) :=
  begin
    induction l,
    { exact H},
    { exact rcons r (v_0 _ _ H)}
  end

  theorem rel_respect_append_right {l₁ l₂ : indexed_list R a₂ a₃} (l : indexed_list R a₁ a₂)
    (H₁ : indexed_list_rel Q l₁ l₂) : indexed_list_rel Q (l₁ ++ l) (l₂ ++ l) :=
  begin
    induction H₁ with a₁ a₂ l₁
                      a₂ a₃ a₄ l₂ l₂' l₁ q
                      a₂ a₃ a₄ l₁ l₂ r H₁ IH
                      a₂ a₃ l₁ l₂ l₂' H₁ H₁' IH IH',
    { reflexivity},
    { rewrite [+ append_assoc], exact rel _ q},
    { exact rcons r (IH l) },
    { exact rtrans (IH l) (IH' l)}
  end

  theorem rel_respect_append {l₁ l₂ : indexed_list R a₂ a₃} {l₃ l₄ : indexed_list R a₁ a₂}
    (H₁ : indexed_list_rel Q l₁ l₂) (H₂ : indexed_list_rel Q l₃ l₄) :
    indexed_list_rel Q (l₁ ++ l₃) (l₂ ++ l₄) :=
  begin
    induction H₁ with a₁ a₂ l
                      a₂ a₃ a₄ l₂ l₂' l q
                      a₂ a₃ a₄ l₁ l₂ r H₁ IH
                      a₂ a₃ l₁ l₂ l₂' H₁ H₁' IH IH',
    { exact rel_respect_append_left _ H₂},
    { rewrite [+ append_assoc], transitivity _, exact rel _ q,
      apply rel_respect_append_left, apply rel_respect_append_left, exact H₂},
    { exact rcons r (IH _ _ H₂) },
    { refine rtrans (IH _ _ H₂) _, apply rel_respect_append_right, exact H₁'}
  end

  theorem rel_respect_reverse (rev : Π⦃a a'⦄, R a a' → R a' a) {l₁ l₂ : indexed_list R a₁ a₂}
    (H : indexed_list_rel Q l₁ l₂)
    (rev_rel : Π⦃a a' : A⦄ {l l' : indexed_list R a a'},
      Q l l' → indexed_list_rel Q (reverse rev l) (reverse rev l')) :
    indexed_list_rel Q (reverse rev l₁) (reverse rev l₂) :=
  begin
    induction H,
    { reflexivity},
    { rewrite [+ reverse_append], apply rel_respect_append_left, apply rev_rel q},
    { rewrite [+reverse_cons,-+append_singleton], apply rel_respect_append_right, exact v_0},
    { exact rtrans v_0 v_1}
  end

  theorem rel_left_inv (rev : Π⦃a a'⦄, R a a' → R a' a) (l : indexed_list R a₁ a₂)
    (li : Π⦃a a' : A⦄ (r : R a a'), indexed_list_rel Q [rev r, r] nil) :
    indexed_list_rel Q (reverse rev l ++ l) nil :=
  begin
    induction l,
    { reflexivity},
    { rewrite [reverse_cons, concat_append],
      refine rtrans _ v_0, apply rel_respect_append_left,
      exact rel_respect_append_right _ (li r)}
  end

  theorem rel_right_inv (rev : Π⦃a a'⦄, R a a' → R a' a) (l : indexed_list R a₁ a₂)
    (ri : Π⦃a a' : A⦄ (r : R a a'), indexed_list_rel Q [r, rev r] nil) :
    indexed_list_rel Q (l ++ reverse rev l) nil :=
  begin
    induction l using indexed_list.rec_tail,
    { reflexivity},
    { rewrite [reverse_concat, concat_append],
      refine rtrans _ a, apply rel_respect_append_left,
      exact rel_respect_append_right _ (ri r)}
  end

  definition realize_eq {P : A → A → Type} {f : Π⦃a a'⦄, R a a' → P a a'} {ρ : Πa, P a a}
    {c : Π⦃a₁ a₂ a₃⦄, P a₁ a₂ → P a₂ a₃ → P a₁ a₃}
    (assoc : Π⦃a₁ a₂ a₃ a₄⦄ (p : P a₁ a₂) (q : P a₂ a₃) (r : P a₃ a₄), c (c p q) r = c p (c q r))
    (id_right : Π⦃a₁ a₂⦄ (p : P a₁ a₂), c p (ρ a₂) = p)
    (resp_rel : Π⦃a₁ a₂⦄ {l₁ l₂ : indexed_list R a₁ a₂}, Q l₁ l₂ →
      realize P f ρ c l₁ = realize P f ρ c l₂)
    ⦃a a' : A⦄ {l l' : indexed_list R a a'} (H : indexed_list_rel Q l l') :
    realize P f ρ c l = realize P f ρ c l' :=
  begin
    induction H,
    { reflexivity},
    { rewrite [+realize_append assoc id_right], apply ap (c _), exact resp_rel q},
    { exact ap (λx, c x (f r)) v_0},
    { exact v_0 ⬝ v_1}
  end


end indexed_list
namespace indexed_list
  section
  parameters {A : Type} {R : A → A → Type}
    (Q : Π⦃a a' : A⦄, indexed_list R a a' → indexed_list R a a' → Type)
  variables ⦃a a' a₁ a₂ a₃ a₄ : A⦄
  definition indexed_list_trel [constructor] (l l' : indexed_list R a a') : Prop :=
  ∥indexed_list_rel Q l l'∥

  local notation `S` := @indexed_list_trel
  definition indexed_list_quotient (a a' : A) : Type := set_quotient (@S a a')
  local notation `mor` := indexed_list_quotient
  local attribute indexed_list_quotient [reducible]

  definition is_reflexive_R : is_reflexive (@S a a') :=
  begin constructor, intro s, apply tr, constructor end
  local attribute is_reflexive_R [instance]

  definition indexed_list_compose [unfold 7 8] (g : mor a₂ a₃) (f : mor a₁ a₂) : mor a₁ a₃ :=
  begin
    refine quotient_binary_map _ _ g f, exact append,
    intros, refine trunc_functor2 _ r s, exact rel_respect_append
  end

  definition indexed_list_id [constructor] (a : A) : mor a a :=
  class_of nil

  local infix ` ∘∘ `:60 := indexed_list_compose
  local notation `p1` := indexed_list_id _

  theorem indexed_list_assoc (h : mor a₃ a₄) (g : mor a₂ a₃) (f : mor a₁ a₂) :
    h ∘∘ (g ∘∘ f) = (h ∘∘ g) ∘∘ f :=
  begin
    induction h using set_quotient.rec_prop with h,
    induction g using set_quotient.rec_prop with g,
    induction f using set_quotient.rec_prop with f,
    rewrite [▸*, append_assoc]
  end

  theorem indexed_list_id_left (f : mor a a') : p1 ∘∘ f = f :=
  begin
    induction f using set_quotient.rec_prop with f,
    reflexivity
  end

  theorem indexed_list_id_right (f : mor a a') : f ∘∘ p1 = f :=
  begin
    induction f using set_quotient.rec_prop with f,
    rewrite [▸*, append_nil]
  end

  definition Precategory_indexed_list [constructor] : Precategory :=
  precategory.MK A
                 mor
                 _
                 indexed_list_compose
                 indexed_list_id
                 indexed_list_assoc
                 indexed_list_id_left
                 indexed_list_id_right

  parameters (inv : Π⦃a a' : A⦄, R a a' → R a' a)
    (rel_inv : Π⦃a a' : A⦄ {l l' : indexed_list R a a'},
      Q l l' → indexed_list_rel Q (reverse inv l) (reverse inv l'))
    (li : Π⦃a a' : A⦄ (r : R a a'), indexed_list_rel Q [inv r, r] nil)
    (ri : Π⦃a a' : A⦄ (r : R a a'), indexed_list_rel Q [r, inv r] nil)

  include rel_inv li ri
  definition indexed_list_inv [unfold 8] (f : mor a a') : mor a' a :=
  begin
    refine quotient_unary_map (reverse inv) _ f,
    intros, refine trunc_functor _ _ r, esimp,
    intro s, apply rel_respect_reverse inv s rel_inv
  end

  local postfix `^`:max := indexed_list_inv

  theorem indexed_list_left_inv (f : mor a₁ a₂) : f^ ∘∘ f = p1 :=
  begin
    induction f using set_quotient.rec_prop with f,
    esimp, apply eq_of_rel, apply tr,
    apply rel_left_inv, apply li
  end

  theorem indexed_list_right_inv (f : mor a₁ a₂) : f ∘∘ f^ = p1 :=
  begin
    induction f using set_quotient.rec_prop with f,
    esimp, apply eq_of_rel, apply tr,
    apply rel_right_inv, apply ri
  end

  definition Groupoid_indexed_list [constructor] : Groupoid :=
  groupoid.MK Precategory_indexed_list
    (λa b f, is_iso.mk (indexed_list_inv f) (indexed_list_left_inv f) (indexed_list_right_inv f))

  end


end indexed_list
open indexed_list

namespace category

  inductive pushout_prehom_index {C D E : Precategory} (F : C ⇒ D) (G : C ⇒ E) :
    D + E → D + E → Type :=
  | iD : Π{d d' : D} (f : d ⟶ d'), pushout_prehom_index F G (inl d) (inl d')
  | iE : Π{e e' : E} (g : e ⟶ e'), pushout_prehom_index F G (inr e) (inr e')
  | DE : Π(c : C), pushout_prehom_index F G (inl (F c)) (inr (G c))
  | ED : Π(c : C), pushout_prehom_index F G (inr (G c)) (inl (F c))

  open pushout_prehom_index

  definition pushout_prehom {C D E : Precategory} (F : C ⇒ D) (G : C ⇒ E) : D + E → D + E → Type :=
  indexed_list (pushout_prehom_index F G)

  inductive pushout_hom_rel_index {C D E : Precategory} (F : C ⇒ D) (G : C ⇒ E) :
    Π⦃x x' : D + E⦄, pushout_prehom F G x x' → pushout_prehom F G x x' → Type :=
  | DD  : Π{d₁ d₂ d₃ : D} (g : d₂ ⟶ d₃) (f : d₁ ⟶ d₂),
      pushout_hom_rel_index F G [iD F G g, iD F G f] [iD F G (g ∘ f)]
  | EE  : Π{e₁ e₂ e₃ : E} (g : e₂ ⟶ e₃) (f : e₁ ⟶ e₂),
      pushout_hom_rel_index F G [iE F G g, iE F G f] [iE F G (g ∘ f)]
  | DED : Π(c : C), pushout_hom_rel_index F G [ED F G c, DE F G c] nil
  | EDE : Π(c : C), pushout_hom_rel_index F G [DE F G c, ED F G c] nil
  | idD : Π(d : D), pushout_hom_rel_index F G [iD F G (ID d)] nil
  | idE : Π(e : E), pushout_hom_rel_index F G [iE F G (ID e)] nil

  open pushout_hom_rel_index
  -- section
  -- parameters {C D E : Precategory} (F : C ⇒ D) (G : C ⇒ E)
  -- local notation `ob` := D + E
  -- variables ⦃x x' x₁ x₂ x₃ x₄ : ob⦄

  -- definition pushout_hom_rel [constructor] (l l' : pushout_prehom F G x x') : Prop :=
  -- ∥indexed_list_rel (pushout_hom_rel_index F G) l l'∥

  -- local notation `R` := @pushout_hom_rel
  -- definition pushout_hom (x x' : ob) : Type := set_quotient (@R x x')
  -- local notation `mor` := @pushout_hom
  -- local attribute pushout_hom [reducible]

  -- definition is_reflexive_R : is_reflexive (@R x x') :=
  -- begin constructor, intro s, apply tr, constructor end
  -- local attribute is_reflexive_R [instance]

  -- definition pushout_compose [unfold 9 10] (g : mor x₂ x₃) (f : mor x₁ x₂) : mor x₁ x₃ :=
  -- begin
  --   refine quotient_binary_map _ _ g f, exact append,
  --   intros, refine trunc_functor2 _ r s, exact rel_respect_append
  -- end

  -- definition pushout_id [constructor] (x : ob) : mor x x :=
  -- class_of nil

  -- local infix ` ∘∘ `:60 := pushout_compose
  -- local notation `p1` := pushout_id _

  -- theorem pushout_assoc (h : mor x₃ x₄) (g : mor x₂ x₃) (f : mor x₁ x₂) :
  --   h ∘∘ (g ∘∘ f) = (h ∘∘ g) ∘∘ f :=
  -- begin
  --   induction h using set_quotient.rec_prop with h,
  --   induction g using set_quotient.rec_prop with g,
  --   induction f using set_quotient.rec_prop with f,
  --   rewrite [▸*, append_assoc]
  -- end

  -- theorem pushout_id_left (f : mor x x') : p1 ∘∘ f = f :=
  -- begin
  --   induction f using set_quotient.rec_prop with f,
  --   reflexivity
  -- end

  -- theorem pushout_id_right (f : mor x x') : f ∘∘ p1 = f :=
  -- begin
  --   induction f using set_quotient.rec_prop with f,
  --   rewrite [▸*, append_nil]
  -- end

  definition Precategory_pushout [constructor] {C D E : Precategory} (F : C ⇒ D) (G : C ⇒ E) :
    Precategory :=
  Precategory_indexed_list (pushout_hom_rel_index F G)
  -- precategory.MK ob
  --                mor
  --                _
  --                pushout_compose
  --                pushout_id
  --                pushout_assoc
  --                pushout_id_left
  --                pushout_id_right

  -- end

  variables {C D E : Groupoid} (F : C ⇒ D) (G : C ⇒ E)
  variables ⦃x x' x₁ x₂ x₃ x₄ : Precategory_pushout F G⦄

  definition pushout_index_inv [unfold 8] (i : pushout_prehom_index F G x x') :
    pushout_prehom_index F G x' x :=
  begin
    induction i,
    { exact iD F G f⁻¹},
    { exact iE F G g⁻¹},
    { exact ED F G c},
    { exact DE F G c},
  end

  open indexed_list.indexed_list_rel
  theorem pushout_index_reverse {l l' : pushout_prehom F G x x'}
    (q : pushout_hom_rel_index F G l l') : indexed_list_rel (pushout_hom_rel_index F G)
      (reverse (pushout_index_inv F G) l) (reverse (pushout_index_inv F G) l') :=
  begin
    induction q: apply indexed_list_rel_of_Q;
    try rewrite reverse_singleton; try rewrite reverse_pair; try rewrite reverse_nil; esimp;
    try rewrite [comp_inverse]; try rewrite [id_inverse]; constructor,
  end

  theorem pushout_index_li (i : pushout_prehom_index F G x x') :
    indexed_list_rel (pushout_hom_rel_index F G) [pushout_index_inv F G i, i] nil :=
  begin
    induction i: esimp,
    { refine rtrans (indexed_list_rel_of_Q !DD) _,
      rewrite [comp.left_inverse], exact indexed_list_rel_of_Q !idD},
    { refine rtrans (indexed_list_rel_of_Q !EE) _,
      rewrite [comp.left_inverse], exact indexed_list_rel_of_Q !idE},
    { exact indexed_list_rel_of_Q !DED},
    { exact indexed_list_rel_of_Q !EDE}
  end

  theorem pushout_index_ri (i : pushout_prehom_index F G x x') :
    indexed_list_rel (pushout_hom_rel_index F G) [i, pushout_index_inv F G i] nil :=
  begin
    induction i: esimp,
    { refine rtrans (indexed_list_rel_of_Q !DD) _,
      rewrite [comp.right_inverse], exact indexed_list_rel_of_Q !idD},
    { refine rtrans (indexed_list_rel_of_Q !EE) _,
      rewrite [comp.right_inverse], exact indexed_list_rel_of_Q !idE},
    { exact indexed_list_rel_of_Q !EDE},
    { exact indexed_list_rel_of_Q !DED}
  end

  definition Groupoid_pushout [constructor] : Groupoid :=
  Groupoid_indexed_list (pushout_hom_rel_index F G) (pushout_index_inv F G)
    (pushout_index_reverse F G) (pushout_index_li F G) (pushout_index_ri F G)


end category