open import Cat.CartesianClosed.Instances.PSh
open import Cat.Diagram.Everything
open import Cat.Functor.Everything
open import Cat.Instances.Functor
open import Cat.Prelude

open import Topoi.Base

import Cat.Functor.Reasoning as Func
import Cat.Reasoning as Cat

module Topoi.Reasoning where

Reasoning in topoiπŸ”—

As mentioned in the overture on topos theory, categories of sheaves are incredibly nice categories to work in logically, mirroring many of the same properties of the category of Sets. This follows from the fact that they are reflective subcategories of presheaf categories, and those categories enjoy many of the exactness properties of Sets\sets by virtue of being functor categories.

This module provides a companion to the overture which makes it more convenient to reason about a particular sheaf topos by computing explicit descriptions of finite limits and colimits, and establishing the key exactness properties of a topos: Coproducts are disjoint, equivalence relations are effective, and colimits are stable under pullback.

module Sheaf-topos {o β„“} {𝒯 : Precategory o β„“} (T : Topos β„“ 𝒯) where
  open Cat 𝒯 public
  open _⊣_ (T .Topos.L⊣ι) public

  module L = Func (T .Topos.L)
  module L-lex = is-lex (T .Topos.L-lex)
  module ΞΉ = Func (T .Topos.ΞΉ)

  open Topos T using (site) public

  module Presh = Cat (PSh β„“ site)

  LΞΉ-iso : βˆ€ x β†’ is-invertible (counit.Ξ΅ x)
  Lι-iso x = iso→invertible
    (is-reflectiveβ†’counit-is-iso (T .Topos.L⊣ι) (T .Topos.has-ff))

  Ρ⁻¹ : Id => T .Topos.L F∘ T .Topos.ι
  Ρ⁻¹ = Cat._β‰…_.from (is-reflectiveβ†’counit-iso (T .Topos.L⊣ι) (T .Topos.has-ff))
  module Ρ⁻¹ = _=>_ Ρ⁻¹

  psh-equal : βˆ€ {X Y} {f g : Hom X Y} β†’ ΞΉ.₁ f ≑ ΞΉ.₁ g β†’ f ≑ g
  psh-equal = fully-faithful→faithful {F = T .Topos.ι} (T .Topos.has-ff)

Terminology: We will refer to the objects of C\mathcal{C}, the topos, as sheaves, and the objects of [Sop,Sets][S\op,\sets] as presheaves. Correspondingly, the left adjoint functor [Sop,Sets]β†’C[S\op, \sets] \to \mathcal{C} is called sheafification.

LimitsπŸ”—

Since the sheafification functor is left exact and the inclusion functor is fully faithful (thus the adjunction counit is an isomorphism, c.f. Lι-iso), we can compute limits directly in the presheaf category and sheafify. Unfolding the result of this procedure, rather than appealing to the equivalence C≅[Sop,Sets]Lι\mathcal{C} \cong [S\op,\sets]^{L\iota}, yields much better computational properties. We do it by hand for the terminal object, binary products, and binary pullbacks.

  open Terminal
  terminal-sheaf : Terminal 𝒯
  terminal-sheaf .top = L.β‚€ (PSh-terminal {C = site} .top)
  terminal-sheaf .has⊀ = L-lex.pres-⊀ (PSh-terminal {C = site} .has⊀)

  product-sheaf : βˆ€ A B β†’ Product 𝒯 A B
  product-sheaf A B = productβ€² where
    product-presheaf : Product (PSh β„“ site) (ΞΉ.β‚€ A) (ΞΉ.β‚€ B)
    product-presheaf = PSh-products {C = site} _ _

    open Product
    productβ€² : Product 𝒯 A B
    productβ€² .apex = L.β‚€ (product-presheaf .apex)
    productβ€² .π₁ = counit.Ξ΅ _ ∘ L.₁ (product-presheaf .π₁)
    productβ€² .Ο€β‚‚ = counit.Ξ΅ _ ∘ L.₁ (product-presheaf .Ο€β‚‚)
    productβ€² .has-is-product =
      let
        prod =
          L-lex.pres-product
            (PSh-terminal {C = site} .has⊀)
            (product-presheaf .has-is-product)
      in is-product-iso 𝒯 (LΞΉ-iso _) (LΞΉ-iso _) prod

  open Cartesian 𝒯 product-sheaf public

The computation for finite connected limits (pullbacks, equalisers) is a bit more involved, but not by much:

  pullback-sheaf
    : βˆ€ {X Y Z} (f : Hom X Z) (g : Hom Y Z)
    β†’ Pullback 𝒯 f g
  pullback-sheaf f g = pullbackβ€² where
    pullback-presheaf : Pullback (PSh β„“ site) (ΞΉ.₁ f) (ΞΉ.₁ g)
    pullback-presheaf = PSh-pullbacks {C = site} _ _

    open Pullback
    open is-pullback
    module Pb = Pullback pullback-presheaf
    module lpb = is-pullback (L-lex.pres-pullback (pullback-presheaf .has-is-pb))

    pullbackβ€² : Pullback 𝒯 f g
    pullbackβ€² .apex = L.β‚€ Pb.apex
    pullbackβ€² .p₁ = counit.Ξ΅ _ ∘ L.₁ Pb.p₁
    pullbackβ€² .pβ‚‚ = counit.Ξ΅ _ ∘ L.₁ Pb.pβ‚‚
    pullbackβ€² .has-is-pb = pbβ€² where
      pbβ€² : is-pullback 𝒯 _ f _ g
      pbβ€² .square = squareβ€² where abstract
        squareβ€² : f ∘ counit.Ξ΅ _ ∘ L.₁ Pb.p₁ ≑ g ∘ counit.Ξ΅ _ ∘ L.₁ Pb.pβ‚‚
        squareβ€² =
          f ∘ counit.Ξ΅ _ ∘ L.₁ Pb.p₁           β‰‘βŸ¨ extendl (sym (counit.is-natural _ _ _)) βŸ©β‰‘
          counit.Ξ΅ _ ∘ L.₁ (ΞΉ.₁ f) ∘ L.₁ Pb.p₁ β‰‘βŸ¨ refl⟩∘⟨ lpb.square βŸ©β‰‘
          counit.Ξ΅ _ ∘ L.₁ (ΞΉ.₁ g) ∘ L.₁ Pb.pβ‚‚ β‰‘βŸ¨ extendl (counit.is-natural _ _ _) βŸ©β‰‘
          g ∘ counit.Ξ΅ _ ∘ L.₁ Pb.pβ‚‚           ∎

      pbβ€² .limiting {p₁' = p₁'} {pβ‚‚'} p =
        lpb.limiting {p₁' = Ρ⁻¹.Ξ· _ ∘ p₁'} {pβ‚‚' = Ρ⁻¹.Ξ· _ ∘ pβ‚‚'} path
        where abstract
          path : L.₁ (ΞΉ.₁ f) ∘ Ρ⁻¹.Ξ· _ ∘ p₁' ≑ L.₁ (ΞΉ.₁ g) ∘ Ρ⁻¹.Ξ· _ ∘ pβ‚‚'
          path =
            L.₁ (ΞΉ.₁ f) ∘ Ρ⁻¹.Ξ· _ ∘ p₁' β‰‘βŸ¨ extendl (sym (Ρ⁻¹.is-natural _ _ _)) βŸ©β‰‘
            Ρ⁻¹.Ξ· _ ∘ f ∘ p₁'           β‰‘βŸ¨ refl⟩∘⟨ p βŸ©β‰‘
            Ρ⁻¹.Ξ· _ ∘ g ∘ pβ‚‚'           β‰‘βŸ¨ extendl (Ρ⁻¹.is-natural _ _ _) βŸ©β‰‘
            L.₁ (ΞΉ.₁ g) ∘ Ρ⁻¹.Ξ· _ ∘ pβ‚‚' ∎

      pbβ€² .pβ‚βˆ˜limiting =
        pullr lpb.pβ‚βˆ˜limiting βˆ™ cancell (LΞΉ-iso _ .is-invertible.invl)
      pbβ€² .pβ‚‚βˆ˜limiting =
        pullr lpb.pβ‚‚βˆ˜limiting βˆ™ cancell (LΞΉ-iso _ .is-invertible.invl)
      pbβ€² .unique p q = lpb.unique
        (sym ( apβ‚‚ _∘_ refl (sym p βˆ™ sym (assoc _ _ _))
             βˆ™ cancell (LΞΉ-iso _ .is-invertible.invr)))
        (sym ( apβ‚‚ _∘_ refl (sym q βˆ™ sym (assoc _ _ _))
             βˆ™ cancell (LΞΉ-iso _ .is-invertible.invr)))

  finitely-complete : Finitely-complete 𝒯
  finitely-complete .Finitely-complete.terminal = terminal-sheaf
  finitely-complete .Finitely-complete.products = product-sheaf
  finitely-complete .Finitely-complete.equalisers =
    with-pullbacks 𝒯 terminal-sheaf pullback-sheaf
      .Finitely-complete.equalisers
  finitely-complete .Finitely-complete.pullbacks = pullback-sheaf