{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Comonad.Traced.Class
-- Copyright   :  (C) 2008-2012 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable (fundeps, MPTCs)
----------------------------------------------------------------------------
module Control.Comonad.Traced.Class
  ( ComonadTraced(..)
  , traces
  ) where

import Control.Comonad
import Control.Comonad.Trans.Class
import Control.Comonad.Trans.Env
import Control.Comonad.Trans.Store
import qualified Control.Comonad.Trans.Traced as Traced
import Control.Comonad.Trans.Identity
#if __GLASGOW_HASKELL__ < 710
import Data.Semigroup
#endif

class Comonad w => ComonadTraced m w | w -> m where
  trace :: m -> w a -> a

traces :: ComonadTraced m w => (a -> m) -> w a -> a
traces :: forall m (w :: * -> *) a. ComonadTraced m w => (a -> m) -> w a -> a
traces a -> m
f w a
wa = m -> w a -> a
forall a. m -> w a -> a
forall m (w :: * -> *) a. ComonadTraced m w => m -> w a -> a
trace (a -> m
f (w a -> a
forall a. w a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract w a
wa)) w a
wa
{-# INLINE traces #-}

instance (Comonad w, Monoid m) => ComonadTraced m (Traced.TracedT m w) where
  trace :: forall a. m -> TracedT m w a -> a
trace = m -> TracedT m w a -> a
forall (w :: * -> *) m a. Comonad w => m -> TracedT m w a -> a
Traced.trace

instance Monoid m => ComonadTraced m ((->) m) where
  trace :: forall a. m -> (m -> a) -> a
trace m
m m -> a
f = m -> a
f m
m

lowerTrace :: (ComonadTrans t, ComonadTraced m w) => m -> t w a -> a
lowerTrace :: forall (t :: (* -> *) -> * -> *) m (w :: * -> *) a.
(ComonadTrans t, ComonadTraced m w) =>
m -> t w a -> a
lowerTrace m
m = m -> w a -> a
forall a. m -> w a -> a
forall m (w :: * -> *) a. ComonadTraced m w => m -> w a -> a
trace m
m (w a -> a) -> (t w a -> w a) -> t w a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t w a -> w a
forall (w :: * -> *) a. Comonad w => t w a -> w a
forall (t :: (* -> *) -> * -> *) (w :: * -> *) a.
(ComonadTrans t, Comonad w) =>
t w a -> w a
lower
{-# INLINE lowerTrace #-}

-- All of these require UndecidableInstances because they do not satisfy the coverage condition

instance ComonadTraced m w => ComonadTraced m (IdentityT w) where
  trace :: forall a. m -> IdentityT w a -> a
trace = m -> IdentityT w a -> a
forall (t :: (* -> *) -> * -> *) m (w :: * -> *) a.
(ComonadTrans t, ComonadTraced m w) =>
m -> t w a -> a
lowerTrace

instance ComonadTraced m w => ComonadTraced m (EnvT e w) where
  trace :: forall a. m -> EnvT e w a -> a
trace = m -> EnvT e w a -> a
forall (t :: (* -> *) -> * -> *) m (w :: * -> *) a.
(ComonadTrans t, ComonadTraced m w) =>
m -> t w a -> a
lowerTrace

instance ComonadTraced m w => ComonadTraced m (StoreT s w) where
  trace :: forall a. m -> StoreT s w a -> a
trace = m -> StoreT s w a -> a
forall (t :: (* -> *) -> * -> *) m (w :: * -> *) a.
(ComonadTrans t, ComonadTraced m w) =>
m -> t w a -> a
lowerTrace