Move the category of families

src/Cat/Categories/Fam.agda

@@ -0,0 +1,48 @@
+{-# OPTIONS --allow-unsolved-metas #-}
+module Cat.Categories.Fam where
+
+open import Agda.Primitive
+open import Data.Product
+open import Cubical
+import Function
+
+open import Cat.Category
+open import Cat.Equality
+
+open Equality.Data.Product
+
+module _ {ℓa ℓb : Level} where
+  private
+    Obj = Σ[ A ∈ Set ℓa ] (A → Set ℓb)
+    Arr : Obj → Obj → Set (ℓa ⊔ ℓb)
+    Arr (A , B) (A' , B') = Σ[ f ∈ (A → A') ] ({x : A} → B x → B' (f x))
+    one : {o : Obj} → Arr o o
+    proj₁ one = λ x → x
+    proj₂ one = λ b → b
+    _∘_ : {a b c : Obj} → Arr b c → Arr a b → Arr a c
+    (g , g') ∘ (f , f') = g Function.∘ f , g' Function.∘ f'
+    _⟨_∘_⟩ : {a b : Obj} → (c : Obj) → Arr b c → Arr a b → Arr a c
+    c ⟨ g ∘ f ⟩ = _∘_ {c = c} g f
+
+    module _ {A B C D : Obj} {f : Arr A B} {g : Arr B C} {h : Arr C D} where
+      assoc : (D ⟨ h ∘ C ⟨ g ∘ f ⟩ ⟩) ≡ D ⟨ D ⟨ h ∘ g ⟩ ∘ f ⟩
+      assoc = Σ≡ refl refl
+
+    module _ {A B : Obj} {f : Arr A B} where
+      ident : B ⟨ f ∘ one ⟩ ≡ f × B ⟨ one {B} ∘ f ⟩ ≡ f
+      ident = (Σ≡ refl refl) , Σ≡ refl refl
+
+    instance
+      isCategory : IsCategory Obj Arr one (λ {a b c} → _∘_ {a} {b} {c})
+      isCategory = record
+        { assoc = λ {A} {B} {C} {D} {f} {g} {h} → assoc {D = D} {f} {g} {h}
+        ; ident = λ {A} {B} {f} → ident {A} {B} {f = f}
+        }
+
+  Fam : Category (lsuc (ℓa ⊔ ℓb)) (ℓa ⊔ ℓb)
+  Fam = record
+    { Object = Obj
+    ; Arrow = Arr
+    ; 𝟙 = one
+    ; _∘_ = λ {a b c} → _∘_ {a} {b} {c}
+    }

src/Cat/Cubical.agda

@@ -8,54 +8,22 @@ open import Data.Sum
 open import Data.Unit
 open import Data.Empty
 open import Data.Product
+open import Function
+open import Cubical
 
 open import Cat.Category
 open import Cat.Functor
+open import Cat.Categories.Fam
 
 -- See chapter 1 for a discussion on how presheaf categories are CwF's.
 
 -- See section 6.8 in Huber's thesis for details on how to implement the
 -- categorical version of CTT
 
-module CwF {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') where
 open Category hiding (_∘_)
 open Functor
-  open import Function
-  open import Cubical
-
-  module _ {ℓa ℓb : Level} where
-    private
-      Obj = Σ[ A ∈ Set ℓa ] (A → Set ℓb)
-      Arr : Obj → Obj → Set (ℓa ⊔ ℓb)
-      Arr (A , B) (A' , B') = Σ[ f ∈ (A → A') ] ({x : A} → B x → B' (f x))
-      one : {o : Obj} → Arr o o
-      proj₁ one = λ x → x
-      proj₂ one = λ b → b
-      _:⊕:_ : {a b c : Obj} → Arr b c → Arr a b → Arr a c
-      (g , g') :⊕: (f , f') = g ∘ f , g' ∘ f'
-
-      module _ {A B C D : Obj} {f : Arr A B} {g : Arr B C} {h : Arr C D} where
-        :assoc: : (_:⊕:_ {A} {C} {D} h (_:⊕:_ {A} {B} {C} g f)) ≡ (_:⊕:_ {A} {B} {D} (_:⊕:_ {B} {C} {D} h g) f)
-        :assoc: = {!!}
-
-      module _ {A B : Obj} {f : Arr A B} where
-        :ident: : (_:⊕:_ {A} {A} {B} f one) ≡ f × (_:⊕:_ {A} {B} {B} one f) ≡ f
-        :ident: = {!!}
-
-      instance
-        :isCategory: : IsCategory Obj Arr one (λ {a b c} → _:⊕:_ {a} {b} {c})
-        :isCategory: = record
-          { assoc = λ {A} {B} {C} {D} {f} {g} {h} → :assoc: {A} {B} {C} {D} {f} {g} {h}
-          ; ident = {!!}
-          }
-    Fam : Category (lsuc (ℓa ⊔ ℓb)) (ℓa ⊔ ℓb)
-    Fam = record
-      { Object = Obj
-      ; Arrow = Arr
-      ; 𝟙 = one
-      ; _∘_ = λ {a b c} → _:⊕:_ {a} {b} {c}
-      }
 
+module CwF {ℓ ℓ' : Level} (ℂ : Category ℓ ℓ') where
   Contexts = ℂ .Object
   Substitutions = ℂ .Arrow