diff --git a/CHANGELOG.md b/CHANGELOG.md index 46eae12c..caba2d81 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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: diff --git a/src/Control/Comonad/Env/Class.purs b/src/Control/Comonad/Env/Class.purs index 4ce00b2b..f033ada5 100644 --- a/src/Control/Comonad/Env/Class.purs +++ b/src/Control/Comonad/Env/Class.purs @@ -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 @@ -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) diff --git a/src/Control/Comonad/Traced/Class.purs b/src/Control/Comonad/Traced/Class.purs index 53691923..7819049c 100644 --- a/src/Control/Comonad/Traced/Class.purs +++ b/src/Control/Comonad/Traced/Class.purs @@ -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) @@ -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 diff --git a/src/Control/Comonad/Trans/Class.purs b/src/Control/Comonad/Trans/Class.purs index bb64693c..9709fff0 100644 --- a/src/Control/Comonad/Trans/Class.purs +++ b/src/Control/Comonad/Trans/Class.purs @@ -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_. -- | @@ -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 diff --git a/src/Control/Monad/Identity/Trans.purs b/src/Control/Monad/Identity/Trans.purs index 4dcc9d5d..e7ba6f07 100644 --- a/src/Control/Monad/Identity/Trans.purs +++ b/src/Control/Monad/Identity/Trans.purs @@ -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) @@ -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. @@ -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