1{-# LANGUAGE MultiParamTypeClasses #-}
2{-# LANGUAGE FunctionalDependencies #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE UndecidableInstances #-}
5{-# LANGUAGE CPP #-}
6#if __GLASGOW_HASKELL__ >= 704
7{-# LANGUAGE Safe #-}
8#elif __GLASGOW_HASKELL__ >= 702
9{-# LANGUAGE Trustworthy #-}
10#endif
11-----------------------------------------------------------------------------
12-- |
13-- Module      :  Control.Comonad.Env.Class
14-- Copyright   :  (C) 2008-2015 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.Env.Class
22  ( ComonadEnv(..)
23  , asks
24  ) where
25
26import Control.Comonad
27import Control.Comonad.Trans.Class
28import qualified Control.Comonad.Trans.Env as Env
29import Control.Comonad.Trans.Store
30import Control.Comonad.Trans.Traced
31import Control.Comonad.Trans.Identity
32import Data.Semigroup
33
34class Comonad w => ComonadEnv e w | w -> e where
35  ask :: w a -> e
36
37asks :: ComonadEnv e w => (e -> e') -> w a -> e'
38asks f wa = f (ask wa)
39{-# INLINE asks #-}
40
41instance Comonad w => ComonadEnv e (Env.EnvT e w) where
42  ask = Env.ask
43
44instance ComonadEnv e ((,)e) where
45  ask = fst
46
47instance ComonadEnv e (Arg e) where
48  ask (Arg e _) = e
49
50lowerAsk :: (ComonadEnv e w, ComonadTrans t) => t w a -> e
51lowerAsk = ask . lower
52{-# INLINE lowerAsk #-}
53
54instance ComonadEnv e w => ComonadEnv e (StoreT t w) where
55  ask = lowerAsk
56
57instance ComonadEnv e w => ComonadEnv e (IdentityT w) where
58  ask = lowerAsk
59
60instance (ComonadEnv e w, Monoid m) => ComonadEnv e (TracedT m w) where
61  ask = lowerAsk
62