{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 707
{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable, Safe #-}
#elif __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
#ifdef MIN_VERSION_indexed_traversable
{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Comonad.Trans.Traced
-- Copyright   :  (C) 2008-2014 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
-- The trace comonad builds up a result by prepending monoidal values to each
-- other.
--
-- This module specifies the traced comonad transformer (aka the cowriter or
-- exponential comonad transformer).
--
----------------------------------------------------------------------------
module Control.Comonad.Trans.Traced
  (
  -- * Traced comonad
    Traced
  , traced
  , runTraced
  -- * Traced comonad transformer
  , TracedT(..)
  -- * Operations
  , trace
  , listen
  , listens
  , censor
  ) where

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif

#if __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

#ifdef MIN_VERSION_distributive
import Data.Distributive
#endif

#ifdef MIN_VERSION_indexed_traversable
import Data.Functor.WithIndex
#endif

import Data.Functor.Identity

#if __GLASGOW_HASKELL__ < 710
import Data.Semigroup
#endif

import Data.Typeable


type Traced m = TracedT m Identity

traced :: (m -> a) -> Traced m a
traced :: forall m a. (m -> a) -> Traced m a
traced m -> a
f = forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
TracedT (forall a. a -> Identity a
Identity m -> a
f)

runTraced :: Traced m a -> m -> a
runTraced :: forall m a. Traced m a -> m -> a
runTraced (TracedT (Identity m -> a
f)) = m -> a
f

newtype TracedT m w a = TracedT { forall m (w :: * -> *) a. TracedT m w a -> w (m -> a)
runTracedT :: w (m -> a) }

instance Functor w => Functor (TracedT m w) where
  fmap :: forall a b. (a -> b) -> TracedT m w a -> TracedT m w b
fmap a -> b
g = forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
TracedT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b
g forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m (w :: * -> *) a. TracedT m w a -> w (m -> a)
runTracedT

instance (ComonadApply w, Monoid m) => ComonadApply (TracedT m w) where
  TracedT w (m -> a -> b)
wf <@> :: forall a b. TracedT m w (a -> b) -> TracedT m w a -> TracedT m w b
<@> TracedT w (m -> a)
wa = forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
TracedT (forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> w (m -> a -> b)
wf forall (w :: * -> *) a b.
ComonadApply w =>
w (a -> b) -> w a -> w b
<@> w (m -> a)
wa)

instance Applicative w => Applicative (TracedT m w) where
  pure :: forall a. a -> TracedT m w a
pure = forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
TracedT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
  TracedT w (m -> a -> b)
wf <*> :: forall a b. TracedT m w (a -> b) -> TracedT m w a -> TracedT m w b
<*> TracedT w (m -> a)
wa = forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
TracedT (forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> w (m -> a -> b)
wf forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> w (m -> a)
wa)

instance (Comonad w, Monoid m) => Comonad (TracedT m w) where
  extend :: forall a b. (TracedT m w a -> b) -> TracedT m w a -> TracedT m w b
extend TracedT m w a -> b
f = forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
TracedT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (\w (m -> a)
wf m
m -> TracedT m w a -> b
f (forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
TracedT (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => a -> a -> a
mappend m
m) w (m -> a)
wf))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m (w :: * -> *) a. TracedT m w a -> w (m -> a)
runTracedT
  extract :: forall a. TracedT m w a -> a
extract (TracedT w (m -> a)
wf) = forall (w :: * -> *) a. Comonad w => w a -> a
extract w (m -> a)
wf forall a. Monoid a => a
mempty

instance Monoid m => ComonadTrans (TracedT m) where
  lower :: forall (w :: * -> *) a. Comonad w => TracedT m w a -> w a
lower = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m (w :: * -> *) a. TracedT m w a -> w (m -> a)
runTracedT

instance ComonadHoist (TracedT m) where
  cohoist :: forall (w :: * -> *) (v :: * -> *) a.
(Comonad w, Comonad v) =>
(forall x. w x -> v x) -> TracedT m w a -> TracedT m v a
cohoist forall x. w x -> v x
l = forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
TracedT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. w x -> v x
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m (w :: * -> *) a. TracedT m w a -> w (m -> a)
runTracedT

#ifdef MIN_VERSION_distributive
instance Distributive w => Distributive (TracedT m w) where
  distribute :: forall (f :: * -> *) a.
Functor f =>
f (TracedT m w a) -> TracedT m w (f a)
distribute = forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
TracedT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\f (m -> a)
tma m
m -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ m
m) f (m -> a)
tma) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (g :: * -> *) (f :: * -> *) a b.
(Distributive g, Functor f) =>
(a -> g b) -> f a -> g (f b)
collect forall m (w :: * -> *) a. TracedT m w a -> w (m -> a)
runTracedT
#endif

#ifdef MIN_VERSION_indexed_traversable
instance FunctorWithIndex i w => FunctorWithIndex (s, i) (TracedT s w) where
  imap :: forall a b. ((s, i) -> a -> b) -> TracedT s w a -> TracedT s w b
imap (s, i) -> a -> b
f (TracedT w (s -> a)
w) = forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
TracedT forall a b. (a -> b) -> a -> b
$ forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (\i
k' s -> a
g s
k -> (s, i) -> a -> b
f (s
k, i
k') (s -> a
g s
k)) w (s -> a)
w
  {-# INLINE imap #-}
#endif

trace :: Comonad w => m -> TracedT m w a -> a
trace :: forall (w :: * -> *) m a. Comonad w => m -> TracedT m w a -> a
trace m
m (TracedT w (m -> a)
wf) = forall (w :: * -> *) a. Comonad w => w a -> a
extract w (m -> a)
wf m
m

listen :: Functor w => TracedT m w a -> TracedT m w (a, m)
listen :: forall (w :: * -> *) m a.
Functor w =>
TracedT m w a -> TracedT m w (a, m)
listen = forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
TracedT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\m -> a
f m
m -> (m -> a
f m
m, m
m)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m (w :: * -> *) a. TracedT m w a -> w (m -> a)
runTracedT

listens :: Functor w => (m -> b) -> TracedT m w a -> TracedT m w (a, b)
listens :: forall (w :: * -> *) m b a.
Functor w =>
(m -> b) -> TracedT m w a -> TracedT m w (a, b)
listens m -> b
g = forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
TracedT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\m -> a
f m
m -> (m -> a
f m
m, m -> b
g m
m)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m (w :: * -> *) a. TracedT m w a -> w (m -> a)
runTracedT

censor :: Functor w => (m -> m) -> TracedT m w a -> TracedT m w a
censor :: forall (w :: * -> *) m a.
Functor w =>
(m -> m) -> TracedT m w a -> TracedT m w a
censor m -> m
g = forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
TracedT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b c a. (b -> c) -> (a -> b) -> a -> c
. m -> m
g) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m (w :: * -> *) a. TracedT m w a -> w (m -> a)
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