1{-# LANGUAGE CPP #-}
2{-# LANGUAGE MultiParamTypeClasses #-}
3{-# LANGUAGE FunctionalDependencies #-}
4{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE UndecidableInstances #-}
6#if __GLASGOW_HASKELL__ >= 704
7{-# LANGUAGE Safe #-}
8#elif __GLASGOW_HASKELL__ >= 702
9{-# LANGUAGE Trustworthy #-}
10#endif
11-----------------------------------------------------------------------------
12-- |
13-- Module      :  Control.Comonad.Traced.Class
14-- Copyright   :  (C) 2008-2012 Edward Kmett
15-- License     :  BSD-style (see the file LICENSE)
16--
17-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
18-- Stability   :  experimental
19-- Portability :  non-portable (fundeps, MPTCs)
20----------------------------------------------------------------------------
21module Control.Comonad.Traced.Class
22  ( ComonadTraced(..)
23  , traces
24  ) where
25
26import Control.Comonad
27import Control.Comonad.Trans.Class
28import Control.Comonad.Trans.Env
29import Control.Comonad.Trans.Store
30import qualified Control.Comonad.Trans.Traced as Traced
31import Control.Comonad.Trans.Identity
32#if __GLASGOW_HASKELL__ < 710
33import Data.Semigroup
34#endif
35
36class Comonad w => ComonadTraced m w | w -> m where
37  trace :: m -> w a -> a
38
39traces :: ComonadTraced m w => (a -> m) -> w a -> a
40traces f wa = trace (f (extract wa)) wa
41{-# INLINE traces #-}
42
43instance (Comonad w, Monoid m) => ComonadTraced m (Traced.TracedT m w) where
44  trace = Traced.trace
45
46instance Monoid m => ComonadTraced m ((->) m) where
47  trace m f = f m
48
49lowerTrace :: (ComonadTrans t, ComonadTraced m w) => m -> t w a -> a
50lowerTrace m = trace m . lower
51{-# INLINE lowerTrace #-}
52
53-- All of these require UndecidableInstances because they do not satisfy the coverage condition
54
55instance ComonadTraced m w => ComonadTraced m (IdentityT w) where
56  trace = lowerTrace
57
58instance ComonadTraced m w => ComonadTraced m (EnvT e w) where
59  trace = lowerTrace
60
61instance ComonadTraced m w => ComonadTraced m (StoreT s w) where
62  trace = lowerTrace
63