{-# 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 <ekmett@gmail.com>
-- 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