-- | The indexed costate (also called "store") transfomer: each @'CostateT' f i j@ term has a value of type @i@, and wants within @f@ a value of type @j@.

module Control.Comonad.Indexed.Trans.Costate where

import Prelude hiding ((.))
import qualified Control.Applicative as Base
import qualified Control.Comonad as Base
import Control.Semigroupoid
import Data.Functor.Indexed

data CostateT f i j a = CostateT (f (j -> a)) i
  deriving (a -> CostateT f i j b -> CostateT f i j a
(a -> b) -> CostateT f i j a -> CostateT f i j b
(forall a b. (a -> b) -> CostateT f i j a -> CostateT f i j b)
-> (forall a b. a -> CostateT f i j b -> CostateT f i j a)
-> Functor (CostateT f i j)
forall a b. a -> CostateT f i j b -> CostateT f i j a
forall a b. (a -> b) -> CostateT f i j a -> CostateT f i j b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (f :: * -> *) i j a b.
Functor f =>
a -> CostateT f i j b -> CostateT f i j a
forall (f :: * -> *) i j a b.
Functor f =>
(a -> b) -> CostateT f i j a -> CostateT f i j b
<$ :: a -> CostateT f i j b -> CostateT f i j a
$c<$ :: forall (f :: * -> *) i j a b.
Functor f =>
a -> CostateT f i j b -> CostateT f i j a
fmap :: (a -> b) -> CostateT f i j a -> CostateT f i j b
$cfmap :: forall (f :: * -> *) i j a b.
Functor f =>
(a -> b) -> CostateT f i j a -> CostateT f i j b
Functor)

colift :: Functor f => CostateT f k k a -> f a
colift :: CostateT f k k a -> f a
colift (CostateT x :: f (k -> a)
x s :: k
s) = ((k -> a) -> k -> a
forall a b. (a -> b) -> a -> b
$ k
s) ((k -> a) -> a) -> f (k -> a) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (k -> a)
x

lens :: Functor φ => ((f (j -> a), i) -> φ (g (v -> b), u)) -> CostateT f i j a -> φ (CostateT g u v b)
lens :: ((f (j -> a), i) -> φ (g (v -> b), u))
-> CostateT f i j a -> φ (CostateT g u v b)
lens φ :: (f (j -> a), i) -> φ (g (v -> b), u)
φ (CostateT x :: f (j -> a)
x s :: i
s) = (g (v -> b) -> u -> CostateT g u v b)
-> (g (v -> b), u) -> CostateT g u v b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry g (v -> b) -> u -> CostateT g u v b
forall (f :: * -> *) i j a. f (j -> a) -> i -> CostateT f i j a
CostateT ((g (v -> b), u) -> CostateT g u v b)
-> φ (g (v -> b), u) -> φ (CostateT g u v b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (f (j -> a), i) -> φ (g (v -> b), u)
φ (f (j -> a)
x, i
s)

instance Base.Applicative p => Apply (CostateT p) where
    liftA2 :: (a -> b -> c)
-> CostateT p i j a -> CostateT p j k b -> CostateT p i k c
liftA2 φ :: a -> b -> c
φ (CostateT x :: p (j -> a)
x i :: i
i) (CostateT y :: p (k -> b)
y j :: j
j) = p (k -> c) -> i -> CostateT p i k c
forall (f :: * -> *) i j a. f (j -> a) -> i -> CostateT f i j a
CostateT (((j -> a) -> (k -> b) -> k -> c)
-> p (j -> a) -> p (k -> b) -> p (k -> c)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Base.liftA2 (\ f :: j -> a
f g :: k -> b
g -> a -> b -> c
φ (j -> a
f j
j) (b -> c) -> (k -> b) -> k -> c
forall k (κ :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Semigroupoid κ =>
κ b c -> κ a b -> κ a c
. k -> b
g) p (j -> a)
x p (k -> b)
y) i
i

instance (Base.Comonad ɯ) => Cobind (CostateT ɯ) where
    cut :: CostateT ɯ i k a -> CostateT ɯ i j (CostateT ɯ j k a)
cut (CostateT f :: ɯ (k -> a)
f i :: i
i) = ɯ (j -> CostateT ɯ j k a) -> i -> CostateT ɯ i j (CostateT ɯ j k a)
forall (f :: * -> *) i j a. f (j -> a) -> i -> CostateT f i j a
CostateT (ɯ (k -> a) -> j -> CostateT ɯ j k a
forall (f :: * -> *) i j a. f (j -> a) -> i -> CostateT f i j a
CostateT ɯ (k -> a)
f (j -> CostateT ɯ j k a) -> ɯ (k -> a) -> ɯ (j -> CostateT ɯ j k a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ɯ (k -> a)
f) i
i

instance (Base.Comonad ɯ) => Base.Comonad (CostateT ɯ k k) where
    copure :: CostateT ɯ k k a -> a
copure (CostateT f :: ɯ (k -> a)
f i :: k
i) = ɯ (k -> a) -> k -> a
forall (ɯ :: * -> *) a. Comonad ɯ => ɯ a -> a
copure ɯ (k -> a)
f k
i
    cut :: CostateT ɯ k k a -> CostateT ɯ k k (CostateT ɯ k k a)
cut = CostateT ɯ k k a -> CostateT ɯ k k (CostateT ɯ k k a)
forall k (ɯ :: k -> k -> * -> *) (i :: k) (k :: k) a (j :: k).
Cobind ɯ =>
ɯ i k a -> ɯ i j (ɯ j k a)
cut