Use long name
This commit is contained in:
parent
30cf0bb765
commit
4d73514ab5
|
|
@ -10,8 +10,8 @@ open import Cat.Category.NaturalTransformation
|
||||||
open import Cat.Category.Yoneda
|
open import Cat.Category.Yoneda
|
||||||
open import Cat.Category.Monoid
|
open import Cat.Category.Monoid
|
||||||
open import Cat.Category.Monad
|
open import Cat.Category.Monad
|
||||||
open Cat.Category.Monad.Monoidal
|
open import Cat.Category.Monad.Monoidal
|
||||||
open Cat.Category.Monad.Kleisli
|
open import Cat.Category.Monad.Kleisli
|
||||||
open import Cat.Category.Monad.Voevodsky
|
open import Cat.Category.Monad.Voevodsky
|
||||||
|
|
||||||
open import Cat.Categories.Sets
|
open import Cat.Categories.Sets
|
||||||
|
|
|
||||||
|
|
@ -28,186 +28,205 @@ import Cat.Category.Monad.Monoidal
|
||||||
import Cat.Category.Monad.Kleisli
|
import Cat.Category.Monad.Kleisli
|
||||||
open import Cat.Categories.Fun
|
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.
|
-- | The monoidal- and kleisli presentation of monads are equivalent.
|
||||||
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
module _ {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
open Cat.Category.NaturalTransformation ℂ ℂ using (NaturalTransformation ; propIsNatural)
|
open Cat.Category.NaturalTransformation ℂ ℂ using (NaturalTransformation ; propIsNatural)
|
||||||
private
|
private
|
||||||
module ℂ = Category ℂ
|
module ℂ = Category ℂ
|
||||||
open ℂ using (Object ; Arrow ; identity ; _<<<_ ; _>>>_)
|
open ℂ using (Object ; Arrow ; identity ; _<<<_ ; _>>>_)
|
||||||
module M = Monoidal ℂ
|
|
||||||
module K = Kleisli ℂ
|
|
||||||
|
|
||||||
module _ (m : M.RawMonad) where
|
module Monoidal = Cat.Category.Monad.Monoidal ℂ
|
||||||
open M.RawMonad m
|
module Kleisli = Cat.Category.Monad.Kleisli ℂ
|
||||||
|
|
||||||
forthRaw : K.RawMonad
|
module _ (m : Monoidal.RawMonad) where
|
||||||
K.RawMonad.omap forthRaw = Romap
|
open Monoidal.RawMonad m
|
||||||
K.RawMonad.pure forthRaw = pureT _
|
|
||||||
K.RawMonad.bind forthRaw = bind
|
|
||||||
|
|
||||||
module _ {raw : M.RawMonad} (m : M.IsMonad raw) where
|
toKleisliRaw : Kleisli.RawMonad
|
||||||
private
|
Kleisli.RawMonad.omap toKleisliRaw = Romap
|
||||||
module MI = M.IsMonad m
|
Kleisli.RawMonad.pure toKleisliRaw = pure
|
||||||
forthIsMonad : K.IsMonad (forthRaw raw)
|
Kleisli.RawMonad.bind toKleisliRaw = bind
|
||||||
K.IsMonad.isIdentity forthIsMonad = snd MI.isInverse
|
|
||||||
K.IsMonad.isNatural forthIsMonad = MI.isNatural
|
|
||||||
K.IsMonad.isDistributive forthIsMonad = MI.isDistributive
|
|
||||||
|
|
||||||
forth : M.Monad → K.Monad
|
module _ {raw : Monoidal.RawMonad} (m : Monoidal.IsMonad raw) where
|
||||||
Kleisli.Monad.raw (forth m) = forthRaw (M.Monad.raw m)
|
open Monoidal.IsMonad m
|
||||||
Kleisli.Monad.isMonad (forth m) = forthIsMonad (M.Monad.isMonad m)
|
|
||||||
|
|
||||||
module _ (m : K.Monad) where
|
open Kleisli.RawMonad (toKleisliRaw raw) using (_>=>_)
|
||||||
open K.Monad m
|
toKleisliIsMonad : Kleisli.IsMonad (toKleisliRaw raw)
|
||||||
|
Kleisli.IsMonad.isIdentity toKleisliIsMonad = begin
|
||||||
|
bind pure ≡⟨⟩
|
||||||
|
join <<< (fmap pure) ≡⟨ snd isInverse ⟩
|
||||||
|
identity ∎
|
||||||
|
Kleisli.IsMonad.isNatural toKleisliIsMonad f = begin
|
||||||
|
pure >=> f ≡⟨⟩
|
||||||
|
pure >>> bind f ≡⟨⟩
|
||||||
|
bind f <<< pure ≡⟨⟩
|
||||||
|
(join <<< fmap f) <<< pure ≡⟨ isNatural f ⟩
|
||||||
|
f ∎
|
||||||
|
Kleisli.IsMonad.isDistributive toKleisliIsMonad f g = begin
|
||||||
|
bind g >>> bind f ≡⟨⟩
|
||||||
|
(join <<< fmap g) >>> (join <<< fmap f) ≡⟨ isDistributive f g ⟩
|
||||||
|
bind (g >=> f) ∎
|
||||||
|
-- Kleisli.IsMonad.isDistributive toKleisliIsMonad = isDistributive
|
||||||
|
|
||||||
backRaw : M.RawMonad
|
toKleisli : Monoidal.Monad → Kleisli.Monad
|
||||||
M.RawMonad.R backRaw = R
|
Kleisli.Monad.raw (toKleisli m) = toKleisliRaw (Monoidal.Monad.raw m)
|
||||||
M.RawMonad.pureNT backRaw = pureNT
|
Kleisli.Monad.isMonad (toKleisli m) = toKleisliIsMonad (Monoidal.Monad.isMonad m)
|
||||||
M.RawMonad.joinNT backRaw = joinNT
|
|
||||||
|
|
||||||
private
|
module _ (m : Kleisli.Monad) where
|
||||||
open M.RawMonad backRaw renaming
|
open Kleisli.Monad m
|
||||||
( join to join*
|
|
||||||
; pure to pure*
|
|
||||||
; bind to bind*
|
|
||||||
; fmap to fmap*
|
|
||||||
)
|
|
||||||
module R = Functor (M.RawMonad.R backRaw)
|
|
||||||
|
|
||||||
backIsMonad : M.IsMonad backRaw
|
toMonoidalRaw : Monoidal.RawMonad
|
||||||
M.IsMonad.isAssociative backIsMonad = begin
|
Monoidal.RawMonad.R toMonoidalRaw = R
|
||||||
join* <<< R.fmap join* ≡⟨⟩
|
Monoidal.RawMonad.pureNT toMonoidalRaw = pureNT
|
||||||
|
Monoidal.RawMonad.joinNT toMonoidalRaw = joinNT
|
||||||
|
|
||||||
|
open Monoidal.RawMonad toMonoidalRaw renaming
|
||||||
|
( join to join*
|
||||||
|
; pure to pure*
|
||||||
|
; bind to bind*
|
||||||
|
; fmap to fmap*
|
||||||
|
) using ()
|
||||||
|
|
||||||
|
toMonoidalIsMonad : Monoidal.IsMonad toMonoidalRaw
|
||||||
|
Monoidal.IsMonad.isAssociative toMonoidalIsMonad = begin
|
||||||
|
join* <<< fmap join* ≡⟨⟩
|
||||||
join <<< fmap join ≡⟨ isNaturalForeign ⟩
|
join <<< fmap join ≡⟨ isNaturalForeign ⟩
|
||||||
join <<< join ∎
|
join <<< join ∎
|
||||||
M.IsMonad.isInverse backIsMonad {X} = inv-l , inv-r
|
Monoidal.IsMonad.isInverse toMonoidalIsMonad {X} = inv-l , inv-r
|
||||||
where
|
where
|
||||||
inv-l = begin
|
inv-l = begin
|
||||||
join <<< pure ≡⟨ fst isInverse ⟩
|
join <<< pure ≡⟨ fst isInverse ⟩
|
||||||
identity ∎
|
identity ∎
|
||||||
inv-r = begin
|
inv-r = begin
|
||||||
joinT X <<< R.fmap (pureT X) ≡⟨⟩
|
join* <<< fmap* pure* ≡⟨⟩
|
||||||
join <<< fmap pure ≡⟨ snd isInverse ⟩
|
join <<< fmap pure ≡⟨ snd isInverse ⟩
|
||||||
identity ∎
|
identity ∎
|
||||||
|
|
||||||
back : K.Monad → M.Monad
|
toMonoidal : Kleisli.Monad → Monoidal.Monad
|
||||||
Monoidal.Monad.raw (back m) = backRaw m
|
Monoidal.Monad.raw (toMonoidal m) = toMonoidalRaw m
|
||||||
Monoidal.Monad.isMonad (back m) = backIsMonad m
|
Monoidal.Monad.isMonad (toMonoidal m) = toMonoidalIsMonad m
|
||||||
|
|
||||||
module _ (m : K.Monad) where
|
module _ (m : Kleisli.Monad) where
|
||||||
private
|
private
|
||||||
open K.Monad m
|
open Kleisli.Monad m
|
||||||
bindEq : ∀ {X Y}
|
bindEq : ∀ {X Y}
|
||||||
→ K.RawMonad.bind (forthRaw (backRaw m)) {X} {Y}
|
→ Kleisli.RawMonad.bind (toKleisliRaw (toMonoidalRaw m)) {X} {Y}
|
||||||
≡ K.RawMonad.bind (K.Monad.raw m)
|
≡ bind
|
||||||
bindEq {X} {Y} = begin
|
bindEq {X} {Y} = funExt lem
|
||||||
K.RawMonad.bind (forthRaw (backRaw m)) ≡⟨⟩
|
|
||||||
(λ f → join <<< fmap f) ≡⟨⟩
|
|
||||||
(λ f → bind (f >>> pure) >>> bind identity) ≡⟨ funExt lem ⟩
|
|
||||||
(λ f → bind f) ≡⟨⟩
|
|
||||||
bind ∎
|
|
||||||
where
|
where
|
||||||
lem : (f : Arrow X (omap Y))
|
lem : (f : Arrow X (omap Y))
|
||||||
→ bind (f >>> pure) >>> bind identity
|
→ bind (f >>> pure) >>> bind identity
|
||||||
≡ bind f
|
≡ bind f
|
||||||
lem f = begin
|
lem f = begin
|
||||||
|
join <<< fmap f
|
||||||
|
≡⟨⟩
|
||||||
bind (f >>> pure) >>> bind identity
|
bind (f >>> pure) >>> bind identity
|
||||||
≡⟨ isDistributive _ _ ⟩
|
≡⟨ isDistributive _ _ ⟩
|
||||||
|
bind ((f >>> pure) >=> identity)
|
||||||
|
≡⟨⟩
|
||||||
bind ((f >>> pure) >>> bind identity)
|
bind ((f >>> pure) >>> bind identity)
|
||||||
≡⟨ cong bind ℂ.isAssociative ⟩
|
≡⟨ cong bind ℂ.isAssociative ⟩
|
||||||
bind (f >>> (pure >>> bind identity))
|
bind (f >>> (pure >>> bind identity))
|
||||||
|
≡⟨⟩
|
||||||
|
bind (f >>> (pure >=> identity))
|
||||||
≡⟨ cong (λ φ → bind (f >>> φ)) (isNatural _) ⟩
|
≡⟨ cong (λ φ → bind (f >>> φ)) (isNatural _) ⟩
|
||||||
bind (f >>> identity)
|
bind (f >>> identity)
|
||||||
≡⟨ cong bind ℂ.leftIdentity ⟩
|
≡⟨ cong bind ℂ.leftIdentity ⟩
|
||||||
bind f ∎
|
bind f ∎
|
||||||
|
|
||||||
forthRawEq : forthRaw (backRaw m) ≡ K.Monad.raw m
|
toKleisliRawEq : toKleisliRaw (toMonoidalRaw m) ≡ Kleisli.Monad.raw m
|
||||||
K.RawMonad.omap (forthRawEq _) = omap
|
Kleisli.RawMonad.omap (toKleisliRawEq i) = (begin
|
||||||
K.RawMonad.pure (forthRawEq _) = pure
|
Kleisli.RawMonad.omap (toKleisliRaw (toMonoidalRaw m)) ≡⟨⟩
|
||||||
K.RawMonad.bind (forthRawEq i) = bindEq i
|
Monoidal.RawMonad.Romap (toMonoidalRaw m) ≡⟨⟩
|
||||||
|
omap ∎
|
||||||
|
) i
|
||||||
|
Kleisli.RawMonad.pure (toKleisliRawEq i) = (begin
|
||||||
|
Kleisli.RawMonad.pure (toKleisliRaw (toMonoidalRaw m)) ≡⟨⟩
|
||||||
|
Monoidal.RawMonad.pure (toMonoidalRaw m) ≡⟨⟩
|
||||||
|
pure ∎
|
||||||
|
) i
|
||||||
|
Kleisli.RawMonad.bind (toKleisliRawEq i) = bindEq i
|
||||||
|
|
||||||
fortheq : (m : K.Monad) → forth (back m) ≡ m
|
toKleislieq : (m : Kleisli.Monad) → toKleisli (toMonoidal m) ≡ m
|
||||||
fortheq m = K.Monad≡ (forthRawEq m)
|
toKleislieq m = Kleisli.Monad≡ (toKleisliRawEq m)
|
||||||
|
|
||||||
module _ (m : M.Monad) where
|
module _ (m : Monoidal.Monad) where
|
||||||
private
|
private
|
||||||
open M.Monad m
|
open Monoidal.Monad m
|
||||||
module KM = K.Monad (forth m)
|
-- module KM = Kleisli.Monad (toKleisli m)
|
||||||
|
open Kleisli.Monad (toKleisli m) renaming
|
||||||
|
( bind to bind* ; omap to omap* ; join to join*
|
||||||
|
; fmap to fmap* ; pure to pure* ; R to R*)
|
||||||
|
using ()
|
||||||
module R = Functor R
|
module R = Functor R
|
||||||
omapEq : KM.omap ≡ Romap
|
omapEq : omap* ≡ Romap
|
||||||
omapEq = refl
|
omapEq = refl
|
||||||
|
|
||||||
bindEq : ∀ {X Y} {f : Arrow X (Romap Y)} → KM.bind f ≡ bind f
|
bindEq : ∀ {X Y} {f : Arrow X (Romap Y)} → bind* f ≡ bind f
|
||||||
bindEq {X} {Y} {f} = begin
|
bindEq {X} {Y} {f} = begin
|
||||||
KM.bind f ≡⟨⟩
|
bind* f ≡⟨⟩
|
||||||
joinT Y <<< fmap f ≡⟨⟩
|
join <<< fmap f ≡⟨⟩
|
||||||
bind f ∎
|
bind f ∎
|
||||||
|
|
||||||
joinEq : ∀ {X} → KM.join ≡ joinT X
|
joinEq : ∀ {X} → join* ≡ joinT X
|
||||||
joinEq {X} = begin
|
joinEq {X} = begin
|
||||||
KM.join ≡⟨⟩
|
join* ≡⟨⟩
|
||||||
KM.bind identity ≡⟨⟩
|
bind* identity ≡⟨⟩
|
||||||
bind identity ≡⟨⟩
|
bind identity ≡⟨⟩
|
||||||
joinT X <<< fmap identity ≡⟨ cong (λ φ → _ <<< φ) R.isIdentity ⟩
|
join <<< fmap identity ≡⟨ cong (λ φ → _ <<< φ) R.isIdentity ⟩
|
||||||
joinT X <<< identity ≡⟨ ℂ.rightIdentity ⟩
|
join <<< identity ≡⟨ ℂ.rightIdentity ⟩
|
||||||
joinT X ∎
|
join ∎
|
||||||
|
|
||||||
fmapEq : ∀ {A B} → KM.fmap {A} {B} ≡ fmap
|
fmapEq : ∀ {A B} → fmap* {A} {B} ≡ fmap
|
||||||
fmapEq {A} {B} = funExt (λ f → begin
|
fmapEq {A} {B} = funExt (λ f → begin
|
||||||
KM.fmap f ≡⟨⟩
|
fmap* f ≡⟨⟩
|
||||||
KM.bind (f >>> KM.pure) ≡⟨⟩
|
bind* (f >>> pure*) ≡⟨⟩
|
||||||
bind (f >>> pureT _) ≡⟨⟩
|
bind (f >>> pure) ≡⟨⟩
|
||||||
fmap (f >>> pureT B) >>> joinT B ≡⟨⟩
|
fmap (f >>> pure) >>> join ≡⟨⟩
|
||||||
fmap (f >>> pureT B) >>> joinT B ≡⟨ cong (λ φ → φ >>> joinT B) R.isDistributive ⟩
|
fmap (f >>> pure) >>> join ≡⟨ cong (λ φ → φ >>> joinT B) R.isDistributive ⟩
|
||||||
fmap f >>> fmap (pureT B) >>> joinT B ≡⟨ ℂ.isAssociative ⟩
|
fmap f >>> fmap pure >>> join ≡⟨ ℂ.isAssociative ⟩
|
||||||
joinT B <<< fmap (pureT B) <<< fmap f ≡⟨ cong (λ φ → φ <<< fmap f) (snd isInverse) ⟩
|
join <<< fmap pure <<< fmap f ≡⟨ cong (λ φ → φ <<< fmap f) (snd isInverse) ⟩
|
||||||
identity <<< fmap f ≡⟨ ℂ.leftIdentity ⟩
|
identity <<< fmap f ≡⟨ ℂ.leftIdentity ⟩
|
||||||
fmap f ∎
|
fmap f ∎
|
||||||
)
|
)
|
||||||
|
|
||||||
rawEq : Functor.raw KM.R ≡ Functor.raw R
|
rawEq : Functor.raw R* ≡ Functor.raw R
|
||||||
RawFunctor.omap (rawEq i) = omapEq i
|
RawFunctor.omap (rawEq i) = omapEq i
|
||||||
RawFunctor.fmap (rawEq i) = fmapEq i
|
RawFunctor.fmap (rawEq i) = fmapEq i
|
||||||
|
|
||||||
Req : M.RawMonad.R (backRaw (forth m)) ≡ R
|
Req : Monoidal.RawMonad.R (toMonoidalRaw (toKleisli m)) ≡ R
|
||||||
Req = Functor≡ rawEq
|
Req = Functor≡ rawEq
|
||||||
|
|
||||||
pureTEq : M.RawMonad.pureT (backRaw (forth m)) ≡ pureT
|
pureTEq : Monoidal.RawMonad.pureT (toMonoidalRaw (toKleisli m)) ≡ pureT
|
||||||
pureTEq = funExt (λ X → refl)
|
pureTEq = funExt (λ X → refl)
|
||||||
|
|
||||||
pureNTEq : (λ i → NaturalTransformation Functors.identity (Req i))
|
pureNTEq : (λ i → NaturalTransformation Functors.identity (Req i))
|
||||||
[ M.RawMonad.pureNT (backRaw (forth m)) ≡ pureNT ]
|
[ Monoidal.RawMonad.pureNT (toMonoidalRaw (toKleisli m)) ≡ pureNT ]
|
||||||
pureNTEq = lemSigP (λ i → propIsNatural Functors.identity (Req i)) _ _ pureTEq
|
pureNTEq = lemSigP (λ i → propIsNatural Functors.identity (Req i)) _ _ pureTEq
|
||||||
|
|
||||||
joinTEq : M.RawMonad.joinT (backRaw (forth m)) ≡ joinT
|
joinTEq : Monoidal.RawMonad.joinT (toMonoidalRaw (toKleisli m)) ≡ joinT
|
||||||
joinTEq = funExt (λ X → begin
|
joinTEq = funExt (λ X → begin
|
||||||
M.RawMonad.joinT (backRaw (forth m)) X ≡⟨⟩
|
Monoidal.RawMonad.joinT (toMonoidalRaw (toKleisli m)) X ≡⟨⟩
|
||||||
KM.join ≡⟨⟩
|
join* ≡⟨⟩
|
||||||
joinT X <<< fmap identity ≡⟨ cong (λ φ → joinT X <<< φ) R.isIdentity ⟩
|
join <<< fmap identity ≡⟨ cong (λ φ → join <<< φ) R.isIdentity ⟩
|
||||||
joinT X <<< identity ≡⟨ ℂ.rightIdentity ⟩
|
join <<< identity ≡⟨ ℂ.rightIdentity ⟩
|
||||||
joinT X ∎)
|
join ∎)
|
||||||
|
|
||||||
joinNTEq : (λ i → NaturalTransformation F[ Req i ∘ Req i ] (Req i))
|
joinNTEq : (λ i → NaturalTransformation F[ Req i ∘ Req i ] (Req i))
|
||||||
[ M.RawMonad.joinNT (backRaw (forth m)) ≡ joinNT ]
|
[ Monoidal.RawMonad.joinNT (toMonoidalRaw (toKleisli m)) ≡ joinNT ]
|
||||||
joinNTEq = lemSigP (λ i → propIsNatural F[ Req i ∘ Req i ] (Req i)) _ _ joinTEq
|
joinNTEq = lemSigP (λ i → propIsNatural F[ Req i ∘ Req i ] (Req i)) _ _ joinTEq
|
||||||
|
|
||||||
backRawEq : backRaw (forth m) ≡ M.Monad.raw m
|
toMonoidalRawEq : toMonoidalRaw (toKleisli m) ≡ Monoidal.Monad.raw m
|
||||||
M.RawMonad.R (backRawEq i) = Req i
|
Monoidal.RawMonad.R (toMonoidalRawEq i) = Req i
|
||||||
M.RawMonad.pureNT (backRawEq i) = pureNTEq i
|
Monoidal.RawMonad.pureNT (toMonoidalRawEq i) = pureNTEq i
|
||||||
M.RawMonad.joinNT (backRawEq i) = joinNTEq i
|
Monoidal.RawMonad.joinNT (toMonoidalRawEq i) = joinNTEq i
|
||||||
|
|
||||||
backeq : (m : M.Monad) → back (forth m) ≡ m
|
toMonoidaleq : (m : Monoidal.Monad) → toMonoidal (toKleisli m) ≡ m
|
||||||
backeq m = M.Monad≡ (backRawEq m)
|
toMonoidaleq m = Monoidal.Monad≡ (toMonoidalRawEq m)
|
||||||
|
|
||||||
eqv : isEquiv M.Monad K.Monad forth
|
|
||||||
eqv = gradLemma forth back fortheq backeq
|
|
||||||
|
|
||||||
open import Cat.Equivalence
|
open import Cat.Equivalence
|
||||||
|
|
||||||
Monoidal≊Kleisli : M.Monad ≅ K.Monad
|
Monoidal≊Kleisli : Monoidal.Monad ≅ Kleisli.Monad
|
||||||
Monoidal≊Kleisli = forth , back , funExt backeq , funExt fortheq
|
Monoidal≊Kleisli = toKleisli , toMonoidal , funExt toMonoidaleq , funExt toKleislieq
|
||||||
|
|
||||||
Monoidal≡Kleisli : M.Monad ≡ K.Monad
|
Monoidal≡Kleisli : Monoidal.Monad ≡ Kleisli.Monad
|
||||||
Monoidal≡Kleisli = isoToPath Monoidal≊Kleisli
|
Monoidal≡Kleisli = isoToPath Monoidal≊Kleisli
|
||||||
|
|
|
||||||
|
|
@ -18,7 +18,7 @@ private
|
||||||
|
|
||||||
open Category ℂ using (Object ; Arrow ; identity ; _<<<_)
|
open Category ℂ using (Object ; Arrow ; identity ; _<<<_)
|
||||||
open import Cat.Category.NaturalTransformation ℂ ℂ
|
open import Cat.Category.NaturalTransformation ℂ ℂ
|
||||||
using (NaturalTransformation ; Transformation ; Natural)
|
using (NaturalTransformation ; Transformation ; Natural ; NaturalTransformation≡)
|
||||||
|
|
||||||
record RawMonad : Set ℓ where
|
record RawMonad : Set ℓ where
|
||||||
field
|
field
|
||||||
|
|
@ -78,15 +78,39 @@ record IsMonad (raw : RawMonad) : Set ℓ where
|
||||||
|
|
||||||
isNatural : IsNatural
|
isNatural : IsNatural
|
||||||
isNatural {X} {Y} f = begin
|
isNatural {X} {Y} f = begin
|
||||||
joinT Y <<< R.fmap f <<< pureT X ≡⟨ sym ℂ.isAssociative ⟩
|
join <<< fmap f <<< pure ≡⟨ sym ℂ.isAssociative ⟩
|
||||||
joinT Y <<< (R.fmap f <<< pureT X) ≡⟨ cong (λ φ → joinT Y <<< φ) (sym (pureN f)) ⟩
|
join <<< (fmap f <<< pure) ≡⟨ cong (λ φ → join <<< φ) (sym (pureN f)) ⟩
|
||||||
joinT Y <<< (pureT (R.omap Y) <<< f) ≡⟨ ℂ.isAssociative ⟩
|
join <<< (pure <<< f) ≡⟨ ℂ.isAssociative ⟩
|
||||||
joinT Y <<< pureT (R.omap Y) <<< f ≡⟨ cong (λ φ → φ <<< f) (fst isInverse) ⟩
|
join <<< pure <<< f ≡⟨ cong (λ φ → φ <<< f) (fst isInverse) ⟩
|
||||||
identity <<< f ≡⟨ ℂ.leftIdentity ⟩
|
identity <<< f ≡⟨ ℂ.leftIdentity ⟩
|
||||||
f ∎
|
f ∎
|
||||||
|
|
||||||
isDistributive : IsDistributive
|
isDistributive : IsDistributive
|
||||||
isDistributive {X} {Y} {Z} g f = sym aux
|
isDistributive {X} {Y} {Z} g f = begin
|
||||||
|
join <<< fmap g <<< (join <<< fmap f)
|
||||||
|
≡⟨ Category.isAssociative ℂ ⟩
|
||||||
|
join <<< fmap g <<< join <<< fmap f
|
||||||
|
≡⟨ cong (_<<< fmap f) (sym ℂ.isAssociative) ⟩
|
||||||
|
(join <<< (fmap g <<< join)) <<< fmap f
|
||||||
|
≡⟨ cong (λ φ → φ <<< fmap f) (cong (_<<<_ join) (sym (joinN g))) ⟩
|
||||||
|
(join <<< (join <<< R².fmap g)) <<< fmap f
|
||||||
|
≡⟨ cong (_<<< fmap f) ℂ.isAssociative ⟩
|
||||||
|
((join <<< join) <<< R².fmap g) <<< fmap f
|
||||||
|
≡⟨⟩
|
||||||
|
join <<< join <<< R².fmap g <<< fmap f
|
||||||
|
≡⟨ sym ℂ.isAssociative ⟩
|
||||||
|
(join <<< join) <<< (R².fmap g <<< fmap f)
|
||||||
|
≡⟨ cong (λ φ → φ <<< (R².fmap g <<< fmap f)) (sym isAssociative) ⟩
|
||||||
|
(join <<< fmap join) <<< (R².fmap g <<< fmap f)
|
||||||
|
≡⟨ sym ℂ.isAssociative ⟩
|
||||||
|
join <<< (fmap join <<< (R².fmap g <<< fmap f))
|
||||||
|
≡⟨ cong (_<<<_ join) ℂ.isAssociative ⟩
|
||||||
|
join <<< (fmap join <<< R².fmap g <<< fmap f)
|
||||||
|
≡⟨⟩
|
||||||
|
join <<< (fmap join <<< fmap (fmap g) <<< fmap f)
|
||||||
|
≡⟨ cong (λ φ → join <<< φ) (sym distrib3) ⟩
|
||||||
|
join <<< fmap (join <<< fmap g <<< f)
|
||||||
|
∎
|
||||||
where
|
where
|
||||||
module R² = Functor F[ R ∘ R ]
|
module R² = Functor F[ R ∘ R ]
|
||||||
distrib3 : ∀ {A B C D} {a : Arrow C D} {b : Arrow B C} {c : Arrow A B}
|
distrib3 : ∀ {A B C D} {a : Arrow C D} {b : Arrow B C} {c : Arrow A B}
|
||||||
|
|
@ -96,31 +120,6 @@ record IsMonad (raw : RawMonad) : Set ℓ where
|
||||||
R.fmap (a <<< b <<< c) ≡⟨ R.isDistributive ⟩
|
R.fmap (a <<< b <<< c) ≡⟨ R.isDistributive ⟩
|
||||||
R.fmap (a <<< b) <<< R.fmap c ≡⟨ cong (_<<< _) R.isDistributive ⟩
|
R.fmap (a <<< b) <<< R.fmap c ≡⟨ cong (_<<< _) R.isDistributive ⟩
|
||||||
R.fmap a <<< R.fmap b <<< R.fmap c ∎
|
R.fmap a <<< R.fmap b <<< R.fmap c ∎
|
||||||
aux = begin
|
|
||||||
joinT Z <<< R.fmap (joinT Z <<< R.fmap g <<< f)
|
|
||||||
≡⟨ cong (λ φ → joinT Z <<< φ) distrib3 ⟩
|
|
||||||
joinT Z <<< (R.fmap (joinT Z) <<< R.fmap (R.fmap g) <<< R.fmap f)
|
|
||||||
≡⟨⟩
|
|
||||||
joinT Z <<< (R.fmap (joinT Z) <<< R².fmap g <<< R.fmap f)
|
|
||||||
≡⟨ cong (_<<<_ (joinT Z)) (sym ℂ.isAssociative) ⟩
|
|
||||||
joinT Z <<< (R.fmap (joinT Z) <<< (R².fmap g <<< R.fmap f))
|
|
||||||
≡⟨ ℂ.isAssociative ⟩
|
|
||||||
(joinT Z <<< R.fmap (joinT Z)) <<< (R².fmap g <<< R.fmap f)
|
|
||||||
≡⟨ cong (λ φ → φ <<< (R².fmap g <<< R.fmap f)) isAssociative ⟩
|
|
||||||
(joinT Z <<< joinT (R.omap Z)) <<< (R².fmap g <<< R.fmap f)
|
|
||||||
≡⟨ ℂ.isAssociative ⟩
|
|
||||||
joinT Z <<< joinT (R.omap Z) <<< R².fmap g <<< R.fmap f
|
|
||||||
≡⟨⟩
|
|
||||||
((joinT Z <<< joinT (R.omap Z)) <<< R².fmap g) <<< R.fmap f
|
|
||||||
≡⟨ cong (_<<< R.fmap f) (sym ℂ.isAssociative) ⟩
|
|
||||||
(joinT Z <<< (joinT (R.omap Z) <<< R².fmap g)) <<< R.fmap f
|
|
||||||
≡⟨ cong (λ φ → φ <<< R.fmap f) (cong (_<<<_ (joinT Z)) (joinN g)) ⟩
|
|
||||||
(joinT Z <<< (R.fmap g <<< joinT Y)) <<< R.fmap f
|
|
||||||
≡⟨ cong (_<<< R.fmap f) ℂ.isAssociative ⟩
|
|
||||||
joinT Z <<< R.fmap g <<< joinT Y <<< R.fmap f
|
|
||||||
≡⟨ sym (Category.isAssociative ℂ) ⟩
|
|
||||||
joinT Z <<< R.fmap g <<< (joinT Y <<< R.fmap f)
|
|
||||||
∎
|
|
||||||
|
|
||||||
record Monad : Set ℓ where
|
record Monad : Set ℓ where
|
||||||
field
|
field
|
||||||
|
|
|
||||||
|
|
@ -10,6 +10,8 @@ open import Cat.Category
|
||||||
open import Cat.Category.Functor as F
|
open import Cat.Category.Functor as F
|
||||||
import Cat.Category.NaturalTransformation
|
import Cat.Category.NaturalTransformation
|
||||||
open import Cat.Category.Monad
|
open import Cat.Category.Monad
|
||||||
|
import Cat.Category.Monad.Monoidal as Monoidal
|
||||||
|
import Cat.Category.Monad.Kleisli as Kleisli
|
||||||
open import Cat.Categories.Fun
|
open import Cat.Categories.Fun
|
||||||
open import Cat.Equivalence
|
open import Cat.Equivalence
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue