    {-# LANGUAGE CPP #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE TypeOperators #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE UndecidableInstances #-}
    ----------------------------------------------------------------------
    -- |
    -- Module      :  Control.Comonad.Representable.Store
    -- Copyright   :  (c) Edward Kmett & Sjoerd Visscher 2011
    -- License     :  BSD3
    --
    -- Maintainer  :  ekmett@gmail.com
    -- Stability   :  experimental
    --
    -- This is a generalized 'Store' 'Comonad', parameterized by a 'Representable' 'Functor'.
    -- The representation of that 'Functor' serves as the index of the store.
    --
    -- This can be useful if the representable functor serves to memoize its
    -- contents and will be inspected often.
    ----------------------------------------------------------------------
    module Control.Comonad.Representable.Store
       ( Store
       , store
       , runStore
       , StoreT(..)
       , storeT
       , runStoreT
       , ComonadStore(..)
       ) where

    import Control.Comonad
    import Control.Comonad.Cofree.Class
    import Control.Comonad.Env.Class
    import Control.Comonad.Hoist.Class
    import Control.Comonad.Store.Class
    import Control.Comonad.Traced.Class
    import Control.Comonad.Trans.Class
    import Control.Monad.Identity
    import Data.Functor.Apply
    import Data.Functor.Extend
    import Data.Functor.Rep
    #if !(MIN_VERSION_base(4,11,0))
    import Data.Semigroup
    #endif

    -- | A memoized store comonad parameterized by a representable functor @g@, where
    -- the representatation of @g@, @Rep g@ is the index of the store.
    --
    type Store g = StoreT g Identity

    -- | Construct a store comonad computation from a function and a current index.
    -- (The inverse of 'runStore'.)
    store :: Representable g
          => (Rep g -> a)  -- ^ computation
          -> Rep g         -- ^ index
          -> Store g a
    store :: forall (g :: * -> *) a.
    Representable g =>
    (Rep g -> a) -> Rep g -> Store g a
    store = Identity (Rep g -> a) -> Rep g -> Store g a
    forall (w :: * -> *) (g :: * -> *) a.
    (Functor w, Representable g) =>
    w (Rep g -> a) -> Rep g -> StoreT g w a
    storeT (Identity (Rep g -> a) -> Rep g -> Store g a)
    -> ((Rep g -> a) -> Identity (Rep g -> a))
    -> (Rep g -> a)
    -> Rep g
    -> Store g a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Rep g -> a) -> Identity (Rep g -> a)
    forall a. a -> Identity a
    Identity

    -- | Unwrap a store comonad computation as a function and a current index.
    -- (The inverse of 'store'.)
    runStore :: Representable g
             => Store g a           -- ^ a store to access
             -> (Rep g -> a, Rep g) -- ^ initial state
    runStore :: forall (g :: * -> *) a.
    Representable g =>
    Store g a -> (Rep g -> a, Rep g)
    runStore (StoreT (Identity g a
    ga) Rep g
    k) = (g a -> Rep g -> a
    forall a. g a -> Rep g -> a
    forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
    index g a
    ga, Rep g
    k)

    -- ---------------------------------------------------------------------------
    -- | A store transformer comonad parameterized by:
    --
    --   * @g@ - A representable functor used to memoize results for an index @Rep g@
    --
    --   * @w@ - The inner comonad.
    data StoreT g w a = StoreT (w (g a)) (Rep g)

    storeT :: (Functor w, Representable g) => w (Rep g -> a) -> Rep g -> StoreT g w a
    storeT :: forall (w :: * -> *) (g :: * -> *) a.
    (Functor w, Representable g) =>
    w (Rep g -> a) -> Rep g -> StoreT g w a
    storeT = w (g a) -> Rep g -> StoreT g w a
    forall (g :: * -> *) (w :: * -> *) a.
    w (g a) -> Rep g -> StoreT g w a
    StoreT (w (g a) -> Rep g -> StoreT g w a)
    -> (w (Rep g -> a) -> w (g a))
    -> w (Rep g -> a)
    -> Rep g
    -> StoreT g w a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Rep g -> a) -> g a) -> w (Rep g -> a) -> w (g a)
    forall a b. (a -> b) -> w a -> w b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Rep g -> a) -> g a
    forall a. (Rep g -> a) -> g a
    forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
    tabulate

    runStoreT :: (Functor w, Representable g) => StoreT g w a -> (w (Rep g -> a), Rep g)
    runStoreT :: forall (w :: * -> *) (g :: * -> *) a.
    (Functor w, Representable g) =>
    StoreT g w a -> (w (Rep g -> a), Rep g)
    runStoreT (StoreT w (g a)
    w Rep g
    s) = (g a -> Rep g -> a
    forall a. g a -> Rep g -> a
    forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
    index (g a -> Rep g -> a) -> w (g a) -> w (Rep g -> a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> w (g a)
    w, Rep g
    s)

    instance (Comonad w, Representable g, Rep g ~ s) => ComonadStore s (StoreT g w) where
      pos :: forall a. StoreT g w a -> s
    pos (StoreT w (g a)
    _ Rep g
    s) = s
    Rep g
    s
      peek :: forall a. s -> StoreT g w a -> a
    peek s
    s (StoreT w (g a)
    w Rep g
    _) = w (g a) -> g a
    forall a. w a -> a
    forall (w :: * -> *) a. Comonad w => w a -> a
    extract w (g a)
    w g a -> Rep g -> a
    forall a. g a -> Rep g -> a
    forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
    `index` s
    Rep g
    s
      peeks :: forall a. (s -> s) -> StoreT g w a -> a
    peeks s -> s
    f (StoreT w (g a)
    w Rep g
    s) = w (g a) -> g a
    forall a. w a -> a
    forall (w :: * -> *) a. Comonad w => w a -> a
    extract w (g a)
    w g a -> Rep g -> a
    forall a. g a -> Rep g -> a
    forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
    `index` s -> s
    f s
    Rep g
    s
      seek :: forall a. s -> StoreT g w a -> StoreT g w a
    seek s
    s (StoreT w (g a)
    w Rep g
    _) = w (g a) -> Rep g -> StoreT g w a
    forall (g :: * -> *) (w :: * -> *) a.
    w (g a) -> Rep g -> StoreT g w a
    StoreT w (g a)
    w s
    Rep g
    s
      seeks :: forall a. (s -> s) -> StoreT g w a -> StoreT g w a
    seeks s -> s
    f (StoreT w (g a)
    w Rep g
    s) = w (g a) -> Rep g -> StoreT g w a
    forall (g :: * -> *) (w :: * -> *) a.
    w (g a) -> Rep g -> StoreT g w a
    StoreT w (g a)
    w (s -> s
    f s
    Rep g
    s)

    instance (Functor w, Functor g) => Functor (StoreT g w) where
      fmap :: forall a b. (a -> b) -> StoreT g w a -> StoreT g w b
    fmap a -> b
    f (StoreT w (g a)
    w Rep g
    s) = w (g b) -> Rep g -> StoreT g w b
    forall (g :: * -> *) (w :: * -> *) a.
    w (g a) -> Rep g -> StoreT g w a
    StoreT ((g a -> g b) -> w (g a) -> w (g b)
    forall a b. (a -> b) -> w a -> w b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((a -> b) -> g a -> g b
    forall a b. (a -> b) -> g a -> g b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f) w (g a)
    w) Rep g
    s

    instance (Apply w, Semigroup (Rep g), Representable g) => Apply (StoreT g w) where
      StoreT w (g (a -> b))
    ff Rep g
    m <.> :: forall a b. StoreT g w (a -> b) -> StoreT g w a -> StoreT g w b
    <.> StoreT w (g a)
    fa Rep g
    n = w (g b) -> Rep g -> StoreT g w b
    forall (g :: * -> *) (w :: * -> *) a.
    w (g a) -> Rep g -> StoreT g w a
    StoreT (g (a -> b) -> g a -> g b
    forall (f :: * -> *) a b.
    Representable f =>
    f (a -> b) -> f a -> f b
    apRep (g (a -> b) -> g a -> g b) -> w (g (a -> b)) -> w (g a -> g b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> w (g (a -> b))
    ff w (g a -> g b) -> w (g a) -> w (g b)
    forall a b. w (a -> b) -> w a -> w b
    forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
    <.> w (g a)
    fa) (Rep g
    m Rep g -> Rep g -> Rep g
    forall a. Semigroup a => a -> a -> a
    <> Rep g
    n)

    instance (ComonadApply w, Semigroup (Rep g), Representable g) => ComonadApply (StoreT g w) where
      StoreT w (g (a -> b))
    ff Rep g
    m <@> :: forall a b. StoreT g w (a -> b) -> StoreT g w a -> StoreT g w b
    <@> StoreT w (g a)
    fa Rep g
    n = w (g b) -> Rep g -> StoreT g w b
    forall (g :: * -> *) (w :: * -> *) a.
    w (g a) -> Rep g -> StoreT g w a
    StoreT (g (a -> b) -> g a -> g b
    forall (f :: * -> *) a b.
    Representable f =>
    f (a -> b) -> f a -> f b
    apRep (g (a -> b) -> g a -> g b) -> w (g (a -> b)) -> w (g a -> g b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> w (g (a -> b))
    ff w (g a -> g b) -> w (g a) -> w (g b)
    forall a b. w (a -> b) -> w a -> w b
    forall (w :: * -> *) a b.
    ComonadApply w =>
    w (a -> b) -> w a -> w b
    <@> w (g a)
    fa) (Rep g
    m Rep g -> Rep g -> Rep g
    forall a. Semigroup a => a -> a -> a
    <> Rep g
    n)

    instance (Applicative w, Monoid (Rep g), Representable g) => Applicative (StoreT g w) where
      pure :: forall a. a -> StoreT g w a
    pure a
    a = w (g a) -> Rep g -> StoreT g w a
    forall (g :: * -> *) (w :: * -> *) a.
    w (g a) -> Rep g -> StoreT g w a
    StoreT (g a -> w (g a)
    forall a. a -> w a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (a -> g a
    forall (f :: * -> *) a. Representable f => a -> f a
    pureRep a
    a)) Rep g
    forall a. Monoid a => a
    mempty
      StoreT w (g (a -> b))
    ff Rep g
    m <*> :: forall a b. StoreT g w (a -> b) -> StoreT g w a -> StoreT g w b
    <*> StoreT w (g a)
    fa Rep g
    n = w (g b) -> Rep g -> StoreT g w b
    forall (g :: * -> *) (w :: * -> *) a.
    w (g a) -> Rep g -> StoreT g w a
    StoreT (g (a -> b) -> g a -> g b
    forall (f :: * -> *) a b.
    Representable f =>
    f (a -> b) -> f a -> f b
    apRep (g (a -> b) -> g a -> g b) -> w (g (a -> b)) -> w (g a -> g b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> w (g (a -> b))
    ff w (g a -> g b) -> w (g a) -> w (g b)
    forall a b. w (a -> b) -> w a -> w b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> w (g a)
    fa) (Rep g
    m Rep g -> Rep g -> Rep g
    forall a. Monoid a => a -> a -> a
    `mappend` Rep g
    n)

    instance (Extend w, Representable g) => Extend (StoreT g w) where
      duplicated :: forall a. StoreT g w a -> StoreT g w (StoreT g w a)
    duplicated (StoreT w (g a)
    wf Rep g
    s) = w (g (StoreT g w a)) -> Rep g -> StoreT g w (StoreT g w a)
    forall (g :: * -> *) (w :: * -> *) a.
    w (g a) -> Rep g -> StoreT g w a
    StoreT ((w (g a) -> g (StoreT g w a)) -> w (g a) -> w (g (StoreT g w a))
    forall a b. (w a -> b) -> w a -> w b
    forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
    extended ((Rep g -> StoreT g w a) -> g (StoreT g w a)
    forall a. (Rep g -> a) -> g a
    forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
    tabulate ((Rep g -> StoreT g w a) -> g (StoreT g w a))
    -> (w (g a) -> Rep g -> StoreT g w a)
    -> w (g a)
    -> g (StoreT g w a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . w (g a) -> Rep g -> StoreT g w a
    forall (g :: * -> *) (w :: * -> *) a.
    w (g a) -> Rep g -> StoreT g w a
    StoreT) w (g a)
    wf) Rep g
    s

    instance (Comonad w, Representable g) => Comonad (StoreT g w) where
      duplicate :: forall a. StoreT g w a -> StoreT g w (StoreT g w a)
    duplicate (StoreT w (g a)
    wf Rep g
    s) = w (g (StoreT g w a)) -> Rep g -> StoreT g w (StoreT g w a)
    forall (g :: * -> *) (w :: * -> *) a.
    w (g a) -> Rep g -> StoreT g w a
    StoreT ((w (g a) -> g (StoreT g w a)) -> w (g a) -> w (g (StoreT g w a))
    forall a b. (w a -> b) -> w a -> w b
    forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
    extend ((Rep g -> StoreT g w a) -> g (StoreT g w a)
    forall a. (Rep g -> a) -> g a
    forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
    tabulate ((Rep g -> StoreT g w a) -> g (StoreT g w a))
    -> (w (g a) -> Rep g -> StoreT g w a)
    -> w (g a)
    -> g (StoreT g w a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . w (g a) -> Rep g -> StoreT g w a
    forall (g :: * -> *) (w :: * -> *) a.
    w (g a) -> Rep g -> StoreT g w a
    StoreT) w (g a)
    wf) Rep g
    s
      extract :: forall a. StoreT g w a -> a
    extract (StoreT w (g a)
    wf Rep g
    s) = g a -> Rep g -> a
    forall a. g a -> Rep g -> a
    forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
    index (w (g a) -> g a
    forall a. w a -> a
    forall (w :: * -> *) a. Comonad w => w a -> a
    extract w (g a)
    wf) Rep g
    s

    instance Representable g => ComonadTrans (StoreT g) where
      lower :: forall (w :: * -> *) a. Comonad w => StoreT g w a -> w a
    lower (StoreT w (g a)
    w Rep g
    s) = (g a -> a) -> w (g a) -> w a
    forall a b. (a -> b) -> w a -> w b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (g a -> Rep g -> a
    forall a. g a -> Rep g -> a
    forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
    `index` Rep g
    s) w (g a)
    w

    instance ComonadHoist (StoreT g) where
      cohoist :: forall (w :: * -> *) (v :: * -> *) a.
    (Comonad w, Comonad v) =>
    (forall x. w x -> v x) -> StoreT g w a -> StoreT g v a
    cohoist forall x. w x -> v x
    f (StoreT w (g a)
    w Rep g
    s) = v (g a) -> Rep g -> StoreT g v a
    forall (g :: * -> *) (w :: * -> *) a.
    w (g a) -> Rep g -> StoreT g w a
    StoreT (w (g a) -> v (g a)
    forall x. w x -> v x
    f w (g a)
    w) Rep g
    s

    instance (ComonadTraced m w, Representable g) => ComonadTraced m (StoreT g w) where
      trace :: forall a. m -> StoreT g w a -> a
    trace m
    m = m -> w a -> a
    forall a. m -> w a -> a
    forall m (w :: * -> *) a. ComonadTraced m w => m -> w a -> a
    trace m
    m (w a -> a) -> (StoreT g w a -> w a) -> StoreT g w a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StoreT g w a -> w a
    forall (w :: * -> *) a. Comonad w => StoreT g w a -> w a
    forall (t :: (* -> *) -> * -> *) (w :: * -> *) a.
    (ComonadTrans t, Comonad w) =>
    t w a -> w a
    lower

    instance (ComonadEnv m w, Representable g) => ComonadEnv m (StoreT g w) where
      ask :: forall a. StoreT g w a -> m
    ask = w a -> m
    forall a. w a -> m
    forall e (w :: * -> *) a. ComonadEnv e w => w a -> e
    ask (w a -> m) -> (StoreT g w a -> w a) -> StoreT g w a -> m
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StoreT g w a -> w a
    forall (w :: * -> *) a. Comonad w => StoreT g w a -> w a
    forall (t :: (* -> *) -> * -> *) (w :: * -> *) a.
    (ComonadTrans t, Comonad w) =>
    t w a -> w a
    lower

    instance (Representable g, ComonadCofree f w) => ComonadCofree f (StoreT g w) where
      unwrap :: forall a. StoreT g w a -> f (StoreT g w a)
    unwrap (StoreT w (g a)
    w Rep g
    s) = (w (g a) -> StoreT g w a) -> f (w (g a)) -> f (StoreT g w a)
    forall a b. (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (w (g a) -> Rep g -> StoreT g w a
    forall (g :: * -> *) (w :: * -> *) a.
    w (g a) -> Rep g -> StoreT g w a
    `StoreT` Rep g
    s) (w (g a) -> f (w (g a))
    forall a. w a -> f (w a)
    forall (f :: * -> *) (w :: * -> *) a.
    ComonadCofree f w =>
    w a -> f (w a)
    unwrap w (g a)
    w)