{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Comonad.Store.Class
-- Copyright   :  (C) 2008-2012 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
#if __GLASGOW_HASKELL__ < 710
import Data.Semigroup
#endif

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 s -> s
f w a
w = s -> w a -> a
forall a. s -> w a -> a
forall s (w :: * -> *) a. ComonadStore s w => s -> w a -> a
peek (s -> s
f (w a -> s
forall a. w a -> s
forall s (w :: * -> *) a. ComonadStore s w => w a -> s
pos w a
w)) w a
w

  seek :: s -> w a -> w a
  seek s
s = s -> w (w a) -> w a
forall a. s -> w a -> a
forall s (w :: * -> *) a. ComonadStore s w => s -> w a -> a
peek s
s (w (w a) -> w a) -> (w a -> w (w a)) -> w a -> w a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w a -> w (w a)
forall a. w a -> w (w a)
forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate

  seeks :: (s -> s) -> w a -> w a
  seeks s -> s
f = (s -> s) -> w (w a) -> w a
forall a. (s -> s) -> w a -> a
forall s (w :: * -> *) a. ComonadStore s w => (s -> s) -> w a -> a
peeks s -> s
f (w (w a) -> w a) -> (w a -> w (w a)) -> w a -> w a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w a -> w (w a)
forall a. w a -> w (w a)
forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate

  experiment :: Functor f => (s -> f s) -> w a -> f a
  experiment s -> f s
f w a
w = (s -> a) -> f s -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s -> w a -> a
forall a. s -> w a -> a
forall s (w :: * -> *) a. ComonadStore s w => s -> w a -> a
`peek` w a
w) (s -> f s
f (w a -> s
forall a. w a -> s
forall s (w :: * -> *) a. ComonadStore s w => w a -> s
pos w a
w))

instance Comonad w => ComonadStore s (Store.StoreT s w) where
  pos :: forall a. StoreT s w a -> s
pos = StoreT s w a -> s
forall s (w :: * -> *) a. StoreT s w a -> s
Store.pos
  peek :: forall a. s -> StoreT s w a -> a
peek = s -> StoreT s w a -> a
forall (w :: * -> *) s a. Comonad w => s -> StoreT s w a -> a
Store.peek
  peeks :: forall a. (s -> s) -> StoreT s w a -> a
peeks = (s -> s) -> StoreT s w a -> a
forall (w :: * -> *) s a.
Comonad w =>
(s -> s) -> StoreT s w a -> a
Store.peeks
  seek :: forall a. s -> StoreT s w a -> StoreT s w a
seek = s -> StoreT s w a -> StoreT s w a
forall s (w :: * -> *) a. s -> StoreT s w a -> StoreT s w a
Store.seek
  seeks :: forall a. (s -> s) -> StoreT s w a -> StoreT s w a
seeks = (s -> s) -> StoreT s w a -> StoreT s w a
forall s (w :: * -> *) a. (s -> s) -> StoreT s w a -> StoreT s w a
Store.seeks
  experiment :: forall (f :: * -> *) a.
Functor f =>
(s -> f s) -> StoreT s w a -> f a
experiment = (s -> f s) -> StoreT s w a -> f a
forall (w :: * -> *) (f :: * -> *) s a.
(Comonad w, Functor f) =>
(s -> f s) -> StoreT s w a -> f a
Store.experiment

lowerPos :: (ComonadTrans t, ComonadStore s w) => t w a -> s
lowerPos :: forall (t :: (* -> *) -> * -> *) s (w :: * -> *) a.
(ComonadTrans t, ComonadStore s w) =>
t w a -> s
lowerPos = w a -> s
forall a. w a -> s
forall s (w :: * -> *) a. ComonadStore s w => w a -> s
pos (w a -> s) -> (t w a -> w a) -> t w a -> s
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 lowerPos #-}

lowerPeek :: (ComonadTrans t, ComonadStore s w) => s -> t w a -> a
lowerPeek :: forall (t :: (* -> *) -> * -> *) s (w :: * -> *) a.
(ComonadTrans t, ComonadStore s w) =>
s -> t w a -> a
lowerPeek s
s = s -> w a -> a
forall a. s -> w a -> a
forall s (w :: * -> *) a. ComonadStore s w => s -> w a -> a
peek s
s (w a -> a) -> (t w a -> w a) -> t w a -> a
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 lowerPeek #-}

lowerExperiment :: (ComonadTrans t, ComonadStore s w, Functor f) => (s -> f s) -> t w a -> f a
lowerExperiment :: forall (t :: (* -> *) -> * -> *) s (w :: * -> *) (f :: * -> *) a.
(ComonadTrans t, ComonadStore s w, Functor f) =>
(s -> f s) -> t w a -> f a
lowerExperiment s -> f s
f = (s -> f s) -> w a -> f a
forall s (w :: * -> *) (f :: * -> *) a.
(ComonadStore s w, Functor f) =>
(s -> f s) -> w a -> f a
forall (f :: * -> *) a. Functor f => (s -> f s) -> w a -> f a
experiment s -> f s
f (w a -> f a) -> (t w a -> w a) -> t w a -> f a
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 lowerExperiment #-}

instance ComonadStore s w => ComonadStore s (IdentityT w) where
  pos :: forall a. IdentityT w a -> s
pos = IdentityT w a -> s
forall (t :: (* -> *) -> * -> *) s (w :: * -> *) a.
(ComonadTrans t, ComonadStore s w) =>
t w a -> s
lowerPos
  peek :: forall a. s -> IdentityT w a -> a
peek = s -> IdentityT w a -> a
forall (t :: (* -> *) -> * -> *) s (w :: * -> *) a.
(ComonadTrans t, ComonadStore s w) =>
s -> t w a -> a
lowerPeek
  experiment :: forall (f :: * -> *) a.
Functor f =>
(s -> f s) -> IdentityT w a -> f a
experiment = (s -> f s) -> IdentityT w a -> f a
forall (t :: (* -> *) -> * -> *) s (w :: * -> *) (f :: * -> *) a.
(ComonadTrans t, ComonadStore s w, Functor f) =>
(s -> f s) -> t w a -> f a
lowerExperiment

instance ComonadStore s w => ComonadStore s (EnvT e w) where
  pos :: forall a. EnvT e w a -> s
pos = EnvT e w a -> s
forall (t :: (* -> *) -> * -> *) s (w :: * -> *) a.
(ComonadTrans t, ComonadStore s w) =>
t w a -> s
lowerPos
  peek :: forall a. s -> EnvT e w a -> a
peek = s -> EnvT e w a -> a
forall (t :: (* -> *) -> * -> *) s (w :: * -> *) a.
(ComonadTrans t, ComonadStore s w) =>
s -> t w a -> a
lowerPeek
  experiment :: forall (f :: * -> *) a.
Functor f =>
(s -> f s) -> EnvT e w a -> f a
experiment = (s -> f s) -> EnvT e w a -> f a
forall (t :: (* -> *) -> * -> *) s (w :: * -> *) (f :: * -> *) a.
(ComonadTrans t, ComonadStore s w, Functor f) =>
(s -> f s) -> t w a -> f a
lowerExperiment

instance (ComonadStore s w, Monoid m) => ComonadStore s (TracedT m w) where
  pos :: forall a. TracedT m w a -> s
pos = TracedT m w a -> s
forall (t :: (* -> *) -> * -> *) s (w :: * -> *) a.
(ComonadTrans t, ComonadStore s w) =>
t w a -> s
lowerPos
  peek :: forall a. s -> TracedT m w a -> a
peek = s -> TracedT m w a -> a
forall (t :: (* -> *) -> * -> *) s (w :: * -> *) a.
(ComonadTrans t, ComonadStore s w) =>
s -> t w a -> a
lowerPeek
  experiment :: forall (f :: * -> *) a.
Functor f =>
(s -> f s) -> TracedT m w a -> f a
experiment = (s -> f s) -> TracedT m w a -> f a
forall (t :: (* -> *) -> * -> *) s (w :: * -> *) (f :: * -> *) a.
(ComonadTrans t, ComonadStore s w, Functor f) =>
(s -> f s) -> t w a -> f a
lowerExperiment