Naming
This commit is contained in:
parent
9173468b03
commit
4de27aa06c
|
@ -114,7 +114,7 @@ module Monoidal {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
|
|
||||||
record Monad : Set ℓ where
|
record Monad : Set ℓ where
|
||||||
field
|
field
|
||||||
raw : RawMonad
|
raw : RawMonad
|
||||||
isMonad : IsMonad raw
|
isMonad : IsMonad raw
|
||||||
open IsMonad isMonad public
|
open IsMonad isMonad public
|
||||||
|
|
||||||
|
@ -131,6 +131,7 @@ module Monoidal {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
yX = y {X}
|
yX = y {X}
|
||||||
e1 = Category.arrowsAreSets ℂ _ _ (proj₁ xX) (proj₁ yX)
|
e1 = Category.arrowsAreSets ℂ _ _ (proj₁ xX) (proj₁ yX)
|
||||||
e2 = Category.arrowsAreSets ℂ _ _ (proj₂ xX) (proj₂ yX)
|
e2 = Category.arrowsAreSets ℂ _ _ (proj₂ xX) (proj₂ yX)
|
||||||
|
|
||||||
open IsMonad
|
open IsMonad
|
||||||
propIsMonad : (raw : _) → isProp (IsMonad raw)
|
propIsMonad : (raw : _) → isProp (IsMonad raw)
|
||||||
IsMonad.isAssociative (propIsMonad raw a b i) j
|
IsMonad.isAssociative (propIsMonad raw a b i) j
|
||||||
|
@ -141,8 +142,9 @@ module Monoidal {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
(isInverse a) (isInverse b) i
|
(isInverse a) (isInverse b) i
|
||||||
|
|
||||||
module _ {m n : Monad} (eq : Monad.raw m ≡ Monad.raw n) where
|
module _ {m n : Monad} (eq : Monad.raw m ≡ Monad.raw n) where
|
||||||
eqIsMonad : (λ i → IsMonad (eq i)) [ Monad.isMonad m ≡ Monad.isMonad n ]
|
private
|
||||||
eqIsMonad = lemPropF propIsMonad eq
|
eqIsMonad : (λ i → IsMonad (eq i)) [ Monad.isMonad m ≡ Monad.isMonad n ]
|
||||||
|
eqIsMonad = lemPropF propIsMonad eq
|
||||||
|
|
||||||
Monad≡ : m ≡ n
|
Monad≡ : m ≡ n
|
||||||
Monad.raw (Monad≡ i) = eq i
|
Monad.raw (Monad≡ i) = eq i
|
||||||
|
@ -161,23 +163,22 @@ module Kleisli {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
-- are not generally types.
|
-- are not generally types.
|
||||||
record RawMonad : Set ℓ where
|
record RawMonad : Set ℓ where
|
||||||
field
|
field
|
||||||
Romap : Object → Object
|
omap : Object → Object
|
||||||
-- Note name-change from [voe]
|
pure : {X : Object} → ℂ [ X , omap X ]
|
||||||
pure : {X : Object} → ℂ [ X , Romap X ]
|
bind : {X Y : Object} → ℂ [ X , omap Y ] → ℂ [ omap X , omap Y ]
|
||||||
bind : {X Y : Object} → ℂ [ X , Romap Y ] → ℂ [ Romap X , Romap Y ]
|
|
||||||
|
|
||||||
-- | functor map
|
-- | functor map
|
||||||
--
|
--
|
||||||
-- This should perhaps be defined in a "Klesli-version" of functors as well?
|
-- This should perhaps be defined in a "Klesli-version" of functors as well?
|
||||||
fmap : ∀ {A B} → ℂ [ A , B ] → ℂ [ Romap A , Romap B ]
|
fmap : ∀ {A B} → ℂ [ A , B ] → ℂ [ omap A , omap B ]
|
||||||
fmap f = bind (pure ∘ f)
|
fmap f = bind (pure ∘ f)
|
||||||
|
|
||||||
-- | Composition of monads aka. the kleisli-arrow.
|
-- | Composition of monads aka. the kleisli-arrow.
|
||||||
_>=>_ : {A B C : Object} → ℂ [ A , Romap B ] → ℂ [ B , Romap C ] → ℂ [ A , Romap C ]
|
_>=>_ : {A B C : Object} → ℂ [ A , omap B ] → ℂ [ B , omap C ] → ℂ [ A , omap C ]
|
||||||
f >=> g = f >>> (bind g)
|
f >=> g = f >>> (bind g)
|
||||||
|
|
||||||
-- | Flattening nested monads.
|
-- | Flattening nested monads.
|
||||||
join : {A : Object} → ℂ [ Romap (Romap A) , Romap A ]
|
join : {A : Object} → ℂ [ omap (omap A) , omap A ]
|
||||||
join = bind 𝟙
|
join = bind 𝟙
|
||||||
|
|
||||||
------------------
|
------------------
|
||||||
|
@ -187,10 +188,10 @@ module Kleisli {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
-- There may be better names than what I've chosen here.
|
-- There may be better names than what I've chosen here.
|
||||||
|
|
||||||
IsIdentity = {X : Object}
|
IsIdentity = {X : Object}
|
||||||
→ bind pure ≡ 𝟙 {Romap X}
|
→ bind pure ≡ 𝟙 {omap X}
|
||||||
IsNatural = {X Y : Object} (f : ℂ [ X , Romap Y ])
|
IsNatural = {X Y : Object} (f : ℂ [ X , omap Y ])
|
||||||
→ pure >>> (bind f) ≡ f
|
→ pure >>> (bind f) ≡ f
|
||||||
IsDistributive = {X Y Z : Object} (g : ℂ [ Y , Romap Z ]) (f : ℂ [ X , Romap Y ])
|
IsDistributive = {X Y Z : Object} (g : ℂ [ Y , omap Z ]) (f : ℂ [ X , omap Y ])
|
||||||
→ (bind f) >>> (bind g) ≡ bind (f >=> g)
|
→ (bind f) >>> (bind g) ≡ bind (f >=> g)
|
||||||
|
|
||||||
-- | Functor map fusion.
|
-- | Functor map fusion.
|
||||||
|
@ -218,23 +219,22 @@ module Kleisli {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
fusion : Fusion
|
fusion : Fusion
|
||||||
fusion {g = g} {f} = begin
|
fusion {g = g} {f} = begin
|
||||||
fmap (g ∘ f) ≡⟨⟩
|
fmap (g ∘ f) ≡⟨⟩
|
||||||
bind ((f >>> g) >>> pure) ≡⟨ cong bind isAssociative ⟩
|
bind ((f >>> g) >>> pure) ≡⟨ cong bind ℂ.isAssociative ⟩
|
||||||
bind (f >>> (g >>> pure)) ≡⟨ cong (λ φ → bind (f >>> φ)) (sym (isNatural _)) ⟩
|
bind (f >>> (g >>> pure)) ≡⟨ cong (λ φ → bind (f >>> φ)) (sym (isNatural _)) ⟩
|
||||||
bind (f >>> (pure >>> (bind (g >>> pure)))) ≡⟨⟩
|
bind (f >>> (pure >>> (bind (g >>> pure)))) ≡⟨⟩
|
||||||
bind (f >>> (pure >>> fmap g)) ≡⟨⟩
|
bind (f >>> (pure >>> fmap g)) ≡⟨⟩
|
||||||
bind ((fmap g ∘ pure) ∘ f) ≡⟨ cong bind (sym isAssociative) ⟩
|
bind ((fmap g ∘ pure) ∘ f) ≡⟨ cong bind (sym ℂ.isAssociative) ⟩
|
||||||
bind (fmap g ∘ (pure ∘ f)) ≡⟨ sym lem ⟩
|
bind (fmap g ∘ (pure ∘ f)) ≡⟨ sym distrib ⟩
|
||||||
bind (pure ∘ g) ∘ bind (pure ∘ f) ≡⟨⟩
|
bind (pure ∘ g) ∘ bind (pure ∘ f) ≡⟨⟩
|
||||||
fmap g ∘ fmap f ∎
|
fmap g ∘ fmap f ∎
|
||||||
where
|
where
|
||||||
open Category ℂ using (isAssociative)
|
distrib : fmap g ∘ fmap f ≡ bind (fmap g ∘ (pure ∘ f))
|
||||||
lem : fmap g ∘ fmap f ≡ bind (fmap g ∘ (pure ∘ f))
|
distrib = isDistributive (pure ∘ g) (pure ∘ f)
|
||||||
lem = isDistributive (pure ∘ g) (pure ∘ f)
|
|
||||||
|
|
||||||
-- | This formulation gives rise to the following endo-functor.
|
-- | This formulation gives rise to the following endo-functor.
|
||||||
private
|
private
|
||||||
rawR : RawFunctor ℂ ℂ
|
rawR : RawFunctor ℂ ℂ
|
||||||
RawFunctor.func* rawR = Romap
|
RawFunctor.func* rawR = omap
|
||||||
RawFunctor.func→ rawR = fmap
|
RawFunctor.func→ rawR = fmap
|
||||||
|
|
||||||
isFunctorR : IsFunctor ℂ ℂ rawR
|
isFunctorR : IsFunctor ℂ ℂ rawR
|
||||||
|
@ -302,7 +302,6 @@ module Kleisli {ℓa ℓb : Level} (ℂ : Category ℓa ℓb) where
|
||||||
bind 𝟙 >>> R.func→ f ≡⟨⟩
|
bind 𝟙 >>> R.func→ f ≡⟨⟩
|
||||||
R.func→ f ∘ bind 𝟙 ≡⟨⟩
|
R.func→ f ∘ bind 𝟙 ≡⟨⟩
|
||||||
R.func→ f ∘ join ∎
|
R.func→ f ∘ join ∎
|
||||||
where
|
|
||||||
|
|
||||||
pureNT : NaturalTransformation R⁰ R
|
pureNT : NaturalTransformation R⁰ R
|
||||||
proj₁ pureNT = pureT
|
proj₁ pureNT = pureT
|
||||||
|
@ -400,7 +399,7 @@ module _ {ℓa ℓb : Level} {ℂ : Category ℓa ℓb} where
|
||||||
open M.RawMonad m
|
open M.RawMonad m
|
||||||
|
|
||||||
forthRaw : K.RawMonad
|
forthRaw : K.RawMonad
|
||||||
K.RawMonad.Romap forthRaw = Romap
|
K.RawMonad.omap forthRaw = Romap
|
||||||
K.RawMonad.pure forthRaw = pureT _
|
K.RawMonad.pure forthRaw = pureT _
|
||||||
K.RawMonad.bind forthRaw = bind
|
K.RawMonad.bind forthRaw = bind
|
||||||
|
|
||||||
|
@ -469,7 +468,7 @@ module _ {ℓa ℓb : Level} {ℂ : Category ℓa ℓb} where
|
||||||
bind ∎
|
bind ∎
|
||||||
where
|
where
|
||||||
joinT = proj₁ joinNT
|
joinT = proj₁ joinNT
|
||||||
lem : (f : Arrow X (Romap Y)) → bind (f >>> pure) >>> bind 𝟙 ≡ bind f
|
lem : (f : Arrow X (omap Y)) → bind (f >>> pure) >>> bind 𝟙 ≡ bind f
|
||||||
lem f = begin
|
lem f = begin
|
||||||
bind (f >>> pure) >>> bind 𝟙
|
bind (f >>> pure) >>> bind 𝟙
|
||||||
≡⟨ isDistributive _ _ ⟩
|
≡⟨ isDistributive _ _ ⟩
|
||||||
|
@ -485,7 +484,7 @@ module _ {ℓa ℓb : Level} {ℂ : Category ℓa ℓb} where
|
||||||
x & f = f x
|
x & f = f x
|
||||||
|
|
||||||
forthRawEq : forthRaw (backRaw m) ≡ K.Monad.raw m
|
forthRawEq : forthRaw (backRaw m) ≡ K.Monad.raw m
|
||||||
K.RawMonad.Romap (forthRawEq _) = Romap
|
K.RawMonad.omap (forthRawEq _) = omap
|
||||||
K.RawMonad.pure (forthRawEq _) = pure
|
K.RawMonad.pure (forthRawEq _) = pure
|
||||||
-- stuck
|
-- stuck
|
||||||
K.RawMonad.bind (forthRawEq i) = bindEq i
|
K.RawMonad.bind (forthRawEq i) = bindEq i
|
||||||
|
|
Loading…
Reference in a new issue