Define goals in Kleisli

This commit is contained in:
Frederik Hanghøj Iversen 2018-03-01 14:58:01 +01:00
parent 64a0292755
commit ae46a48861

View file

@ -117,9 +117,8 @@ module Monoidal {a b : Level} ( : Category a b) where
module Kleisli {a b : Level} ( : Category a b) where module Kleisli {a b : Level} ( : Category a b) where
private private
= a b = a b
module = Category
module = Category open using (Arrow ; 𝟙 ; Object ; _∘_ ; _>>>_)
open using (Arrow ; 𝟙 ; Object ; _∘_ ; _>>>_)
-- | Data for a monad. -- | Data for a monad.
-- --
@ -166,6 +165,13 @@ module Kleisli {a b : Level} ( : Category a b) where
Fusion = {X Y Z : Object} {g : [ Y , Z ]} {f : [ X , Y ]} Fusion = {X Y Z : Object} {g : [ Y , Z ]} {f : [ X , Y ]}
fmap (g f) fmap g fmap f fmap (g f) fmap g fmap f
-- In the ("foreign") formulation of a monad `IsNatural`'s analogue here would be:
IsNaturalForeign : Set _
IsNaturalForeign = {X : Object} join {X} fmap join join join
IsInverse : Set _
IsInverse = {X : Object} join {X} pure 𝟙 × join {X} fmap pure 𝟙
record IsMonad (raw : RawMonad) : Set where record IsMonad (raw : RawMonad) : Set where
open RawMonad raw public open RawMonad raw public
field field
@ -271,6 +277,21 @@ module Kleisli {a b : Level} ( : Category a b) where
proj₁ μNatTrans = μTrans proj₁ μNatTrans = μTrans
proj₂ μNatTrans = μNatural proj₂ μNatTrans = μNatural
isNaturalForeign : IsNaturalForeign
isNaturalForeign = begin
join fmap join ≡⟨ {!!}
join join
isInverse : IsInverse
isInverse = inv-l , inv-r
where
inv-l = begin
join pure ≡⟨ {!!}
𝟙
inv-r = begin
join fmap pure ≡⟨ {!!}
𝟙
record Monad : Set where record Monad : Set where
field field
raw : RawMonad raw : RawMonad
@ -330,19 +351,37 @@ module _ {a b : Level} { : Category a b} where
Kleisli.Monad.isMonad (forth m) = forthIsMonad (M.Monad.isMonad m) Kleisli.Monad.isMonad (forth m) = forthIsMonad (M.Monad.isMonad m)
module _ (m : K.Monad) where module _ (m : K.Monad) where
open K.Monad m private
open K.Monad m
module MR = M.RawMonad
module MI = M.IsMonad
module MR = M.RawMonad
backRaw : M.RawMonad backRaw : M.RawMonad
MR.R backRaw = R MR.R backRaw = R
MR.ηNatTrans backRaw = ηNatTrans MR.ηNatTrans backRaw = ηNatTrans
MR.μNatTrans backRaw = μNatTrans MR.μNatTrans backRaw = μNatTrans
module MI = M.IsMonad private
-- also prove these in K.Monad! open MR backRaw
module R = Functor (MR.R backRaw)
backIsMonad : M.IsMonad backRaw backIsMonad : M.IsMonad backRaw
MI.isAssociative backIsMonad = {!isAssociative!} MI.isAssociative backIsMonad {X} = begin
MI.isInverse backIsMonad = {!!} μ X R.func→ (μ X) ≡⟨⟩
join fmap (μ X) ≡⟨⟩
join fmap join ≡⟨ isNaturalForeign
join join ≡⟨⟩
μ X μ (R.func* X)
MI.isInverse backIsMonad {X} = inv-l , inv-r
where
inv-l = begin
μ X η (R.func* X) ≡⟨⟩
join pure ≡⟨ proj₁ isInverse
𝟙
inv-r = begin
μ X R.func→ (η X) ≡⟨⟩
join fmap pure ≡⟨ proj₂ isInverse
𝟙
back : K.Monad M.Monad back : K.Monad M.Monad
Monoidal.Monad.raw (back m) = backRaw m Monoidal.Monad.raw (back m) = backRaw m