{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 707
{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-}
#endif
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
module Control.Comonad.Trans.Traced
(
Traced
, traced
, runTraced
, TracedT(..)
, trace
, listen
, listens
, censor
) where
import Control.Applicative
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 707
import Control.Monad.Instances ()
#endif
import Control.Monad (ap)
import Control.Comonad
import Control.Comonad.Hoist.Class
import Control.Comonad.Trans.Class
import Data.Distributive
import Data.Functor.Identity
import Data.Semigroup
import Data.Typeable
type Traced m = TracedT m Identity
traced :: (m -> a) -> Traced m a
traced f = TracedT (Identity f)
runTraced :: Traced m a -> m -> a
runTraced (TracedT (Identity f)) = f
newtype TracedT m w a = TracedT { runTracedT :: w (m -> a) }
instance Functor w => Functor (TracedT m w) where
fmap g = TracedT . fmap (g .) . runTracedT
instance (ComonadApply w, Monoid m) => ComonadApply (TracedT m w) where
TracedT wf <@> TracedT wa = TracedT (ap <$> wf <@> wa)
instance Applicative w => Applicative (TracedT m w) where
pure = TracedT . pure . const
TracedT wf <*> TracedT wa = TracedT (ap <$> wf <*> wa)
instance (Comonad w, Monoid m) => Comonad (TracedT m w) where
extend f = TracedT . extend (\wf m -> f (TracedT (fmap (. mappend m) wf))) . runTracedT
extract (TracedT wf) = extract wf mempty
instance Monoid m => ComonadTrans (TracedT m) where
lower = fmap ($ mempty) . runTracedT
instance Monoid m => ComonadHoist (TracedT m) where
cohoist l = TracedT . l . runTracedT
instance Distributive w => Distributive (TracedT m w) where
distribute = TracedT . fmap (\tma m -> fmap ($ m) tma) . collect runTracedT
trace :: Comonad w => m -> TracedT m w a -> a
trace m (TracedT wf) = extract wf m
listen :: Functor w => TracedT m w a -> TracedT m w (a, m)
listen = TracedT . fmap (\f m -> (f m, m)) . runTracedT
listens :: Functor w => (m -> b) -> TracedT m w a -> TracedT m w (a, b)
listens g = TracedT . fmap (\f m -> (f m, g m)) . runTracedT
censor :: Functor w => (m -> m) -> TracedT m w a -> TracedT m w a
censor g = TracedT . fmap (. g) . runTracedT
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__ >= 707
deriving instance Typeable TracedT
#else
instance (Typeable s, Typeable1 w) => Typeable1 (TracedT s w) where
typeOf1 dswa = mkTyConApp tracedTTyCon [typeOf (s dswa), typeOf1 (w dswa)]
where
s :: TracedT s w a -> s
s = undefined
w :: TracedT s w a -> w a
w = undefined
tracedTTyCon :: TyCon
#if __GLASGOW_HASKELL__ < 704
tracedTTyCon = mkTyCon "Control.Comonad.Trans.Traced.TracedT"
#else
tracedTTyCon = mkTyCon3 "comonad-transformers" "Control.Comonad.Trans.Traced" "TracedT"
#endif
{-# NOINLINE tracedTTyCon #-}
#endif
#endif