Implement exponentials

src/Cat/Category.agda

@@ -88,6 +88,13 @@ record Product {ℓ ℓ' : Level} {ℂ : Category ℓ ℓ'} (A B : ℂ .Object)
     proj₁ : ℂ .Arrow obj A
     proj₂ : ℂ .Arrow obj B
     {{isProduct}} : IsProduct ℂ proj₁ proj₂
+  arrowProduct : ∀ {X} → (π₁ : Arrow ℂ X A) (π₂ : Arrow ℂ X B)
+    → Arrow ℂ X obj
+  arrowProduct π₁ π₂ = fst (isProduct π₁ π₂)
+
+record HasProducts {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') : Set (ℓ ⊔ ℓ') where
+  field
+    product : ∀ (A B : ℂ .Object) → Product {ℂ = ℂ} A B
 
 module _ {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') where
   Opposite : Category ℓ ℓ'

src/Cat/Category/Properties.agda

@@ -49,17 +49,32 @@ epi-mono-is-not-iso f =
 -}
 
 
-module _ {ℓa ℓa' ℓb ℓb'} where
+module _ {ℓ ℓ'} (ℂ : Category ℓ ℓ') {{hasProducts : HasProducts ℂ}} (B C : ℂ .Category.Object) where
-  Exponential : Category ℓa ℓa' → Category ℓb ℓb' → Category {!!} {!!}
+  open Category
-  Exponential A B = record
+  open HasProducts hasProducts
-    { Object = {!!}
+  open Product
-    ; Arrow = {!!}
+  prod-obj : (A B : ℂ .Object) → ℂ .Object
-    ; 𝟙 = {!!}
+  prod-obj A B = Product.obj (product A B)
-    ; _⊕_ = {!!}
+  -- The product mentioned in awodey in Def 6.1 is not the regular product of arrows.
-    ; isCategory = {!!}
+  -- It's a "parallel" product
-    }
+  ×A : {A A' B B' : ℂ .Object} → ℂ .Arrow A A' → ℂ .Arrow B B'
+    → ℂ .Arrow (prod-obj A B) (prod-obj A' B')
+  ×A {A = A} {A' = A'} {B = B} {B' = B'} a b = arrowProduct (product A' B')
+    (ℂ ._⊕_ a ((product A B) .proj₁))
+    (ℂ ._⊕_ b ((product A B) .proj₂))
+
+  IsExponential : {Cᴮ : ℂ .Object} → ℂ .Arrow (prod-obj Cᴮ B) C → Set (ℓ ⊔ ℓ')
+  IsExponential eval = ∀ (A : ℂ .Object) (f : ℂ .Arrow (prod-obj A B) C)
+    → ∃![ f~ ] (ℂ ._⊕_ eval (×A f~ (ℂ .𝟙)) ≡ f)
+
+  record Exponential : Set (ℓ ⊔ ℓ') where
+    field
+      -- obj ≡ Cᴮ
+      obj : ℂ .Object
+      eval : ℂ .Arrow ( prod-obj obj B ) C
+      {{isExponential}} : IsExponential eval
 
 _⇑_ = Exponential
 
-yoneda : ∀ {ℓ ℓ'} → {ℂ : Category ℓ ℓ'} → Functor ℂ (Sets ⇑ (Opposite ℂ))
+-- yoneda : ∀ {ℓ ℓ'} → {ℂ : Category ℓ ℓ'} → Functor ℂ (Sets ⇑ (Opposite ℂ))
-yoneda = {!!}
+-- yoneda = {!!}