Prove equality principle for monads

This commit is contained in:
Frederik Hanghøj Iversen 2018-03-01 20:12:49 +01:00
parent a7f31bb3e2
commit f2164a6717

View file

@ -7,7 +7,7 @@ open import Data.Product
open import Cubical open import Cubical
open import Cat.Category open import Cat.Category hiding (propIsAssociative)
open import Cat.Category.Functor as F open import Cat.Category.Functor as F
open import Cat.Category.NaturalTransformation open import Cat.Category.NaturalTransformation
open import Cat.Categories.Fun open import Cat.Categories.Fun
@ -103,13 +103,36 @@ module Monoidal {a b : Level} ( : Category a b) where
isMonad : IsMonad raw isMonad : IsMonad raw
open IsMonad isMonad public open IsMonad isMonad public
postulate propIsMonad : {raw} isProp (IsMonad raw) private
Monad≡ : {m n : Monad} Monad.raw m Monad.raw n m n module _ {m : RawMonad} where
Monad.raw (Monad≡ eq i) = eq i open RawMonad m
Monad.isMonad (Monad≡ {m} {n} eq i) = res i propIsAssociative : isProp IsAssociative
where propIsAssociative x y i {X}
-- TODO: PathJ nightmare + `propIsMonad`. = Category.arrowsAreSets _ _ (x {X}) (y {X}) i
postulate res : (λ i IsMonad (eq i)) [ Monad.isMonad m Monad.isMonad n ] propIsInverse : isProp IsInverse
propIsInverse x y i {X} = e1 i , e2 i
where
xX = x {X}
yX = y {X}
e1 = Category.arrowsAreSets _ _ (proj₁ xX) (proj₁ yX)
e2 = Category.arrowsAreSets _ _ (proj₂ xX) (proj₂ yX)
open IsMonad
propIsMonad : (raw : _) isProp (IsMonad raw)
IsMonad.isAssociative (propIsMonad raw a b i) j
= propIsAssociative {raw}
(isAssociative a) (isAssociative b) i j
IsMonad.isInverse (propIsMonad raw a b i)
= propIsInverse {raw}
(isInverse a) (isInverse b) i
module _ {m n : Monad} (eq : Monad.raw m Monad.raw n) where
open import Cubical.NType.Properties
eqIsMonad : (λ i IsMonad (eq i)) [ Monad.isMonad m Monad.isMonad n ]
eqIsMonad = lemPropF propIsMonad eq
Monad≡ : m n
Monad.raw (Monad≡ i) = eq i
Monad.isMonad (Monad≡ i) = eqIsMonad i
-- "A monad in the Kleisli form" [voe] -- "A monad in the Kleisli form" [voe]
module Kleisli {a b : Level} ( : Category a b) where module Kleisli {a b : Level} ( : Category a b) where