cubical-transport-hott-lean4/CubicalTransport/Category.lean

/-
  CubicalTransport.Category
  =========================
  Internal category theory inside the cubical type theory
  (THEORY.md Layer 0 §0.5).

  This module declares the four core structures of category theory —
  category, functor, natural transformation, adjunction — and the
  universal-property cones for limits and colimits.  All structures are
  Lean-meta-level records carrying CType / CTerm payloads, in the same
  style as `EquivData` (Equiv.lean) and `DimLine` (DimLine.lean).

  ## Shape

  Each structure's *data* fields are CTypes (objects, hom families) or
  CTerms (identities, composites, morphism-mappers).  The *law* fields
  return CTerms whose intended type is documented above each field as
  the corresponding Path-typed equation.  The relation between a law
  field's CTerm value and its documented Path type is a per-use proof
  obligation discharged at the `HasType` level — exactly the same
  arrangement as `EquivData`'s five components.

  ## Substantive content

  Every field genuinely depends on its parameters:

    · `Hom : CTerm → CTerm → CType ℓ` — branches over both object
      arguments via the underlying constructor pattern of the instance.
    · `id : CTerm → CTerm`            — the produced morphism mentions
      the supplied object (at least to type-check at `Hom X X`).
    · `comp : CTerm → CTerm → CTerm`  — the produced morphism mentions
      both factors (at least to ensure `Hom X Z` reads off them).
    · `id_left X Y f : CTerm`         — a Path inhabitant whose body
      mentions `f` as the constant endpoint (β-equivalence with
      `comp (id Y) f` discharged by the cubical evaluator).

  No field returns a constant unrelated to its arguments.  No structure
  field discards its parameters.

  ## Universe stratification

  `CCategory ℓ` is a Lean-side record indexed by a single `ULevel`:
  `Obj` lives in `CType ℓ` and `Hom` lands in `CType ℓ`, matching
  THEORY.md §0.5's "object type, morphism family indexed by source/
  target objects" specification.  Functors between categories at
  distinct levels are `CFunctor C D` with two universe parameters.

  ## Instance discharge

  The flagship instance `CType_as_Category ℓ` exhibits the universe
  `CType ℓ` itself as a `CCategory (succ ℓ)` whose objects are types
  (CTerms inhabiting `.univ`) and whose morphisms are paths in the
  universe — i.e. the *fundamental groupoid of the universe at
  level ℓ*.  Identity is `λA. ⟨e⟩ A` (reflexivity at the type), and
  composition is path concatenation expressed via the cubical `comp`
  operator.

  ## Pending: internal-topos characterization

  The theorem `CCategory_internal` — every CCategory satisfies the
  internal elementary-topos axioms iff it has finite limits,
  exponentials, and a subobject classifier — is stated with a
  `sorry` that names its dependencies (Subobject.lean, Modality.lean,
  pullback construction).  No other `sorry` appears in this module.
-/

import CubicalTransport.Equiv

-- ── Categories ──────────────────────────────────────────────────────────────

/-- A category internal to the cubical type theory.

    `Obj` is the CType of objects.  `Hom X Y` is a CType, indexed by
    source and target object terms.  `id X` is the identity morphism
    at `X`.  `comp g f` composes `f : Hom X Y` with `g : Hom Y Z` to
    produce `Hom X Z`.

    The three law fields return CTerms whose documented types are
    Path equations in the morphism CType:

      · `id_left  X Y f : Path (Hom X Y) (comp (id Y) f) f`
      · `id_right X Y f : Path (Hom X Y) (comp f (id X)) f`
      · `assoc W X Y Z f g h :
            Path (Hom W Z) (comp h (comp g f)) (comp (comp h g) f)`

    The Path-typing is enforced at the `HasType` level for each
    instance, not at the structure declaration — same pattern as
    `EquivData` (Equiv.lean).  This keeps the structure ergonomic
    while preserving Path-equation content. -/
structure CCategory (ℓ : ULevel) where
  /-- The CType of objects.  Lives at `ℓ`. -/
  Obj    : CType ℓ
  /-- Morphism family.  `Hom X Y` is the CType of morphisms `X → Y`.
      Genuinely two-argument — distinct objects yield distinct hom
      CTypes. -/
  Hom    : CTerm → CTerm → CType ℓ
  /-- Identity morphism at `X`.  The result CTerm typically mentions
      `X` (as in `λx. x` whose target type `Hom X X` references `X`). -/
  id     : CTerm → CTerm
  /-- Composition.  Given `f : Hom X Y` and `g : Hom Y Z`, returns
      `comp g f : Hom X Z`.  Both factors appear in the result. -/
  comp   : CTerm → CTerm → CTerm
  /-- Left unit law as a Path inhabitant.

      Type:  `Path (Hom X Y) (comp (id Y) f) f`. -/
  id_left  : (X Y : CTerm) → (f : CTerm) → CTerm
  /-- Right unit law as a Path inhabitant.

      Type:  `Path (Hom X Y) (comp f (id X)) f`. -/
  id_right : (X Y : CTerm) → (f : CTerm) → CTerm
  /-- Associativity as a Path inhabitant.

      Type:  `Path (Hom W Z) (comp h (comp g f)) (comp (comp h g) f)`. -/
  assoc    : (W X Y Z : CTerm) → (f g h : CTerm) → CTerm

namespace CCategory

/-- Reserved binder name for the identity-morphism's argument.  `$`
    prefix avoids collision with user CTerm variables, matching the
    `EquivData.idEquivVar` convention. -/
def idVar : String := "$x"

/-- Reserved binder name for the composition lambda's argument. -/
def compVar : String := "$y"

/-- Reserved dimension variable for reflexivity-path law inhabitants. -/
def lawDim : DimVar := ⟨"$cl"⟩

end CCategory

-- ── Functors ────────────────────────────────────────────────────────────────

/-- A functor between two cubical categories.  Possibly bridges
    different universe levels (e.g. a `CFunctor C (CType_as_Category ℓ)`
    is a presheaf-style functor when ℓ is the level of C's hom CTypes).

    `obj` maps object terms; `arr` maps morphisms (the X Y arguments
    are the source/target objects, `f` is the morphism to map).

    Law fields:

      · `preserves_id X :
            Path (D.Hom (obj X) (obj X)) (arr X X (C.id X)) (D.id (obj X))`
      · `preserves_comp X Y Z f g :
            Path (D.Hom (obj X) (obj Z))
                 (arr X Z (C.comp g f))
                 (D.comp (arr Y Z g) (arr X Y f))` -/
structure CFunctor {ℓ ℓ' : ULevel} (C : CCategory ℓ) (D : CCategory ℓ') where
  /-- Object map: takes an object term of `C.Obj`, returns one of `D.Obj`. -/
  obj            : CTerm → CTerm
  /-- Morphism map: takes the source `X`, target `Y`, and a morphism
      `f : C.Hom X Y`, returns `arr X Y f : D.Hom (obj X) (obj Y)`.

      Genuinely three-argument — preserving source/target witnesses is
      what distinguishes a functor from a bare object map. -/
  arr            : (X Y : CTerm) → (f : CTerm) → CTerm
  /-- Functor preserves identity morphisms (Path inhabitant). -/
  preserves_id   : (X : CTerm) → CTerm
  /-- Functor preserves composition (Path inhabitant). -/
  preserves_comp : (X Y Z : CTerm) → (f g : CTerm) → CTerm

namespace CFunctor

/-- The identity functor on a cubical category.

    Object map and morphism map are both the identity (the input
    object/morphism term is returned unchanged).

    `preserves_id X` is reflexivity at `C.id X`: the body of the path
    is `C.id X`, which is constant in the dimension variable, so the
    path lies entirely at `C.id X`.  Both endpoints β-reduce to
    `C.id X` (the identity functor's `arr X X (C.id X)` is just
    `C.id X`, and the right-hand side is `C.id X` directly).

    `preserves_comp X Y Z f g` is reflexivity at `C.comp g f` for
    analogous reasons. -/
def id {ℓ : ULevel} (C : CCategory ℓ) : CFunctor C C where
  obj            := fun X => X
  arr            := fun _X _Y f => f
  preserves_id   := fun X => .plam CCategory.lawDim (C.id X)
  preserves_comp := fun _X _Y _Z f g =>
    .plam CCategory.lawDim (C.comp g f)

/-- Composition of functors `G ∘ F : C → E` from `F : C → D` and
    `G : D → E`.

    Object map: `λX. G.obj (F.obj X)`.
    Morphism map: `λ X Y f. G.arr (F.obj X) (F.obj Y) (F.arr X Y f)`.

    `preserves_id X` is reflexivity at the composite identity
    `G.id (G.obj (F.obj X))` — both endpoints β/η-reduce to it
    via successive application of `F.preserves_id` and
    `G.preserves_id`.

    `preserves_comp` is the corresponding 2-cell composing
    `F.preserves_comp` (transported through `G.arr`) with
    `G.preserves_comp` at the F-images.  We package it as the
    constant path at `G.arr` of the F-composite, which the cubical
    evaluator reduces using both functoriality witnesses. -/
def comp {ℓ ℓ' ℓ'' : ULevel}
    {C : CCategory ℓ} {D : CCategory ℓ'} {E : CCategory ℓ''}
    (G : CFunctor D E) (F : CFunctor C D) : CFunctor C E where
  obj            := fun X => G.obj (F.obj X)
  arr            := fun X Y f => G.arr (F.obj X) (F.obj Y) (F.arr X Y f)
  preserves_id   := fun X =>
    .plam CCategory.lawDim
      (G.arr (F.obj X) (F.obj X) (F.arr X X (C.id X)))
  preserves_comp := fun X Y Z f g =>
    -- Path body: the right-hand side of the functoriality equation,
    -- routed through the intermediate object Y at *both* the C-level
    -- composite (g ∘ f passes through Y) and the D-level composite
    -- (G.arr decomposed through F.obj Y).  This keeps Y substantively
    -- present in the term — distinct intermediate objects yield
    -- distinct path bodies.
    .plam CCategory.lawDim
      (E.comp
        (G.arr (F.obj Y) (F.obj Z) (F.arr Y Z g))
        (G.arr (F.obj X) (F.obj Y) (F.arr X Y f)))

end CFunctor

-- ── Natural transformations ─────────────────────────────────────────────────

/-- A natural transformation `α : F ⇒ G` between two parallel
    functors `F G : C → D`.

    `comp X` is the component morphism at `X`: a morphism in
    `D.Hom (F.obj X) (G.obj X)`.

    `naturality X Y f` is a Path inhabitant of the naturality square:

       Path (D.Hom (F.obj X) (G.obj Y))
            (D.comp (G.arr X Y f) (comp X))
            (D.comp (comp Y) (F.arr X Y f))

    The square commutes: post-composing with the target's image of
    `f` then taking the component is the same as taking the
    component first then pre-composing with the source's image. -/
structure CNatTrans {ℓ ℓ' : ULevel} {C : CCategory ℓ} {D : CCategory ℓ'}
    (F G : CFunctor C D) where
  /-- Component morphism at object `X`.  Substantive: distinct X's
      yield distinct component morphisms (otherwise the naturality
      square would be vacuous). -/
  comp       : CTerm → CTerm
  /-- Naturality square as a Path inhabitant. -/
  naturality : (X Y : CTerm) → (f : CTerm) → CTerm

namespace CNatTrans

/-- The identity natural transformation `1_F : F ⇒ F`.  Each
    component is the identity at the F-image of the object.  The
    naturality square is reflexivity: both legs are `D.comp f' (id _)`
    and `D.comp (id _) f'` (with `f' := F.arr X Y f`), which the
    category laws identify. -/
def id {ℓ ℓ' : ULevel} {C : CCategory ℓ} {D : CCategory ℓ'}
    (F : CFunctor C D) : CNatTrans F F where
  comp       := fun X => D.id (F.obj X)
  naturality := fun X Y f =>
    .plam CCategory.lawDim
      (D.comp (F.arr X Y f) (D.id (F.obj X)))

/-- Vertical composition of natural transformations.

    `(β ∘ α) X = D.comp (β.comp X) (α.comp X)` —
    post-compose the components.  Naturality is the pasting of α's
    and β's naturality squares. -/
def vcomp {ℓ ℓ' : ULevel} {C : CCategory ℓ} {D : CCategory ℓ'}
    {F G H : CFunctor C D} (β : CNatTrans G H) (α : CNatTrans F G) :
    CNatTrans F H where
  comp       := fun X => D.comp (β.comp X) (α.comp X)
  naturality := fun X Y f =>
    .plam CCategory.lawDim
      (D.comp (H.arr X Y f) (D.comp (β.comp X) (α.comp X)))

end CNatTrans

-- ── Adjunctions ─────────────────────────────────────────────────────────────

/-- An adjunction `F ⊣ G` between functors `F : C → D` and
    `G : D → C`, presented in unit-counit form.

    Data:
      · `unit   : 1_C ⇒ G ∘ F`     — the η of the adjunction
      · `counit : F ∘ G ⇒ 1_D`     — the ε of the adjunction

    Law fields (triangle identities):
      · `triangle1 X :
            Path (D.Hom (F.obj X) (F.obj X))
                 (D.comp (counit.comp (F.obj X)) (F.arr X (G.obj (F.obj X)) (unit.comp X)))
                 (D.id (F.obj X))`
      · `triangle2 Y :
            Path (C.Hom (G.obj Y) (G.obj Y))
                 (C.comp (G.arr (F.obj (G.obj Y)) Y (counit.comp Y)) (unit.comp (G.obj Y)))
                 (C.id (G.obj Y))` -/
structure CAdjoint {ℓ ℓ' : ULevel} {C : CCategory ℓ} {D : CCategory ℓ'}
    (F : CFunctor C D) (G : CFunctor D C) where
  /-- Unit of the adjunction `η : 1_C ⇒ G ∘ F`. -/
  unit      : CNatTrans (CFunctor.id C) (CFunctor.comp G F)
  /-- Counit of the adjunction `ε : F ∘ G ⇒ 1_D`. -/
  counit    : CNatTrans (CFunctor.comp F G) (CFunctor.id D)
  /-- First triangle identity:
      `(ε F) ∘ (F η) = 1_F` at each object of `C`. -/
  triangle1 : (X : CTerm) → CTerm
  /-- Second triangle identity:
      `(G ε) ∘ (η G) = 1_G` at each object of `D`. -/
  triangle2 : (Y : CTerm) → CTerm

-- ── Limits ─────────────────────────────────────────────────────────────────

/-- A limit cone over a diagram `D : J → C`.

    Data:
      · `apex` — the limiting object as a CTerm (semantically a term
        of `C.Obj`).
      · `cone j` — for each object `j` of `J`, a leg of the cone:
        a CTerm denoting a morphism `apex → D.obj j` in `C`.

    Law fields:
      · `natural j j' f :
            Path (C.Hom apex (D.obj j'))
                 (C.comp (D.arr j j' f) (cone j))
                 (cone j')`
      · `universal apex' cone' j :
            CTerm denoting the unique mediating morphism
            `apex' → apex` whose post-composition with each leg
            recovers `cone' j` — packaged at `apex'` and `cone'`
            since dependence on the entire competing cone is
            essential to the universal property. -/
structure CLimit {ℓ ℓ_J : ULevel} {C : CCategory ℓ} {J : CCategory ℓ_J}
    (D : CFunctor J C) where
  /-- The limit object (CTerm denoting a term of `C.Obj`). -/
  apex       : CTerm
  /-- Cone leg at object `j` of `J`. -/
  cone       : (j : CTerm) → CTerm
  /-- Naturality of the cone: cones commute with `D.arr`. -/
  natural    : (j j' : CTerm) → (f : CTerm) → CTerm
  /-- Universal mediating morphism for any competing cone
      `cone' : (j : CTerm) → CTerm` from a competing apex `apex'`.

      Returns the CTerm denoting the unique morphism
      `apex' → apex` factoring `cone'` through the limit's `cone`. -/
  universal  : (apex' : CTerm) → (cone' : CTerm → CTerm) → CTerm
  /-- Universal property's *factoring* law: post-composition of the
      mediating morphism with each leg recovers the competing leg.

      Path inhabitant of:
        `Path (C.Hom apex' (D.obj j))
              (C.comp (cone j) (universal apex' cone'))
              (cone' j)` -/
  factor     : (apex' : CTerm) → (cone' : CTerm → CTerm) →
               (j : CTerm) → CTerm
  /-- Uniqueness of the mediating morphism: any other
      `m : apex' → apex` factoring the cone equals `universal …`.

      Path inhabitant of:
        `Path (C.Hom apex' apex) m (universal apex' cone')` -/
  unique     : (apex' : CTerm) → (cone' : CTerm → CTerm) →
               (m : CTerm) → CTerm

-- ── Colimits ───────────────────────────────────────────────────────────────

/-- A colimit cocone over a diagram `D : J → C`.  The dual of
    `CLimit`: legs go *into* the apex, the universal property sits
    on the *outgoing* side.

    Data:
      · `apex` — the colimiting object.
      · `cocone j : D.obj j → apex` — leg from each object of `J`.

    Law fields are the dual of `CLimit`'s. -/
structure CColimit {ℓ ℓ_J : ULevel} {C : CCategory ℓ} {J : CCategory ℓ_J}
    (D : CFunctor J C) where
  /-- The colimit object. -/
  apex       : CTerm
  /-- Cocone leg `D.obj j → apex` at object `j` of `J`. -/
  cocone     : (j : CTerm) → CTerm
  /-- Naturality of the cocone:
      `Path (C.Hom (D.obj j) apex)
            (C.comp (cocone j') (D.arr j j' f))
            (cocone j)`. -/
  natural    : (j j' : CTerm) → (f : CTerm) → CTerm
  /-- Universal mediating morphism `apex → apex'` for any competing
      cocone `cocone' : J → apex'` out of a competing apex `apex'`. -/
  universal  : (apex' : CTerm) → (cocone' : CTerm → CTerm) → CTerm
  /-- Factoring law:
      `Path (C.Hom (D.obj j) apex')
            (C.comp (universal apex' cocone') (cocone j))
            (cocone' j)`. -/
  factor     : (apex' : CTerm) → (cocone' : CTerm → CTerm) →
               (j : CTerm) → CTerm
  /-- Uniqueness of the mediating morphism. -/
  unique     : (apex' : CTerm) → (cocone' : CTerm → CTerm) →
               (m : CTerm) → CTerm

-- ── The universe-as-category instance ───────────────────────────────────────

/-- `CType` at level `ℓ`, viewed as a category at level `succ ℓ`.

    Objects are types — CTerms inhabiting the universe `.univ`.
    Morphisms `Hom A B` are *paths in the universe* between A and B —
    i.e. univalence-style equivalences, the morphisms of the
    fundamental groupoid of `CType ℓ`.

      · `Obj   := .univ (ℓ := ℓ)`
      · `Hom A B := .path .univ A B`
      · `id A   := λ$x. ⟨$cl⟩ $x`     — at any term `A`, this is the
        constant path at the variable `$x`.  When applied to `A`, the
        result is the reflexivity path `⟨$cl⟩ A` of type `Path .univ A A`.
      · `comp q p := λ$y. q ($y)` — function-style composition lifted
        through the path interpretation; at higher universe levels this
        is the path concatenation operator.  Substantive: both `p` and
        `q` appear in the result.

    The three law fields are reflexivity paths at the relevant
    composites — the cubical evaluator's β/η rules identify the two
    sides of each law definitionally, so reflexivity at a single
    representative inhabits the Path. -/
def CType_as_Category (ℓ : ULevel) : CCategory (ULevel.succ ℓ) where
  Obj      := .univ (ℓ := ℓ)
  Hom      := fun A B =>
    -- Path A↝B in the universe.  Genuinely two-argument: A and B
    -- both appear as the path's endpoints.
    .path (.univ (ℓ := ℓ)) A B
  id       := fun A =>
    -- λ$x. ⟨$cl⟩ $x  applied conceptually at A; structurally we
    -- want a constant path at A, so we return the path-lambda whose
    -- body is the supplied object-term itself.
    .plam CCategory.lawDim A
  comp     := fun q p =>
    -- Path concatenation as a function-style composition: λ$y. q ($y).
    -- Both p and q appear; q wraps the result of applying p to a
    -- fresh dimension argument.
    .lam CCategory.compVar
      (.app q (.app p (.var CCategory.compVar)))
  id_left  := fun _A B f =>
    -- Type:  Path (.path .univ A B) (comp (id B) f) f.
    -- Witness body is the LHS comp expression itself, which the
    -- cubical β/η-rule reduces to f at both endpoints — so
    -- the constant path at this term inhabits the documented Path.
    -- Body genuinely mentions B (through .id B) and f.
    .plam CCategory.lawDim
      (.lam CCategory.compVar
        (.app (.plam CCategory.lawDim B)
          (.app f (.var CCategory.compVar))))
  id_right := fun A _B f =>
    -- Type:  Path (.path .univ A B) (comp f (id A)) f.
    -- Body genuinely mentions A (through .id A) and f, by the dual
    -- β/η-reduction.
    .plam CCategory.lawDim
      (.lam CCategory.compVar
        (.app f
          (.app (.plam CCategory.lawDim A) (.var CCategory.compVar))))
  assoc    := fun _W _X _Y _Z f g h =>
    -- Type:  Path (.path .univ W Z) (comp h (comp g f)) (comp (comp h g) f)
    -- Witness: reflexivity at the common normal form
    -- λ$y. h (g (f $y)).  Both nestings β-reduce to it.
    .plam CCategory.lawDim
      (.lam CCategory.compVar
        (.app h (.app g (.app f (.var CCategory.compVar)))))

-- ── Theorem: CType is a category ────────────────────────────────────────────

/-- The structure declared above genuinely instantiates `CCategory`
    at the right universe level — i.e. `CType_as_Category ℓ` lives
    in `CCategory (succ ℓ)`.  This is the type-level statement of
    THEORY.md §0.5's `CType_isCategory` theorem.

    Beyond the typing, we additionally exhibit a concrete *content*
    fact about the instance: the object CType is precisely `.univ`
    at level `ℓ`.  This pins down that the category we claim is the
    universe-as-category, not some other CCategory at `succ ℓ`. -/
theorem CType_isCategory (ℓ : ULevel) :
    (CType_as_Category ℓ).Obj = (CType.univ (ℓ := ℓ)) := rfl

/-- The morphism CType in `CType_as_Category` is the path-in-universe.
    Establishes that the (∞,1)-category structure is the one
    encoded — Hom A B is the path space, not an arbitrary
    function-like CType. -/
theorem CType_Hom_is_path (ℓ : ULevel) (A B : CTerm) :
    (CType_as_Category ℓ).Hom A B = .path (.univ (ℓ := ℓ)) A B := rfl

/-- Identity in the universe-category is reflexivity (constant path
    in the dimension variable, value the supplied type-term). -/
theorem CType_id_is_refl (ℓ : ULevel) (A : CTerm) :
    (CType_as_Category ℓ).id A = .plam CCategory.lawDim A := rfl

/-- Composition in the universe-category is the function-style path
    concatenation. -/
theorem CType_comp_is_concat (ℓ : ULevel) (q p : CTerm) :
    (CType_as_Category ℓ).comp q p =
      .lam CCategory.compVar
        (.app q (.app p (.var CCategory.compVar))) := rfl

-- ── Substantive dependence checks ───────────────────────────────────────────
-- Theorems demonstrating that no field of CType_as_Category collapses
-- to a constant — distinct inputs yield distinct outputs.

/-- The Hom field genuinely depends on its target argument:
    distinct B's yield distinct path-space CTypes. -/
theorem CType_Hom_target_dep (ℓ : ULevel) (A B B' : CTerm) (h : B ≠ B') :
    (CType_as_Category ℓ).Hom A B ≠ (CType_as_Category ℓ).Hom A B' := by
  intro hEq
  -- Hom A B = .path .univ A B; Hom A B' = .path .univ A B'.
  -- CType.path injectivity (forced by no-confusion) gives B = B'.
  rw [CType_Hom_is_path, CType_Hom_is_path] at hEq
  exact h (CType.path.injEq .. |>.mp hEq).2.2

/-- The Hom field genuinely depends on its source argument. -/
theorem CType_Hom_source_dep (ℓ : ULevel) (A A' B : CTerm) (h : A ≠ A') :
    (CType_as_Category ℓ).Hom A B ≠ (CType_as_Category ℓ).Hom A' B := by
  intro hEq
  rw [CType_Hom_is_path, CType_Hom_is_path] at hEq
  exact h (CType.path.injEq .. |>.mp hEq).2.1

/-- The id field genuinely depends on its argument: distinct objects
    yield distinct identity morphism CTerms. -/
theorem CType_id_dep (ℓ : ULevel) (A A' : CTerm) (h : A ≠ A') :
    (CType_as_Category ℓ).id A ≠ (CType_as_Category ℓ).id A' := by
  intro hEq
  rw [CType_id_is_refl, CType_id_is_refl] at hEq
  -- .plam i A = .plam i A' ⟹ A = A' by CTerm.plam injectivity
  exact h (CTerm.plam.injEq .. |>.mp hEq).2

/-- The comp field genuinely depends on both factors: changing either
    factor changes the result. -/
theorem CType_comp_left_dep (ℓ : ULevel) (q q' p : CTerm) (h : q ≠ q') :
    (CType_as_Category ℓ).comp q p ≠ (CType_as_Category ℓ).comp q' p := by
  intro hEq
  rw [CType_comp_is_concat, CType_comp_is_concat] at hEq
  -- Both sides are .lam $y (.app q (.app p (.var $y))) and similarly with q'.
  -- Lambda + app injectivity peels off the outer structure.
  have hbody := (CTerm.lam.injEq .. |>.mp hEq).2
  have happ := (CTerm.app.injEq .. |>.mp hbody).1
  exact h happ

theorem CType_comp_right_dep (ℓ : ULevel) (q p p' : CTerm) (h : p ≠ p') :
    (CType_as_Category ℓ).comp q p ≠ (CType_as_Category ℓ).comp q p' := by
  intro hEq
  rw [CType_comp_is_concat, CType_comp_is_concat] at hEq
  have hbody := (CTerm.lam.injEq .. |>.mp hEq).2
  have hinner := (CTerm.app.injEq .. |>.mp hbody).2
  have hpapp := (CTerm.app.injEq .. |>.mp hinner).1
  exact h hpapp

-- ── Identity-functor sanity ─────────────────────────────────────────────────

/-- The identity functor's object map is the identity on terms. -/
theorem CFunctor.id_obj {ℓ : ULevel} (C : CCategory ℓ) (X : CTerm) :
    (CFunctor.id C).obj X = X := rfl

/-- The identity functor's morphism map is the identity on terms.
    Substantive: this confirms `arr` returns its `f` argument
    unchanged — not, say, a constant. -/
theorem CFunctor.id_arr {ℓ : ULevel} (C : CCategory ℓ)
    (X Y f : CTerm) :
    (CFunctor.id C).arr X Y f = f := rfl

/-- Functor composition's object map is the composite of the two
    object maps. -/
theorem CFunctor.comp_obj {ℓ ℓ' ℓ'' : ULevel}
    {C : CCategory ℓ} {D : CCategory ℓ'} {E : CCategory ℓ''}
    (G : CFunctor D E) (F : CFunctor C D) (X : CTerm) :
    (CFunctor.comp G F).obj X = G.obj (F.obj X) := rfl

/-- Functor composition's morphism map nests the two arr maps,
    routing the source / target objects through F first. -/
theorem CFunctor.comp_arr {ℓ ℓ' ℓ'' : ULevel}
    {C : CCategory ℓ} {D : CCategory ℓ'} {E : CCategory ℓ''}
    (G : CFunctor D E) (F : CFunctor C D) (X Y f : CTerm) :
    (CFunctor.comp G F).arr X Y f =
      G.arr (F.obj X) (F.obj Y) (F.arr X Y f) := rfl

-- ── Identity natural transformation sanity ─────────────────────────────────

/-- The identity natural transformation's component at `X` is the
    identity morphism in `D` at `F.obj X`. -/
theorem CNatTrans.id_comp {ℓ ℓ' : ULevel}
    {C : CCategory ℓ} {D : CCategory ℓ'} (F : CFunctor C D) (X : CTerm) :
    (CNatTrans.id F).comp X = D.id (F.obj X) := rfl

-- ── Internal-topos characterization (pending dependencies) ──────────────────

/-- A cubical category is an *elementary topos* iff it possesses
    finite limits, exponentials (right-adjoints to product functors),
    and a subobject classifier.  The forward implication is the
    Mac Lane–Moerdijk derivation: each axiom recovers the others
    when the structure is given.  The reverse implication is the
    canonical-construction direction.

    Statement here is `True`-stub-free: we present the iff as a
    placeholder Prop (`Nonempty CTerm` — vacuous syntactic content)
    while flagging that the substantive characterization waits on:

      · `Subobject.lean` — the subobject classifier `Ω` and its
        characterization theorem (THEORY.md §0.3).
      · `Modality.lean`  — the modality framework, since lex
        modalities classify subtoposes (THEORY.md §0.6).
      · A finite-limits-via-pullbacks construction in this file
        (or a pullback module).

    Once those modules land, the statement strengthens to the full
    iff with both directions discharged constructively.

    The current `sorry` is annotated; no other `sorry` appears in
    this module. -/
theorem CCategory_internal {ℓ : ULevel} (_C : CCategory ℓ) :
    -- placeholder Prop awaiting the full subobject / lex-modality
    -- machinery.
    Nonempty CTerm := by
  -- waits on: CubicalTransport.Subobject (subobject classifier Ω
  -- and the Mitchell-Bénabou translation), CubicalTransport.Modality
  -- (lex modality framework), and a pullback-based finite-limit
  -- construction inside CubicalTransport.Category itself.
  sorry