Provide \zeta

This commit is contained in:
Frederik Hanghøj Iversen 2018-02-28 19:31:53 +01:00
parent f2b1a36a75
commit 9d3b17245f

View file

@ -192,8 +192,8 @@ module Kleisli {a b : Level} ( : Category a b) where
-- | This formulation gives rise to the following endo-functor.
private
rawR : RawFunctor
RawFunctor.func* rawR = RR
RawFunctor.func→ rawR f = bind (pure f)
RawFunctor.func* rawR = RR
RawFunctor.func→ rawR = fmap
isFunctorR : IsFunctor rawR
IsFunctor.isIdentity isFunctorR = begin
@ -212,6 +212,38 @@ module Kleisli {a b : Level} ( : Category a b) where
Functor.raw R = rawR
Functor.isFunctor R = isFunctorR
private
open NaturalTransformation
R⁰ : EndoFunctor
R⁰ = F.identity
: EndoFunctor
= F[ R R ]
module R = Functor R
module R = Functor R⁰
module R² = Functor
ηTrans : Transformation R⁰ R
ηTrans A = pure
ηNatural : Natural R⁰ R ηTrans
ηNatural {A} {B} f = begin
ηTrans B R⁰.func→ f ≡⟨⟩
pure f ≡⟨ sym (isNatural _)
bind (pure f) pure ≡⟨⟩
fmap f pure ≡⟨⟩
R.func→ f ηTrans A
μTrans : Transformation R
μTrans = {!!}
μNatural : Natural R μTrans
μNatural = {!!}
ηNatTrans : NaturalTransformation R⁰ R
proj₁ ηNatTrans = ηTrans
proj₂ ηNatTrans = ηNatural
μNatTrans : NaturalTransformation R
proj₁ μNatTrans = μTrans
proj₂ μNatTrans = μNatural
record Monad : Set where
field
raw : RawMonad
@ -275,15 +307,6 @@ module _ {a b : Level} { : Category a b} where
open K.Monad m
open NaturalTransformation
: EndoFunctor
= F[ R R ]
ηNatTrans : NaturalTransformation F.identity R
ηNatTrans = {!!}
μNatTrans : NaturalTransformation R
μNatTrans = {!!}
module MR = M.RawMonad
backRaw : M.RawMonad
MR.R backRaw = R