{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Comonad.Store.Class -- Copyright : (C) 2008-2011 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable (fundeps, MPTCs) ---------------------------------------------------------------------------- module Control.Comonad.Store.Class ( ComonadStore(..) , lowerPos , lowerPeek ) where import Control.Comonad import Control.Comonad.Trans.Class import Control.Comonad.Trans.Env import qualified Control.Comonad.Trans.Store as Store import Control.Comonad.Trans.Traced import Control.Comonad.Trans.Identity import Data.Semigroup class Comonad w => ComonadStore s w | w -> s where pos :: w a -> s peek :: s -> w a -> a peeks :: (s -> s) -> w a -> a peeks f w = peek (f (pos w)) w seek :: s -> w a -> w a seek s = peek s . duplicate seeks :: (s -> s) -> w a -> w a seeks f = peeks f . duplicate instance Comonad w => ComonadStore s (Store.StoreT s w) where pos = Store.pos peek = Store.peek peeks = Store.peeks seek = Store.seek seeks = Store.seeks lowerPos :: (ComonadTrans t, ComonadStore s w) => t w a -> s lowerPos = pos . lower {-# INLINE lowerPos #-} lowerPeek :: (ComonadTrans t, ComonadStore s w) => s -> t w a -> a lowerPeek s = peek s . lower {-# INLINE lowerPeek #-} instance ComonadStore s w => ComonadStore s (IdentityT w) where pos = lowerPos peek = lowerPeek instance ComonadStore s w => ComonadStore s (EnvT e w) where pos = lowerPos peek = lowerPeek instance (ComonadStore s w, Semigroup m, Monoid m) => ComonadStore s (TracedT m w) where pos = lowerPos peek = lowerPeek