Skip to content

Commit

Permalink
Add remaining instances for Comonad transformers (#145)
Browse files Browse the repository at this point in the history
  • Loading branch information
skeate authored Jun 26, 2024
1 parent be72ab5 commit e201457
Show file tree
Hide file tree
Showing 5 changed files with 54 additions and 3 deletions.
1 change: 1 addition & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@ Notable changes to this project are documented in this file. The format is based
Breaking changes:

New features:
- Add `ComonadAsk`, `ComonadEnv`, and `ComonadTraced` instances for `StoreT`, `EnvT`, and `TracedT` (#145 by @skeate)

Bugfixes:

Expand Down
18 changes: 17 additions & 1 deletion src/Control/Comonad/Env/Class.purs
Original file line number Diff line number Diff line change
Expand Up @@ -2,9 +2,13 @@

module Control.Comonad.Env.Class where

import Prelude

import Control.Comonad (class Comonad)
import Control.Comonad.Env.Trans (EnvT(..))

import Control.Comonad.Store (StoreT(..))
import Control.Comonad.Traced.Trans (TracedT(..))
import Control.Comonad.Trans.Class (lower)
import Data.Tuple (Tuple(..), fst)

-- | The `ComonadEnv` type class represents those comonads which support a
Expand Down Expand Up @@ -44,3 +48,15 @@ instance comonadAskEnvT :: Comonad w => ComonadAsk e (EnvT e w) where
instance comonadEnvEnvT :: Comonad w => ComonadEnv e (EnvT e w) where
local f (EnvT x) = EnvT case x of
Tuple y z -> Tuple (f y) z

instance comonadAskTracedT :: (ComonadAsk e w, Monoid t) => ComonadAsk e (TracedT t w) where
ask = ask <<< lower

instance comonadEnvTracedT :: (ComonadEnv e w, Monoid t) => ComonadEnv e (TracedT t w) where
local f (TracedT w) = TracedT (local f w)

instance comonadAskStoreT :: ComonadAsk e w => ComonadAsk e (StoreT s w) where
ask = ask <<< lower

instance comonadEnvStoreT :: ComonadEnv e w => ComonadEnv e (StoreT s w) where
local f (StoreT (Tuple w s)) = StoreT (Tuple (local f w) s)
25 changes: 24 additions & 1 deletion src/Control/Comonad/Traced/Class.purs
Original file line number Diff line number Diff line change
@@ -1,11 +1,22 @@
-- | This module defines the `ComonadTraced` type class and its instances.

module Control.Comonad.Traced.Class where
module Control.Comonad.Traced.Class
( class ComonadTraced
, track
, tracks
, listen
, listens
, censor
) where

import Prelude

import Control.Comonad (class Comonad, extract)
import Control.Comonad.Env (EnvT)
import Control.Comonad.Store (StoreT)
import Control.Comonad.Traced.Trans (TracedT(..))
import Control.Comonad.Trans.Class (class ComonadTrans, lower)
import Control.Monad.Identity.Trans (IdentityT)
import Data.Tuple (Tuple(..))

-- | The `ComonadTraced` type class represents those monads which support relative (monoidal)
Expand Down Expand Up @@ -47,3 +58,15 @@ censor f (TracedT tr) = TracedT ((f >>> _) <$> tr)

instance comonadTracedTracedT :: (Comonad w, Monoid t) => ComonadTraced t (TracedT t w) where
track t (TracedT tr) = extract tr t

lowerTrack :: forall t m w a. ComonadTrans t => ComonadTraced m w => m -> t w a -> a
lowerTrack m = track m <<< lower

instance comonadTracedIdentityT :: ComonadTraced t w => ComonadTraced t (IdentityT w) where
track = lowerTrack

instance comonadTracedEnvT :: ComonadTraced t w => ComonadTraced t (EnvT e w) where
track = lowerTrack

instance comonadTracedStoreT :: ComonadTraced t w => ComonadTraced t (StoreT s w) where
track = lowerTrack
4 changes: 4 additions & 0 deletions src/Control/Comonad/Trans/Class.purs
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
module Control.Comonad.Trans.Class where

import Control.Comonad (class Comonad)
import Control.Monad.Identity.Trans (IdentityT, runIdentityT)

-- | The `ComonadTrans` type class represents _comonad transformers_.
-- |
Expand All @@ -21,3 +22,6 @@ import Control.Comonad (class Comonad)
-- | - `lower (extend w (f <<< lower)) = extend (lower w) f`
class ComonadTrans f where
lower :: forall w a. Comonad w => f w a -> w a

instance comonadTransIdentityT :: ComonadTrans IdentityT where
lower = runIdentityT
9 changes: 8 additions & 1 deletion src/Control/Monad/Identity/Trans.purs
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@ import Prelude

import Control.Alt (class Alt)
import Control.Alternative (class Alternative)
import Control.Comonad (class Comonad, class Extend, extend, extract)
import Control.Monad.Cont.Class (class MonadCont)
import Control.Monad.Error.Class (class MonadError, class MonadThrow)
import Control.Monad.Reader.Class (class MonadAsk, class MonadReader)
Expand All @@ -15,9 +16,9 @@ import Control.MonadPlus (class MonadPlus)
import Control.Plus (class Plus)
import Data.Eq (class Eq1)
import Data.Foldable (class Foldable)
import Data.Traversable (class Traversable)
import Data.Newtype (class Newtype)
import Data.Ord (class Ord1)
import Data.Traversable (class Traversable)
import Effect.Class (class MonadEffect)

-- | The `IdentityT` monad transformer.
Expand Down Expand Up @@ -67,3 +68,9 @@ derive newtype instance monadTellIdentityT :: MonadTell w m => MonadTell w (Iden
derive newtype instance monadWriterIdentityT :: MonadWriter w m => MonadWriter w (IdentityT m)
derive newtype instance foldableIdentityT :: Foldable m => Foldable (IdentityT m)
derive newtype instance traversableIdentityT :: Traversable m => Traversable (IdentityT m)

instance extendIdentityI :: Extend w => Extend (IdentityT w) where
extend f (IdentityT m) = IdentityT (extend (f <<< IdentityT) m)

instance comonadIdentityT :: Comonad w => Comonad (IdentityT w) where
extract = extract <<< runIdentityT

0 comments on commit e201457

Please sign in to comment.