feat(hott/algebra) add characterization of paths between precategories

hott/algebra/precategory/basic.hlean

@@ -5,8 +5,9 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Module: algebra.precategory.basic
 Authors: Floris van Doorn
 -/
+import types.trunc types.pi
 
-open eq is_trunc
+open eq is_trunc pi
 
 namespace category
 
@@ -138,4 +139,51 @@ namespace category
   definition Precategory.eta (C : Precategory) : Precategory.mk C C = C :=
   Precategory.rec (λob c, idp) C
 
+  /-Characterization of paths between precategories-/
+
+  definition precategory_eq_mk (ob : Type)
+    (hom1 : ob → ob → Type)
+    (hom2 : ob → ob → Type)
+    (homH1 : Π(a b : ob), is_hset (hom1 a b))
+    (homH2 : Π(a b : ob), is_hset (hom2 a b))
+    (comp1 : Π⦃a b c : ob⦄, hom1 b c → hom1 a b → hom1 a c)
+    (comp2 : Π⦃a b c : ob⦄, hom2 b c → hom2 a b → hom2 a c)
+    (ID1 : Π (a : ob), hom1 a a)
+    (ID2 : Π (a : ob), hom2 a a)
+    (assoc1 : Π ⦃a b c d : ob⦄ (h : hom1 c d) (g : hom1 b c) (f : hom1 a b),
+       comp1 h (comp1 g f) = comp1 (comp1 h g) f)
+    (assoc2 : Π ⦃a b c d : ob⦄ (h : hom2 c d) (g : hom2 b c) (f : hom2 a b),
+       comp2 h (comp2 g f) = comp2 (comp2 h g) f)
+    (id_left1 : Π ⦃a b : ob⦄ (f : hom1 a b), comp1 !ID1 f = f)
+    (id_left2 : Π ⦃a b : ob⦄ (f : hom2 a b), comp2 !ID2 f = f)
+    (id_right1 : Π ⦃a b : ob⦄ (f : hom1 a b), comp1 f !ID1 = f)
+    (id_right2 : Π ⦃a b : ob⦄ (f : hom2 a b), comp2 f !ID2 = f)
+    (p : hom1 = hom2)
+    (q : p ▹ comp1 = comp2)
+    (r : p ▹ ID1 = ID2) :
+    precategory.mk hom1 homH1 comp1 ID1 assoc1 id_left1 id_right1
+    = precategory.mk hom2 homH2 comp2 ID2 assoc2 id_left2 id_right2 :=
+  begin
+    cases p, cases q, cases r,
+    assert PhomH : homH1 = homH2,
+      apply is_hprop.elim,
+    cases PhomH,
+    apply (ap0111 (precategory.mk hom2 homH1 comp2 ID2)),
+    repeat (
+      apply @is_hprop.elim ;
+      repeat (apply is_trunc_pi ; intros) ;
+      apply is_trunc_eq ),
+  end
+
+  definition precategory_eq_mk' (ob : Type)
+    (C D : precategory ob)
+    (p : @hom ob C = @hom ob D)
+    (q : transport (λ x, Πa b c, x b c → x a b → x a c) p
+           (@comp ob C) = @comp ob D)
+    (r : transport (λ x, Πa, x a a) p (@ID ob C) = @ID ob D) : C = D :=
+  begin
+    cases C, cases D,
+    apply precategory_eq_mk, apply q, apply r,
+  end
+
 end category