    {-# LANGUAGE CPP #-}
    {-# LANGUAGE Safe #-}
    {-# LANGUAGE StandaloneDeriving #-}
    #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

    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

    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 = Identity (m -> a) -> TracedT m Identity a
    forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
    TracedT ((m -> a) -> Identity (m -> a)
    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 = w (m -> b) -> TracedT m w b
    forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
    TracedT (w (m -> b) -> TracedT m w b)
    -> (TracedT m w a -> w (m -> b)) -> TracedT m w a -> TracedT m w b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((m -> a) -> m -> b) -> w (m -> a) -> w (m -> b)
    forall a b. (a -> b) -> w a -> w b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (a -> b
    g (a -> b) -> (m -> a) -> m -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .) (w (m -> a) -> w (m -> b))
    -> (TracedT m w a -> w (m -> a)) -> TracedT m w a -> w (m -> b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TracedT m w a -> w (m -> a)
    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 = w (m -> b) -> TracedT m w b
    forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
    TracedT ((m -> a -> b) -> (m -> a) -> m -> b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap ((m -> a -> b) -> (m -> a) -> m -> b)
    -> w (m -> a -> b) -> w ((m -> a) -> m -> b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> w (m -> a -> b)
    wf w ((m -> a) -> m -> b) -> w (m -> a) -> w (m -> b)
    forall a b. w (a -> b) -> w a -> w b
    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 = w (m -> a) -> TracedT m w a
    forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
    TracedT (w (m -> a) -> TracedT m w a)
    -> (a -> w (m -> a)) -> a -> TracedT m w a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (m -> a) -> w (m -> a)
    forall a. a -> w a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((m -> a) -> w (m -> a)) -> (a -> m -> a) -> a -> w (m -> a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> m -> a
    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 = w (m -> b) -> TracedT m w b
    forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
    TracedT ((m -> a -> b) -> (m -> a) -> m -> b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap ((m -> a -> b) -> (m -> a) -> m -> b)
    -> w (m -> a -> b) -> w ((m -> a) -> m -> b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> w (m -> a -> b)
    wf w ((m -> a) -> m -> b) -> w (m -> a) -> w (m -> b)
    forall a b. w (a -> b) -> w a -> w b
    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 = w (m -> b) -> TracedT m w b
    forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
    TracedT (w (m -> b) -> TracedT m w b)
    -> (TracedT m w a -> w (m -> b)) -> TracedT m w a -> TracedT m w b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (w (m -> a) -> m -> b) -> w (m -> a) -> w (m -> b)
    forall a b. (w a -> b) -> w a -> w b
    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 (w (m -> a) -> TracedT m w a
    forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
    TracedT (((m -> a) -> m -> a) -> w (m -> a) -> w (m -> a)
    forall a b. (a -> b) -> w a -> w b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((m -> a) -> (m -> m) -> m -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . m -> m -> m
    forall a. Monoid a => a -> a -> a
    mappend m
    m) w (m -> a)
    wf))) (w (m -> a) -> w (m -> b))
    -> (TracedT m w a -> w (m -> a)) -> TracedT m w a -> w (m -> b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TracedT m w a -> w (m -> a)
    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) = w (m -> a) -> m -> a
    forall a. w a -> a
    forall (w :: * -> *) a. Comonad w => w a -> a
    extract w (m -> a)
    wf m
    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 = ((m -> a) -> a) -> w (m -> a) -> w a
    forall a b. (a -> b) -> w a -> w b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((m -> a) -> m -> a
    forall a b. (a -> b) -> a -> b
    $ m
    forall a. Monoid a => a
    mempty) (w (m -> a) -> w a)
    -> (TracedT m w a -> w (m -> a)) -> TracedT m w a -> w a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TracedT m w a -> w (m -> a)
    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 = v (m -> a) -> TracedT m v a
    forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
    TracedT (v (m -> a) -> TracedT m v a)
    -> (TracedT m w a -> v (m -> a)) -> TracedT m w a -> TracedT m v a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . w (m -> a) -> v (m -> a)
    forall x. w x -> v x
    l (w (m -> a) -> v (m -> a))
    -> (TracedT m w a -> w (m -> a)) -> TracedT m w a -> v (m -> a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TracedT m w a -> w (m -> a)
    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 = w (m -> f a) -> TracedT m w (f a)
    forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
    TracedT (w (m -> f a) -> TracedT m w (f a))
    -> (f (TracedT m w a) -> w (m -> f a))
    -> f (TracedT m w a)
    -> TracedT m w (f a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (f (m -> a) -> m -> f a) -> w (f (m -> a)) -> w (m -> f a)
    forall a b. (a -> b) -> w a -> w b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\f (m -> a)
    tma m
    m -> ((m -> a) -> a) -> f (m -> a) -> f a
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((m -> a) -> m -> a
    forall a b. (a -> b) -> a -> b
    $ m
    m) f (m -> a)
    tma) (w (f (m -> a)) -> w (m -> f a))
    -> (f (TracedT m w a) -> w (f (m -> a)))
    -> f (TracedT m w a)
    -> w (m -> f a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TracedT m w a -> w (m -> a))
    -> f (TracedT m w a) -> w (f (m -> a))
    forall (g :: * -> *) (f :: * -> *) a b.
    (Distributive g, Functor f) =>
    (a -> g b) -> f a -> g (f b)
    forall (f :: * -> *) a b. Functor f => (a -> w b) -> f a -> w (f b)
    collect TracedT m w a -> w (m -> a)
    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) = w (s -> b) -> TracedT s w b
    forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
    TracedT (w (s -> b) -> TracedT s w b) -> w (s -> b) -> TracedT s w b
    forall a b. (a -> b) -> a -> b
    $ (i -> (s -> a) -> s -> b) -> w (s -> a) -> w (s -> b)
    forall a b. (i -> a -> b) -> w a -> w 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) = w (m -> a) -> m -> a
    forall a. w a -> a
    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 = w (m -> (a, m)) -> TracedT m w (a, m)
    forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
    TracedT (w (m -> (a, m)) -> TracedT m w (a, m))
    -> (TracedT m w a -> w (m -> (a, m)))
    -> TracedT m w a
    -> TracedT m w (a, m)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((m -> a) -> m -> (a, m)) -> w (m -> a) -> w (m -> (a, m))
    forall a b. (a -> b) -> w a -> w b
    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)) (w (m -> a) -> w (m -> (a, m)))
    -> (TracedT m w a -> w (m -> a))
    -> TracedT m w a
    -> w (m -> (a, m))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TracedT m w a -> w (m -> a)
    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 = w (m -> (a, b)) -> TracedT m w (a, b)
    forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
    TracedT (w (m -> (a, b)) -> TracedT m w (a, b))
    -> (TracedT m w a -> w (m -> (a, b)))
    -> TracedT m w a
    -> TracedT m w (a, b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((m -> a) -> m -> (a, b)) -> w (m -> a) -> w (m -> (a, b))
    forall a b. (a -> b) -> w a -> w b
    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)) (w (m -> a) -> w (m -> (a, b)))
    -> (TracedT m w a -> w (m -> a))
    -> TracedT m w a
    -> w (m -> (a, b))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TracedT m w a -> w (m -> a)
    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 = w (m -> a) -> TracedT m w a
    forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
    TracedT (w (m -> a) -> TracedT m w a)
    -> (TracedT m w a -> w (m -> a)) -> TracedT m w a -> TracedT m w a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((m -> a) -> m -> a) -> w (m -> a) -> w (m -> a)
    forall a b. (a -> b) -> w a -> w b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((m -> a) -> (m -> m) -> m -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . m -> m
    g) (w (m -> a) -> w (m -> a))
    -> (TracedT m w a -> w (m -> a)) -> TracedT m w a -> w (m -> a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TracedT m w a -> w (m -> a)
    forall m (w :: * -> *) a. TracedT m w a -> w (m -> a)
    runTracedT