From 091e77b583d37716f51aca8d98dc2d636bf9d964 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Frederik=20Hangh=C3=B8j=20Iversen?= <fhi.1990@gmail.com>
Date: Wed, 14 Mar 2018 10:23:23 +0100
Subject: [PATCH] Rename IsProduct.isProduct to IsProduct.ump

[WIP]: Also some stuff about propositionality for products.
---
 src/Cat/Categories/Cat.agda   |  2 +-
 src/Cat/Categories/Sets.agda  |  2 +-
 src/Cat/Category/Product.agda | 69 +++++++++++++++++++++++++++++++----
 3 files changed, 64 insertions(+), 9 deletions(-)

diff --git a/src/Cat/Categories/Cat.agda b/src/Cat/Categories/Cat.agda
index 8c7bcbb..f013c82 100644
--- a/src/Cat/Categories/Cat.agda
+++ b/src/Cat/Categories/Cat.agda
@@ -167,7 +167,7 @@ module _ {ℓ ℓ' : Level} (unprovable : IsCategory (RawCat ℓ ℓ')) where
       RawProduct.proj₂  rawProduct = P.proj₂
 
       isProduct : IsProduct Catℓ _ _ rawProduct
-      IsProduct.isProduct isProduct = P.isProduct
+      IsProduct.ump isProduct = P.isProduct
 
     product : Product Catℓ ℂ 𝔻
     Product.raw       product = rawProduct
diff --git a/src/Cat/Categories/Sets.agda b/src/Cat/Categories/Sets.agda
index a329a0f..e395512 100644
--- a/src/Cat/Categories/Sets.agda
+++ b/src/Cat/Categories/Sets.agda
@@ -208,7 +208,7 @@ module _ {ℓ : Level} where
         RawProduct.proj₂  rawProduct = Data.Product.proj₂
 
         isProduct : IsProduct 𝓢 _ _ rawProduct
-        IsProduct.isProduct isProduct {X = X} f g
+        IsProduct.ump isProduct {X = X} f g
           = (f &&& g) , lem {0X = X} f g
 
       product : Product 𝓢 0A 0B
diff --git a/src/Cat/Category/Product.agda b/src/Cat/Category/Product.agda
index dff488a..1ddeed9 100644
--- a/src/Cat/Category/Product.agda
+++ b/src/Cat/Category/Product.agda
@@ -3,6 +3,8 @@ module Cat.Category.Product where
 
 open import Agda.Primitive
 open import Cubical
+open import Cubical.NType.Properties using (lemPropF)
+
 open import Data.Product as P hiding (_×_ ; proj₁ ; proj₂)
 
 open import Cat.Category hiding (module Propositionality)
@@ -24,13 +26,13 @@ module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
     record IsProduct (raw : RawProduct) : Set (ℓa ⊔ ℓb) where
       open RawProduct raw public
       field
-        isProduct : ∀ {X : Object} (f : ℂ [ X , A ]) (g : ℂ [ X , B ])
+        ump : ∀ {X : Object} (f : ℂ [ X , A ]) (g : ℂ [ X , B ])
           → ∃![ f×g ] (ℂ [ proj₁ ∘ f×g ] ≡ f P.× ℂ [ proj₂ ∘ f×g ] ≡ g)
 
       -- | Arrow product
       _P[_×_] : ∀ {X} → (π₁ : ℂ [ X , A ]) (π₂ : ℂ [ X , B ])
         → ℂ [ X , object ]
-      _P[_×_] π₁ π₂ = P.proj₁ (isProduct π₁ π₂)
+      _P[_×_] π₁ π₂ = P.proj₁ (ump π₁ π₂)
 
     record Product : Set (ℓa ⊔ ℓb) where
       field
@@ -59,10 +61,63 @@ module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
         ×  ℂ [ g ∘ snd ]
         ]
 
-module Propositionality {ℓa ℓb : Level} {ℂ : Category ℓa ℓb} {A B : Category.Object ℂ} where
-  -- TODO I'm not sure this is actually provable. Check with Thierry.
-  propProduct : isProp (Product ℂ A B)
-  propProduct = {!!}
+module _ {ℓa ℓb : Level} {ℂ : Category ℓa ℓb} {A B : Category.Object ℂ} where
+  private
+    open Category ℂ
+    module _ (raw : RawProduct ℂ A B) where
+      module _ (x y : IsProduct ℂ A B raw) where
+        private
+          module x = IsProduct x
+          module y = IsProduct y
+
+        module _ {X : Object} (f : ℂ [ X , A ]) (g : ℂ [ X , B ]) where
+          prodAux : x.ump f g ≡ y.ump f g
+          prodAux = {!!}
+
+        propIsProduct' : x ≡ y
+        propIsProduct' i = record { ump = λ f g → prodAux f g i }
+
+      propIsProduct : isProp (IsProduct ℂ A B raw)
+      propIsProduct = propIsProduct'
+
+  Product≡ : {x y : Product ℂ A B} → (Product.raw x ≡ Product.raw y) → x ≡ y
+  Product≡ {x} {y} p i = record { raw = p i ; isProduct = q i }
+    where
+    q : (λ i → IsProduct ℂ A B (p i)) [ Product.isProduct x ≡ Product.isProduct y ]
+    q = lemPropF propIsProduct p
+
+module _ {ℓa ℓb : Level} {ℂ : Category ℓa ℓb} {A B : Category.Object ℂ} where
+  open Category ℂ
+  private
+    module _ (x y : HasProducts ℂ) where
+      private
+        module x = HasProducts x
+        module y = HasProducts y
+      module _ (A B : Object) where
+        module pX = Product (x.product A B)
+        module pY = Product (y.product A B)
+        objEq : pX.object ≡ pY.object
+        objEq = {!!}
+        proj₁Eq : (λ i → ℂ [ objEq i , A ]) [ pX.proj₁ ≡ pY.proj₁ ]
+        proj₁Eq = {!!}
+        proj₂Eq : (λ i → ℂ [ objEq i , B ]) [ pX.proj₂ ≡ pY.proj₂ ]
+        proj₂Eq = {!!}
+        rawEq : pX.raw ≡ pY.raw
+        RawProduct.object (rawEq i) = objEq i
+        RawProduct.proj₁  (rawEq i) = {!!}
+        RawProduct.proj₂  (rawEq i) = {!!}
+
+        isEq : (λ i → IsProduct ℂ A B (rawEq i)) [ pX.isProduct ≡ pY.isProduct ]
+        isEq = {!!}
+
+        appEq : x.product A B ≡ y.product A B
+        appEq = Product≡ rawEq
+
+      productEq : x.product ≡ y.product
+      productEq i = λ A B → appEq A B i
+
+      propHasProducts' : x ≡ y
+      propHasProducts' i = record { product = productEq i }
 
   propHasProducts : isProp (HasProducts ℂ)
-  propHasProducts = {!!}
+  propHasProducts = propHasProducts'