module Util.Internal.Indexed where

-- | > Compose (State Int) f a
newtype Indexed f a = Indexed { Indexed f a -> Int -> (f a, Int)
runIndexed :: Int -> (f a, Int) }

instance Functor f => Functor (Indexed f) where
    fmap :: (a -> b) -> Indexed f a -> Indexed f b
fmap a -> b
f (Indexed Int -> (f a, Int)
sf) = (Int -> (f b, Int)) -> Indexed f b
forall (f :: * -> *) a. (Int -> (f a, Int)) -> Indexed f a
Indexed ((Int -> (f b, Int)) -> Indexed f b)
-> (Int -> (f b, Int)) -> Indexed f b
forall a b. (a -> b) -> a -> b
$ \Int
s -> let (f a
x, Int
s') = Int -> (f a, Int)
sf Int
s in ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
x, Int
s')

instance Applicative f => Applicative (Indexed f) where
    pure :: a -> Indexed f a
pure a
x = (Int -> (f a, Int)) -> Indexed f a
forall (f :: * -> *) a. (Int -> (f a, Int)) -> Indexed f a
Indexed ((Int -> (f a, Int)) -> Indexed f a)
-> (Int -> (f a, Int)) -> Indexed f a
forall a b. (a -> b) -> a -> b
$ (,) (a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)

    Indexed Int -> (f (a -> b), Int)
sfa <*> :: Indexed f (a -> b) -> Indexed f a -> Indexed f b
<*> Indexed Int -> (f a, Int)
sfb = (Int -> (f b, Int)) -> Indexed f b
forall (f :: * -> *) a. (Int -> (f a, Int)) -> Indexed f a
Indexed ((Int -> (f b, Int)) -> Indexed f b)
-> (Int -> (f b, Int)) -> Indexed f b
forall a b. (a -> b) -> a -> b
$ \Int
s ->
        let (f (a -> b)
f, Int
s') = Int -> (f (a -> b), Int)
sfa Int
s
            (f a
x, Int
s'') = Int -> (f a, Int)
sfb Int
s'
        in (f (a -> b)
f f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
x, Int
s'')

evalIndexed :: Indexed f a -> Int -> f a
evalIndexed :: Indexed f a -> Int -> f a
evalIndexed (Indexed Int -> (f a, Int)
sf) Int
x = (f a, Int) -> f a
forall a b. (a, b) -> a
fst (Int -> (f a, Int)
sf Int
x)