Change naming and fuse some modules

This commit is contained in:
Frederik Hanghøj Iversen 2018-03-12 14:38:52 +01:00
parent ccf753d438
commit 5e092964c8

View file

@ -1,3 +1,6 @@
{-
This module provides construction 2.3 in [voe]
-}
{-# OPTIONS --cubical --allow-unsolved-metas #-} {-# OPTIONS --cubical --allow-unsolved-metas #-}
module Cat.Category.Monad.Voevodsky where module Cat.Category.Monad.Voevodsky where
@ -17,17 +20,18 @@ import Cat.Category.Monad.Monoidal as Monoidal
import Cat.Category.Monad.Kleisli as Kleisli import Cat.Category.Monad.Kleisli as Kleisli
open import Cat.Categories.Fun open import Cat.Categories.Fun
module _ {a b : Level} ( : Category a b) where module voe {a b : Level} ( : Category a b) where
private private
= a b = a b
module = Category module = Category
open using (Object ; Arrow ; _∘_) open using (Object ; Arrow)
open NaturalTransformation open NaturalTransformation
open import Function using (_∘_ ; _$_)
module M = Monoidal module M = Monoidal
module K = Kleisli module K = Kleisli
module voe-2-3 (omap : Omap ) (pure : {X : Object} Arrow X (omap X)) where module §2-3 (omap : Omap ) (pure : {X : Object} Arrow X (omap X)) where
record voe-2-3-1 : Set where record §1 : Set where
open M open M
field field
@ -83,7 +87,7 @@ module _ {a b : Level} ( : Category a b) where
; isMonad = isMnd ; isMonad = isMnd
} }
record voe-2-3-2 : Set where record §2 : Set where
open K open K
field field
@ -105,13 +109,8 @@ module _ {a b : Level} ( : Category a b) where
; isMonad = isMnd ; isMonad = isMnd
} }
module _ {a b : Level} { : Category a b} where voe-2-3-1-fromMonad : (m : M.Monad) §2-3.§1 (M.Monad.Romap m) (λ {X} M.Monad.pureT m X)
private -- voe-2-3-1-fromMonad : (m : M.Monad) → voe.§2-3.§1 (M.Monad.Romap m) (λ {X} → M.Monad.pureT m X)
module M = Monoidal
module K = Kleisli
open voe-2-3
voe-2-3-1-fromMonad : (m : M.Monad) voe-2-3-1 (M.Monad.Romap m) (λ {X} M.Monad.pureT m X)
voe-2-3-1-fromMonad m = record voe-2-3-1-fromMonad m = record
{ fmap = Functor.fmap R { fmap = Functor.fmap R
; RisFunctor = Functor.isFunctor R ; RisFunctor = Functor.isFunctor R
@ -128,24 +127,13 @@ module _ {a b : Level} { : Category a b} where
joinT = M.RawMonad.joinT raw joinT = M.RawMonad.joinT raw
joinN = M.RawMonad.joinN raw joinN = M.RawMonad.joinN raw
voe-2-3-2-fromMonad : (m : K.Monad) voe-2-3-2 (K.Monad.omap m) (K.Monad.pure m) voe-2-3-2-fromMonad : (m : K.Monad) §2-3.§2 (K.Monad.omap m) (K.Monad.pure m)
voe-2-3-2-fromMonad m = record voe-2-3-2-fromMonad m = record
{ bind = K.Monad.bind m { bind = K.Monad.bind m
; isMnd = K.Monad.isMonad m ; isMnd = K.Monad.isMonad m
} }
module _ {a b : Level} { : Category a b} where
private
= a b
module = Category
open using (Object ; Arrow)
open NaturalTransformation
module M = Monoidal
module K = Kleisli
open import Function using (_∘_ ; _$_)
module _ (omap : Omap ) (pure : {X : Object} Arrow X (omap X)) where module _ (omap : Omap ) (pure : {X : Object} Arrow X (omap X)) where
open voe-2-3
private private
Monoidal→Kleisli : M.Monad K.Monad Monoidal→Kleisli : M.Monad K.Monad
Monoidal→Kleisli = proj₁ Monoidal≃Kleisli Monoidal→Kleisli = proj₁ Monoidal≃Kleisli
@ -153,11 +141,11 @@ module _ {a b : Level} { : Category a b} where
Kleisli→Monoidal : K.Monad M.Monad Kleisli→Monoidal : K.Monad M.Monad
Kleisli→Monoidal = inverse Monoidal≃Kleisli Kleisli→Monoidal = inverse Monoidal≃Kleisli
forth : voe-2-3-1 omap pure voe-2-3-2 omap pure forth : §2-3.§1 omap pure §2-3.§2 omap pure
forth = voe-2-3-2-fromMonad Monoidal→Kleisli voe-2-3.voe-2-3-1.toMonad forth = voe-2-3-2-fromMonad Monoidal→Kleisli §2-3.§1.toMonad
back : voe-2-3-2 omap pure voe-2-3-1 omap pure back : §2-3.§2 omap pure §2-3.§1 omap pure
back = voe-2-3-1-fromMonad Kleisli→Monoidal voe-2-3.voe-2-3-2.toMonad back = voe-2-3-1-fromMonad Kleisli→Monoidal §2-3.§2.toMonad
forthEq : m _ _ forthEq : m _ _
forthEq m = begin forthEq m = begin
@ -165,23 +153,23 @@ module _ {a b : Level} { : Category a b} where
-- In full gory detail: -- In full gory detail:
( voe-2-3-2-fromMonad ( voe-2-3-2-fromMonad
Monoidal→Kleisli Monoidal→Kleisli
voe-2-3.voe-2-3-1.toMonad §2-3.§1.toMonad
voe-2-3-1-fromMonad voe-2-3-1-fromMonad
Kleisli→Monoidal Kleisli→Monoidal
voe-2-3.voe-2-3-2.toMonad §2-3.§2.toMonad
) m ≡⟨⟩ -- fromMonad and toMonad are inverses ) m ≡⟨⟩ -- fromMonad and toMonad are inverses
( voe-2-3-2-fromMonad ( voe-2-3-2-fromMonad
Monoidal→Kleisli Monoidal→Kleisli
Kleisli→Monoidal Kleisli→Monoidal
voe-2-3.voe-2-3-2.toMonad §2-3.§2.toMonad
) m ≡⟨ u ) m ≡⟨ u
-- Monoidal→Kleisli and Kleisli→Monoidal are inverses -- Monoidal→Kleisli and Kleisli→Monoidal are inverses
-- I should be able to prove this using congruence and `lem` below. -- I should be able to prove this using congruence and `lem` below.
( voe-2-3-2-fromMonad ( voe-2-3-2-fromMonad
voe-2-3.voe-2-3-2.toMonad §2-3.§2.toMonad
) m ≡⟨⟩ ) m ≡⟨⟩
( voe-2-3-2-fromMonad ( voe-2-3-2-fromMonad
voe-2-3.voe-2-3-2.toMonad §2-3.§2.toMonad
) m ≡⟨⟩ -- fromMonad and toMonad are inverses ) m ≡⟨⟩ -- fromMonad and toMonad are inverses
m m
where where
@ -199,25 +187,25 @@ module _ {a b : Level} { : Category a b} where
(back forth) m ≡⟨⟩ (back forth) m ≡⟨⟩
( voe-2-3-1-fromMonad ( voe-2-3-1-fromMonad
Kleisli→Monoidal Kleisli→Monoidal
voe-2-3.voe-2-3-2.toMonad §2-3.§2.toMonad
voe-2-3-2-fromMonad voe-2-3-2-fromMonad
Monoidal→Kleisli Monoidal→Kleisli
voe-2-3.voe-2-3-1.toMonad §2-3.§1.toMonad
) m ≡⟨⟩ -- fromMonad and toMonad are inverses ) m ≡⟨⟩ -- fromMonad and toMonad are inverses
( voe-2-3-1-fromMonad ( voe-2-3-1-fromMonad
Kleisli→Monoidal Kleisli→Monoidal
Monoidal→Kleisli Monoidal→Kleisli
voe-2-3.voe-2-3-1.toMonad §2-3.§1.toMonad
) m ≡⟨ cong (λ φ φ m) t -- Monoidal→Kleisli and Kleisli→Monoidal are inverses ) m ≡⟨ cong (λ φ φ m) t -- Monoidal→Kleisli and Kleisli→Monoidal are inverses
( voe-2-3-1-fromMonad ( voe-2-3-1-fromMonad
voe-2-3.voe-2-3-1.toMonad §2-3.§1.toMonad
) m ≡⟨⟩ -- fromMonad and toMonad are inverses ) m ≡⟨⟩ -- fromMonad and toMonad are inverses
m m
where where
t = {!!} -- cong (λ φ → voe-2-3-1-fromMonad ∘ φ ∘ voe-2-3.voe-2-3-1.toMonad) (recto-verso Monoidal≃Kleisli) t = {!!} -- cong (λ φ → voe-2-3-1-fromMonad ∘ φ ∘ voe-2-3.voe-2-3-1.toMonad) (recto-verso Monoidal≃Kleisli)
voe-isEquiv : isEquiv (voe-2-3-1 omap pure) (voe-2-3-2 omap pure) forth voe-isEquiv : isEquiv (§2-3.§1 omap pure) (§2-3.§2 omap pure) forth
voe-isEquiv = gradLemma forth back forthEq backEq voe-isEquiv = gradLemma forth back forthEq backEq
equiv-2-3 : voe-2-3-1 omap pure voe-2-3-2 omap pure equiv-2-3 : §2-3.§1 omap pure §2-3.§2 omap pure
equiv-2-3 = forth , voe-isEquiv equiv-2-3 = forth , voe-isEquiv