220 lines
7.9 KiB
Agda
220 lines
7.9 KiB
Agda
{---
|
||
Monads
|
||
|
||
This module presents two formulations of monads:
|
||
|
||
* The standard monoidal presentation
|
||
* Kleisli's presentation
|
||
|
||
The first one defines a monad in terms of an endofunctor and two natural
|
||
transformations. The second defines it in terms of a function on objects and a
|
||
pair of arrows.
|
||
|
||
These two formulations are proven to be equivalent:
|
||
|
||
Monoidal.Monad ≃ Kleisli.Monad
|
||
|
||
The monoidal representation is exposed by default from this module.
|
||
---}
|
||
|
||
{-# OPTIONS --cubical --allow-unsolved-metas #-}
|
||
module Cat.Category.Monad where
|
||
|
||
open import Agda.Primitive
|
||
|
||
open import Data.Product
|
||
|
||
open import Cubical
|
||
open import Cubical.NType.Properties using (lemPropF ; lemSig ; lemSigP)
|
||
open import Cubical.GradLemma using (gradLemma)
|
||
|
||
open import Cat.Category
|
||
open import Cat.Category.Functor as F
|
||
open import Cat.Category.NaturalTransformation
|
||
import Cat.Category.Monad.Monoidal
|
||
import Cat.Category.Monad.Kleisli
|
||
open import Cat.Categories.Fun
|
||
|
||
module Monoidal = Cat.Category.Monad.Monoidal
|
||
module Kleisli = Cat.Category.Monad.Kleisli
|
||
|
||
-- | The monoidal- and kleisli presentation of monads are equivalent.
|
||
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||
private
|
||
module ℂ = Category ℂ
|
||
open ℂ using (Object ; Arrow ; 𝟙 ; _∘_ ; _>>>_)
|
||
module M = Monoidal ℂ
|
||
module K = Kleisli ℂ
|
||
|
||
module _ (m : M.RawMonad) where
|
||
open M.RawMonad m
|
||
|
||
forthRaw : K.RawMonad
|
||
K.RawMonad.omap forthRaw = Romap
|
||
K.RawMonad.pure forthRaw = pureT _
|
||
K.RawMonad.bind forthRaw = bind
|
||
|
||
module _ {raw : M.RawMonad} (m : M.IsMonad raw) where
|
||
private
|
||
module MI = M.IsMonad m
|
||
forthIsMonad : K.IsMonad (forthRaw raw)
|
||
K.IsMonad.isIdentity forthIsMonad = proj₂ MI.isInverse
|
||
K.IsMonad.isNatural forthIsMonad = MI.isNatural
|
||
K.IsMonad.isDistributive forthIsMonad = MI.isDistributive
|
||
|
||
forth : M.Monad → K.Monad
|
||
Kleisli.Monad.raw (forth m) = forthRaw (M.Monad.raw m)
|
||
Kleisli.Monad.isMonad (forth m) = forthIsMonad (M.Monad.isMonad m)
|
||
|
||
module _ (m : K.Monad) where
|
||
open K.Monad m
|
||
|
||
backRaw : M.RawMonad
|
||
M.RawMonad.R backRaw = R
|
||
M.RawMonad.pureNT backRaw = pureNT
|
||
M.RawMonad.joinNT backRaw = joinNT
|
||
|
||
private
|
||
open M.RawMonad backRaw
|
||
module R = Functor (M.RawMonad.R backRaw)
|
||
|
||
backIsMonad : M.IsMonad backRaw
|
||
M.IsMonad.isAssociative backIsMonad {X} = begin
|
||
joinT X ∘ R.fmap (joinT X) ≡⟨⟩
|
||
join ∘ fmap (joinT X) ≡⟨⟩
|
||
join ∘ fmap join ≡⟨ isNaturalForeign ⟩
|
||
join ∘ join ≡⟨⟩
|
||
joinT X ∘ joinT (R.omap X) ∎
|
||
M.IsMonad.isInverse backIsMonad {X} = inv-l , inv-r
|
||
where
|
||
inv-l = begin
|
||
joinT X ∘ pureT (R.omap X) ≡⟨⟩
|
||
join ∘ pure ≡⟨ proj₁ isInverse ⟩
|
||
𝟙 ∎
|
||
inv-r = begin
|
||
joinT X ∘ R.fmap (pureT X) ≡⟨⟩
|
||
join ∘ fmap pure ≡⟨ proj₂ isInverse ⟩
|
||
𝟙 ∎
|
||
|
||
back : K.Monad → M.Monad
|
||
Monoidal.Monad.raw (back m) = backRaw m
|
||
Monoidal.Monad.isMonad (back m) = backIsMonad m
|
||
|
||
module _ (m : K.Monad) where
|
||
private
|
||
open K.Monad m
|
||
bindEq : ∀ {X Y}
|
||
→ K.RawMonad.bind (forthRaw (backRaw m)) {X} {Y}
|
||
≡ K.RawMonad.bind (K.Monad.raw m)
|
||
bindEq {X} {Y} = begin
|
||
K.RawMonad.bind (forthRaw (backRaw m)) ≡⟨⟩
|
||
(λ f → join ∘ fmap f) ≡⟨⟩
|
||
(λ f → bind (f >>> pure) >>> bind 𝟙) ≡⟨ funExt lem ⟩
|
||
(λ f → bind f) ≡⟨⟩
|
||
bind ∎
|
||
where
|
||
lem : (f : Arrow X (omap Y))
|
||
→ bind (f >>> pure) >>> bind 𝟙
|
||
≡ bind f
|
||
lem f = begin
|
||
bind (f >>> pure) >>> bind 𝟙
|
||
≡⟨ isDistributive _ _ ⟩
|
||
bind ((f >>> pure) >>> bind 𝟙)
|
||
≡⟨ cong bind ℂ.isAssociative ⟩
|
||
bind (f >>> (pure >>> bind 𝟙))
|
||
≡⟨ cong (λ φ → bind (f >>> φ)) (isNatural _) ⟩
|
||
bind (f >>> 𝟙)
|
||
≡⟨ cong bind ℂ.leftIdentity ⟩
|
||
bind f ∎
|
||
|
||
forthRawEq : forthRaw (backRaw m) ≡ K.Monad.raw m
|
||
K.RawMonad.omap (forthRawEq _) = omap
|
||
K.RawMonad.pure (forthRawEq _) = pure
|
||
K.RawMonad.bind (forthRawEq i) = bindEq i
|
||
|
||
fortheq : (m : K.Monad) → forth (back m) ≡ m
|
||
fortheq m = K.Monad≡ (forthRawEq m)
|
||
|
||
module _ (m : M.Monad) where
|
||
private
|
||
open M.Monad m
|
||
module KM = K.Monad (forth m)
|
||
module R = Functor R
|
||
omapEq : KM.omap ≡ Romap
|
||
omapEq = refl
|
||
|
||
bindEq : ∀ {X Y} {f : Arrow X (Romap Y)} → KM.bind f ≡ bind f
|
||
bindEq {X} {Y} {f} = begin
|
||
KM.bind f ≡⟨⟩
|
||
joinT Y ∘ Rfmap f ≡⟨⟩
|
||
bind f ∎
|
||
|
||
joinEq : ∀ {X} → KM.join ≡ joinT X
|
||
joinEq {X} = begin
|
||
KM.join ≡⟨⟩
|
||
KM.bind 𝟙 ≡⟨⟩
|
||
bind 𝟙 ≡⟨⟩
|
||
joinT X ∘ Rfmap 𝟙 ≡⟨ cong (λ φ → _ ∘ φ) R.isIdentity ⟩
|
||
joinT X ∘ 𝟙 ≡⟨ ℂ.rightIdentity ⟩
|
||
joinT X ∎
|
||
|
||
fmapEq : ∀ {A B} → KM.fmap {A} {B} ≡ Rfmap
|
||
fmapEq {A} {B} = funExt (λ f → begin
|
||
KM.fmap f ≡⟨⟩
|
||
KM.bind (f >>> KM.pure) ≡⟨⟩
|
||
bind (f >>> pureT _) ≡⟨⟩
|
||
Rfmap (f >>> pureT B) >>> joinT B ≡⟨⟩
|
||
Rfmap (f >>> pureT B) >>> joinT B ≡⟨ cong (λ φ → φ >>> joinT B) R.isDistributive ⟩
|
||
Rfmap f >>> Rfmap (pureT B) >>> joinT B ≡⟨ ℂ.isAssociative ⟩
|
||
joinT B ∘ Rfmap (pureT B) ∘ Rfmap f ≡⟨ cong (λ φ → φ ∘ Rfmap f) (proj₂ isInverse) ⟩
|
||
𝟙 ∘ Rfmap f ≡⟨ ℂ.leftIdentity ⟩
|
||
Rfmap f ∎
|
||
)
|
||
|
||
rawEq : Functor.raw KM.R ≡ Functor.raw R
|
||
RawFunctor.omap (rawEq i) = omapEq i
|
||
RawFunctor.fmap (rawEq i) = fmapEq i
|
||
|
||
Req : M.RawMonad.R (backRaw (forth m)) ≡ R
|
||
Req = Functor≡ rawEq
|
||
|
||
open NaturalTransformation ℂ ℂ
|
||
|
||
pureTEq : M.RawMonad.pureT (backRaw (forth m)) ≡ pureT
|
||
pureTEq = funExt (λ X → refl)
|
||
|
||
pureNTEq : (λ i → NaturalTransformation F.identity (Req i))
|
||
[ M.RawMonad.pureNT (backRaw (forth m)) ≡ pureNT ]
|
||
pureNTEq = lemSigP (λ i → propIsNatural F.identity (Req i)) _ _ pureTEq
|
||
|
||
joinTEq : M.RawMonad.joinT (backRaw (forth m)) ≡ joinT
|
||
joinTEq = funExt (λ X → begin
|
||
M.RawMonad.joinT (backRaw (forth m)) X ≡⟨⟩
|
||
KM.join ≡⟨⟩
|
||
joinT X ∘ Rfmap 𝟙 ≡⟨ cong (λ φ → joinT X ∘ φ) R.isIdentity ⟩
|
||
joinT X ∘ 𝟙 ≡⟨ ℂ.rightIdentity ⟩
|
||
joinT X ∎)
|
||
|
||
joinNTEq : (λ i → NaturalTransformation F[ Req i ∘ Req i ] (Req i))
|
||
[ M.RawMonad.joinNT (backRaw (forth m)) ≡ joinNT ]
|
||
joinNTEq = lemSigP (λ i → propIsNatural F[ Req i ∘ Req i ] (Req i)) _ _ joinTEq
|
||
|
||
backRawEq : backRaw (forth m) ≡ M.Monad.raw m
|
||
M.RawMonad.R (backRawEq i) = Req i
|
||
M.RawMonad.pureNT (backRawEq i) = pureNTEq i
|
||
M.RawMonad.joinNT (backRawEq i) = joinNTEq i
|
||
|
||
backeq : (m : M.Monad) → back (forth m) ≡ m
|
||
backeq m = M.Monad≡ (backRawEq m)
|
||
|
||
eqv : isEquiv M.Monad K.Monad forth
|
||
eqv = gradLemma forth back fortheq backeq
|
||
|
||
open import Cat.Equivalence
|
||
|
||
Monoidal≅Kleisli : M.Monad ≅ K.Monad
|
||
Monoidal≅Kleisli = forth , (back , (record { verso-recto = funExt backeq ; recto-verso = funExt fortheq }))
|
||
|
||
Monoidal≃Kleisli : M.Monad ≃ K.Monad
|
||
Monoidal≃Kleisli = forth , eqv
|