{-# 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 <[email protected]>
-- 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 = forall s (w :: * -> *) a. ComonadStore s w => s -> w a -> a
peek (s -> s
f (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 = forall s (w :: * -> *) a. ComonadStore s w => s -> w a -> a
peek s
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate

  seeks :: (s -> s) -> w a -> w a
  seeks s -> s
f = forall s (w :: * -> *) a. ComonadStore s w => (s -> s) -> w a -> a
peeks s -> s
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s (w :: * -> *) a. ComonadStore s w => s -> w a -> a
`peek` w a
w) (s -> f s
f (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 = forall s (w :: * -> *) a. StoreT s w a -> s
Store.pos
  peek :: forall a. s -> StoreT s w a -> a
peek = 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 = 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 = 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 = 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 = 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 = forall s (w :: * -> *) a. ComonadStore s w => w a -> s
pos forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall s (w :: * -> *) a. ComonadStore s w => s -> w a -> a
peek s
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall s (w :: * -> *) (f :: * -> *) a.
(ComonadStore s w, Functor f) =>
(s -> f s) -> w a -> f a
experiment s -> f s
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (t :: (* -> *) -> * -> *) s (w :: * -> *) a.
(ComonadTrans t, ComonadStore s w) =>
t w a -> s
lowerPos
  peek :: forall a. s -> IdentityT w a -> a
peek = 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 = 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 = 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 = 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 = 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 = 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 = 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 = forall (t :: (* -> *) -> * -> *) s (w :: * -> *) (f :: * -> *) a.
(ComonadTrans t, ComonadStore s w, Functor f) =>
(s -> f s) -> t w a -> f a
lowerExperiment