Scaffolding for proving groupoid for monads

This commit is contained in:
Frederik Hanghøj Iversen 2018-05-22 15:35:21 +02:00
parent 1f2b105f9d
commit e7f40eed8a
2 changed files with 35 additions and 4 deletions

View File

@ -1,7 +1,7 @@
{--- {---
The Kleisli formulation of monads The Kleisli formulation of monads
---} ---}
{-# OPTIONS --cubical #-} {-# OPTIONS --cubical --allow-unsolved-metas #-}
open import Agda.Primitive open import Agda.Primitive
open import Cat.Prelude open import Cat.Prelude
@ -265,3 +265,34 @@ module _ {m n : Monad} (eq : Monad.raw m ≡ Monad.raw n) where
Monad≡ : m n Monad≡ : m n
Monad.raw (Monad≡ i) = eq i Monad.raw (Monad≡ i) = eq i
Monad.isMonad (Monad≡ i) = eqIsMonad i Monad.isMonad (Monad≡ i) = eqIsMonad i
module _ where
private
module _ (x y : RawMonad) (p q : x y) (a b : p q) where
eq0-helper : isGrpd (Object Object)
eq0-helper = grpdPi (λ a .groupoidObject)
eq0 : cong (cong RawMonad.omap) a cong (cong RawMonad.omap) b
eq0 = eq0-helper
(RawMonad.omap x) (RawMonad.omap y)
(cong RawMonad.omap p) (cong RawMonad.omap q)
(cong (cong RawMonad.omap) a) (cong (cong RawMonad.omap) b)
eq1-helper : (omap : Object Object) isGrpd ({X : Object} [ X , omap X ])
eq1-helper f = grpdPiImpl (setGrpd .arrowsAreSets)
postulate
eq1 : PathP (λ i PathP
(λ j
PathP (λ k {X : Object} [ X , eq0 i j k X ])
(RawMonad.pure x) (RawMonad.pure y))
(λ i RawMonad.pure (p i)) (λ i RawMonad.pure (q i)))
(cong-d (cong-d RawMonad.pure) a) (cong-d (cong-d RawMonad.pure) b)
grpdRaw : isGrpd RawMonad
RawMonad.omap (grpdRaw x y p q a b x₁ x₂ x₃) = eq0 x y p q a b x₁ x₂ x₃
RawMonad.pure (grpdRaw x y p q a b x₁ x₂ x₃) = {!eq1 x y p q a b x₁ x₂ x₃!}
RawMonad.bind (grpdRaw x y p q a b x₁ x₂ x₃) = {!!}
-- grpdKleisli : isGrpd Monad
-- grpdKleisli = {!!}

View File

@ -107,13 +107,13 @@ module _ { : Level} {A : Set } where
ntypeCumulative {m} ≤′-refl lvl = lvl ntypeCumulative {m} ≤′-refl lvl = lvl
ntypeCumulative {n} {suc m} (≤′-step le) lvl = HasLevel+1 m ⟩₋₂ (ntypeCumulative le lvl) ntypeCumulative {n} {suc m} (≤′-step le) lvl = HasLevel+1 m ⟩₋₂ (ntypeCumulative le lvl)
grpdPi : {a b : Level} {A : Set a} {B : A Set b} grpdPi : {b : Level} {B : A Set b}
((a : A) isGrpd (B a)) isGrpd ((a : A) (B a)) ((a : A) isGrpd (B a)) isGrpd ((a : A) (B a))
grpdPi = piPresNType (S (S (S ⟨-2⟩))) grpdPi = piPresNType (S (S (S ⟨-2⟩)))
grpdPiImpl : {a b : Level} {A : Set a} {B : A Set b} grpdPiImpl : {b : Level} {B : A Set b}
({a : A} isGrpd (B a)) isGrpd ({a : A} (B a)) ({a : A} isGrpd (B a)) isGrpd ({a : A} (B a))
grpdPiImpl {A = A} {B} g = equivPreservesNType {A = Expl} {B = Impl} {n = one} e (grpdPi (λ a g)) grpdPiImpl {B = B} g = equivPreservesNType {A = Expl} {B = Impl} {n = one} e (grpdPi (λ a g))
where where
one = (S (S (S ⟨-2⟩))) one = (S (S (S ⟨-2⟩)))
t : ({a : A} HasLevel one (B a)) t : ({a : A} HasLevel one (B a))