{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Comonad.Env.Class
-- Copyright   :  (C) 2008-2015 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.Env.Class
  ( ComonadEnv(..)
  , asks
  ) where

import Control.Comonad
import Control.Comonad.Trans.Class
import qualified Control.Comonad.Trans.Env as Env
import Control.Comonad.Trans.Store
import Control.Comonad.Trans.Traced
import Control.Comonad.Trans.Identity
import Data.Semigroup

class Comonad w => ComonadEnv e w | w -> e where
  ask :: w a -> e

asks :: ComonadEnv e w => (e -> e') -> w a -> e'
asks :: forall e (w :: * -> *) e' a.
ComonadEnv e w =>
(e -> e') -> w a -> e'
asks e -> e'
f w a
wa = e -> e'
f (w a -> e
forall a. w a -> e
forall e (w :: * -> *) a. ComonadEnv e w => w a -> e
ask w a
wa)
{-# INLINE asks #-}

instance Comonad w => ComonadEnv e (Env.EnvT e w) where
  ask :: forall a. EnvT e w a -> e
ask = EnvT e w a -> e
forall e (w :: * -> *) a. EnvT e w a -> e
Env.ask

instance ComonadEnv e ((,)e) where
  ask :: forall a. (e, a) -> e
ask = (e, a) -> e
forall e a. (e, a) -> e
fst

instance ComonadEnv e (Arg e) where
  ask :: forall a. Arg e a -> e
ask (Arg e
e a
_) = e
e

lowerAsk :: (ComonadEnv e w, ComonadTrans t) => t w a -> e
lowerAsk :: forall e (w :: * -> *) (t :: (* -> *) -> * -> *) a.
(ComonadEnv e w, ComonadTrans t) =>
t w a -> e
lowerAsk = w a -> e
forall a. w a -> e
forall e (w :: * -> *) a. ComonadEnv e w => w a -> e
ask (w a -> e) -> (t w a -> w a) -> t w a -> e
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 lowerAsk #-}

instance ComonadEnv e w => ComonadEnv e (StoreT t w) where
  ask :: forall a. StoreT t w a -> e
ask = StoreT t w a -> e
forall e (w :: * -> *) (t :: (* -> *) -> * -> *) a.
(ComonadEnv e w, ComonadTrans t) =>
t w a -> e
lowerAsk

instance ComonadEnv e w => ComonadEnv e (IdentityT w) where
  ask :: forall a. IdentityT w a -> e
ask = IdentityT w a -> e
forall e (w :: * -> *) (t :: (* -> *) -> * -> *) a.
(ComonadEnv e w, ComonadTrans t) =>
t w a -> e
lowerAsk

instance (ComonadEnv e w, Monoid m) => ComonadEnv e (TracedT m w) where
  ask :: forall a. TracedT m w a -> e
ask = TracedT m w a -> e
forall e (w :: * -> *) (t :: (* -> *) -> * -> *) a.
(ComonadEnv e w, ComonadTrans t) =>
t w a -> e
lowerAsk