Further reduce dependency on impossible facts.
Provide the data for the product in the category of categories without requiring such a category to actually exist
This commit is contained in:
parent
77006011d3
commit
5902c6121b
|
@ -62,8 +62,7 @@ module _ (ℓ ℓ' : Level) where
|
|||
|
||||
-- The following to some extend depends on the category of categories being a
|
||||
-- category. In some places it may not actually be needed, however.
|
||||
module _ {ℓ ℓ' : Level} (unprovable : IsCategory (RawCat ℓ ℓ')) where
|
||||
module _ (ℂ 𝔻 : Category ℓ ℓ') where
|
||||
module CatProducts {ℓ ℓ' : Level} (ℂ 𝔻 : Category ℓ ℓ') where
|
||||
private
|
||||
:Object: = Object ℂ × Object 𝔻
|
||||
:Arrow: : :Object: → :Object: → Set ℓ'
|
||||
|
@ -84,44 +83,45 @@ module _ {ℓ ℓ' : Level} (unprovable : IsCategory (RawCat ℓ ℓ')) where
|
|||
RawCategory._∘_ :rawProduct: = _:⊕:_
|
||||
open RawCategory :rawProduct:
|
||||
|
||||
module C = Category ℂ
|
||||
module D = Category 𝔻
|
||||
module ℂ = Category ℂ
|
||||
module 𝔻 = Category 𝔻
|
||||
open import Cubical.Sigma
|
||||
issSet : {A B : RawCategory.Object :rawProduct:} → isSet (Arrow A B)
|
||||
issSet = setSig {sA = C.arrowsAreSets} {sB = λ x → D.arrowsAreSets}
|
||||
ident' : IsIdentity :𝟙:
|
||||
ident'
|
||||
= Σ≡ (fst C.isIdentity) (fst D.isIdentity)
|
||||
, Σ≡ (snd C.isIdentity) (snd D.isIdentity)
|
||||
postulate univalent : Univalence.Univalent :rawProduct: ident'
|
||||
arrowsAreSets : ArrowsAreSets -- {A B : RawCategory.Object :rawProduct:} → isSet (Arrow A B)
|
||||
arrowsAreSets = setSig {sA = ℂ.arrowsAreSets} {sB = λ x → 𝔻.arrowsAreSets}
|
||||
isIdentity : IsIdentity :𝟙:
|
||||
isIdentity
|
||||
= Σ≡ (fst ℂ.isIdentity) (fst 𝔻.isIdentity)
|
||||
, Σ≡ (snd ℂ.isIdentity) (snd 𝔻.isIdentity)
|
||||
postulate univalent : Univalence.Univalent :rawProduct: isIdentity
|
||||
instance
|
||||
:isCategory: : IsCategory :rawProduct:
|
||||
IsCategory.isAssociative :isCategory: = Σ≡ C.isAssociative D.isAssociative
|
||||
IsCategory.isIdentity :isCategory: = ident'
|
||||
IsCategory.arrowsAreSets :isCategory: = issSet
|
||||
IsCategory.isAssociative :isCategory: = Σ≡ ℂ.isAssociative 𝔻.isAssociative
|
||||
IsCategory.isIdentity :isCategory: = isIdentity
|
||||
IsCategory.arrowsAreSets :isCategory: = arrowsAreSets
|
||||
IsCategory.univalent :isCategory: = univalent
|
||||
|
||||
:product: : Category ℓ ℓ'
|
||||
Category.raw :product: = :rawProduct:
|
||||
obj : Category ℓ ℓ'
|
||||
Category.raw obj = :rawProduct:
|
||||
|
||||
proj₁ : Functor :product: ℂ
|
||||
proj₁ : Functor obj ℂ
|
||||
proj₁ = record
|
||||
{ raw = record { func* = fst ; func→ = fst }
|
||||
; isFunctor = record { isIdentity = refl ; isDistributive = refl }
|
||||
}
|
||||
|
||||
proj₂ : Functor :product: 𝔻
|
||||
proj₂ : Functor obj 𝔻
|
||||
proj₂ = record
|
||||
{ raw = record { func* = snd ; func→ = snd }
|
||||
; isFunctor = record { isIdentity = refl ; isDistributive = refl }
|
||||
}
|
||||
|
||||
module _ {X : Category ℓ ℓ'} (x₁ : Functor X ℂ) (x₂ : Functor X 𝔻) where
|
||||
x : Functor X :product:
|
||||
private
|
||||
x : Functor X obj
|
||||
x = record
|
||||
{ raw = record
|
||||
{ func* = λ x → x₁ .func* x , x₂ .func* x
|
||||
; func→ = λ x → func→ x₁ x , func→ x₂ x
|
||||
{ func* = λ x → x₁.func* x , x₂.func* x
|
||||
; func→ = λ x → x₁.func→ x , x₂.func→ x
|
||||
}
|
||||
; isFunctor = record
|
||||
{ isIdentity = Σ≡ x₁.isIdentity x₂.isIdentity
|
||||
|
@ -147,27 +147,30 @@ module _ {ℓ ℓ' : Level} (unprovable : IsCategory (RawCat ℓ ℓ')) where
|
|||
isUniq : F[ proj₁ ∘ x ] ≡ x₁ × F[ proj₂ ∘ x ] ≡ x₂
|
||||
isUniq = isUniqL , isUniqR
|
||||
|
||||
uniq : ∃![ x ] (F[ proj₁ ∘ x ] ≡ x₁ × F[ proj₂ ∘ x ] ≡ x₂)
|
||||
uniq = x , isUniq
|
||||
isProduct : ∃![ x ] (F[ proj₁ ∘ x ] ≡ x₁ × F[ proj₂ ∘ x ] ≡ x₂)
|
||||
isProduct = x , isUniq
|
||||
|
||||
module _ {ℓ ℓ' : Level} (unprovable : IsCategory (RawCat ℓ ℓ')) where
|
||||
private
|
||||
Catℓ = Cat ℓ ℓ' unprovable
|
||||
module _ (ℂ 𝔻 : Category ℓ ℓ') where
|
||||
private
|
||||
module P = CatProducts ℂ 𝔻
|
||||
|
||||
instance
|
||||
isProduct : IsProduct Catℓ proj₁ proj₂
|
||||
isProduct = uniq
|
||||
isProduct : IsProduct Catℓ P.proj₁ P.proj₂
|
||||
isProduct = P.isProduct
|
||||
|
||||
product : Product {ℂ = Catℓ} ℂ 𝔻
|
||||
product = record
|
||||
{ obj = :product:
|
||||
; proj₁ = proj₁
|
||||
; proj₂ = proj₂
|
||||
{ obj = P.obj
|
||||
; proj₁ = P.proj₁
|
||||
; proj₂ = P.proj₂
|
||||
}
|
||||
|
||||
module _ {ℓ ℓ' : Level} (unprovable : IsCategory (RawCat ℓ ℓ')) where
|
||||
Catt = Cat ℓ ℓ' unprovable
|
||||
instance
|
||||
hasProducts : HasProducts Catt
|
||||
hasProducts = record { product = product unprovable }
|
||||
hasProducts : HasProducts Catℓ
|
||||
hasProducts = record { product = product }
|
||||
|
||||
-- Basically proves that `Cat ℓ ℓ` is cartesian closed.
|
||||
module _ (ℓ : Level) (unprovable : IsCategory (RawCat ℓ ℓ)) where
|
||||
|
|
Loading…
Reference in a new issue