-- | The indexed continuation transformer: see 'ContT'.

module Control.Monad.Indexed.Trans.Cont where

import Prelude (Functor (..), flip, ($), (<$>))
import Control.Applicative (Alternative (..))
import qualified Control.Applicative as Base
import Control.Category
import qualified Control.Monad as Base
import qualified Control.Monad.Fail as Base
import Data.Functor.Indexed

newtype ContT f i j a = ContT { ContT f i j a -> (a -> f j) -> f i
runContT :: (a -> f j) -> f i }
  deriving (a -> ContT f i j b -> ContT f i j a
(a -> b) -> ContT f i j a -> ContT f i j b
(forall a b. (a -> b) -> ContT f i j a -> ContT f i j b)
-> (forall a b. a -> ContT f i j b -> ContT f i j a)
-> Functor (ContT f i j)
forall a b. a -> ContT f i j b -> ContT f i j a
forall a b. (a -> b) -> ContT f i j a -> ContT f i j b
forall k (f :: k -> *) (i :: k) (j :: k) a b.
a -> ContT f i j b -> ContT f i j a
forall k (f :: k -> *) (i :: k) (j :: k) a b.
(a -> b) -> ContT f i j a -> ContT 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
<$ :: a -> ContT f i j b -> ContT f i j a
$c<$ :: forall k (f :: k -> *) (i :: k) (j :: k) a b.
a -> ContT f i j b -> ContT f i j a
fmap :: (a -> b) -> ContT f i j a -> ContT f i j b
$cfmap :: forall k (f :: k -> *) (i :: k) (j :: k) a b.
(a -> b) -> ContT f i j a -> ContT f i j b
Functor)

lift :: Base.Monad m => m a -> ContT m i i a
lift :: m a -> ContT m i i a
lift = ((a -> m i) -> m i) -> ContT m i i a
forall k (f :: k -> *) (i :: k) (j :: k) a.
((a -> f j) -> f i) -> ContT f i j a
ContT (((a -> m i) -> m i) -> ContT m i i a)
-> (m a -> (a -> m i) -> m i) -> m a -> ContT m i i a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. m a -> (a -> m i) -> m i
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(Base.>>=)

evalContT :: Base.Applicative p => ContT p a a a -> p a
evalContT :: ContT p a a a -> p a
evalContT = (ContT p a a a -> (a -> p a) -> p a)
-> (a -> p a) -> ContT p a a a -> p a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ContT p a a a -> (a -> p a) -> p a
forall k (f :: k -> *) (i :: k) (j :: k) a.
ContT f i j a -> (a -> f j) -> f i
runContT a -> p a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

mapContT :: (f i -> f j) -> ContT f i k a -> ContT f j k a
mapContT :: (f i -> f j) -> ContT f i k a -> ContT f j k a
mapContT φ :: f i -> f j
φ (ContT f :: (a -> f k) -> f i
f) = ((a -> f k) -> f j) -> ContT f j k a
forall k (f :: k -> *) (i :: k) (j :: k) a.
((a -> f j) -> f i) -> ContT f i j a
ContT (f i -> f j
φ (f i -> f j) -> ((a -> f k) -> f i) -> (a -> f k) -> f j
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> f k) -> f i
f)

withContT :: ((b -> f j) -> (a -> f k)) -> ContT f i k a -> ContT f i j b
withContT :: ((b -> f j) -> a -> f k) -> ContT f i k a -> ContT f i j b
withContT φ :: (b -> f j) -> a -> f k
φ (ContT f :: (a -> f k) -> f i
f) = ((b -> f j) -> f i) -> ContT f i j b
forall k (f :: k -> *) (i :: k) (j :: k) a.
((a -> f j) -> f i) -> ContT f i j a
ContT ((a -> f k) -> f i
f ((a -> f k) -> f i)
-> ((b -> f j) -> a -> f k) -> (b -> f j) -> f i
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (b -> f j) -> a -> f k
φ)

callCC :: ((a -> ContT f j k b) -> ContT f i j a) -> ContT f i j a
callCC :: ((a -> ContT f j k b) -> ContT f i j a) -> ContT f i j a
callCC f :: (a -> ContT f j k b) -> ContT f i j a
f = ((a -> f j) -> f i) -> ContT f i j a
forall k (f :: k -> *) (i :: k) (j :: k) a.
((a -> f j) -> f i) -> ContT f i j a
ContT (((a -> f j) -> f i) -> ContT f i j a)
-> ((a -> f j) -> f i) -> ContT f i j a
forall a b. (a -> b) -> a -> b
$ \ k :: a -> f j
k -> ContT f i j a -> (a -> f j) -> f i
forall k (f :: k -> *) (i :: k) (j :: k) a.
ContT f i j a -> (a -> f j) -> f i
runContT ((a -> ContT f j k b) -> ContT f i j a
f ((a -> ContT f j k b) -> ContT f i j a)
-> (a -> ContT f j k b) -> ContT f i j a
forall a b. (a -> b) -> a -> b
$ ((b -> f k) -> f j) -> ContT f j k b
forall k (f :: k -> *) (i :: k) (j :: k) a.
((a -> f j) -> f i) -> ContT f i j a
ContT (((b -> f k) -> f j) -> ContT f j k b)
-> (a -> (b -> f k) -> f j) -> a -> ContT f j k b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f j -> (b -> f k) -> f j
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f j -> (b -> f k) -> f j) -> (a -> f j) -> a -> (b -> f k) -> f j
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> f j
k) a -> f j
k

resetT :: Base.Monad m => ContT m a i i -> ContT m j j a
resetT :: ContT m a i i -> ContT m j j a
resetT (ContT f :: (i -> m i) -> m a
f) = ((a -> m j) -> m j) -> ContT m j j a
forall k (f :: k -> *) (i :: k) (j :: k) a.
((a -> f j) -> f i) -> ContT f i j a
ContT ((i -> m i) -> m a
f i -> m i
forall (f :: * -> *) a. Applicative f => a -> f a
pure m a -> (a -> m j) -> m j
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Base.>>=)

shiftT :: Base.Monad m => ((a -> m j) -> ContT m i k k) -> ContT m i j a
shiftT :: ((a -> m j) -> ContT m i k k) -> ContT m i j a
shiftT f :: (a -> m j) -> ContT m i k k
f = ((a -> m j) -> m i) -> ContT m i j a
forall k (f :: k -> *) (i :: k) (j :: k) a.
((a -> f j) -> f i) -> ContT f i j a
ContT ((ContT m i k k -> (k -> m k) -> m i)
-> (k -> m k) -> ContT m i k k -> m i
forall a b c. (a -> b -> c) -> b -> a -> c
flip ContT m i k k -> (k -> m k) -> m i
forall k (f :: k -> *) (i :: k) (j :: k) a.
ContT f i j a -> (a -> f j) -> f i
runContT k -> m k
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ContT m i k k -> m i)
-> ((a -> m j) -> ContT m i k k) -> (a -> m j) -> m i
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> m j) -> ContT m i k k
f)

instance Apply (ContT f) where
    <*> :: ContT f i j (a -> b) -> ContT f j k a -> ContT f i k b
(<*>) = ContT f i j (a -> b) -> ContT f j k a -> ContT f i k b
forall k1 (m :: k1 -> k1 -> * -> *) (i :: k1) (j :: k1) a b
       (k2 :: k1).
(Bind m, forall (k3 :: k1). Applicative (m k3 k3)) =>
m i j (a -> b) -> m j k2 a -> m i k2 b
apIxMonad

instance Bind (ContT f) where
    join :: ContT f i j (ContT f j k a) -> ContT f i k a
join (ContT f :: (ContT f j k a -> f j) -> f i
f) = ((a -> f k) -> f i) -> ContT f i k a
forall k (f :: k -> *) (i :: k) (j :: k) a.
((a -> f j) -> f i) -> ContT f i j a
ContT (((a -> f k) -> f i) -> ContT f i k a)
-> ((a -> f k) -> f i) -> ContT f i k a
forall a b. (a -> b) -> a -> b
$ (ContT f j k a -> f j) -> f i
f ((ContT f j k a -> f j) -> f i)
-> ((a -> f k) -> ContT f j k a -> f j) -> (a -> f k) -> f i
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (ContT f j k a -> (a -> f k) -> f j)
-> (a -> f k) -> ContT f j k a -> f j
forall a b c. (a -> b -> c) -> b -> a -> c
flip ContT f j k a -> (a -> f k) -> f j
forall k (f :: k -> *) (i :: k) (j :: k) a.
ContT f i j a -> (a -> f j) -> f i
runContT

instance Base.Applicative (ContT f k k) where
    pure :: a -> ContT f k k a
pure = ((a -> f k) -> f k) -> ContT f k k a
forall k (f :: k -> *) (i :: k) (j :: k) a.
((a -> f j) -> f i) -> ContT f i j a
ContT (((a -> f k) -> f k) -> ContT f k k a)
-> (a -> (a -> f k) -> f k) -> a -> ContT f k k a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((a -> f k) -> a -> f k) -> a -> (a -> f k) -> f k
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> f k) -> a -> f k
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
    <*> :: ContT f k k (a -> b) -> ContT f k k a -> ContT f k k b
(<*>) = ContT f k k (a -> b) -> ContT f k k a -> ContT f k k b
forall k (p :: k -> k -> * -> *) (i :: k) (j :: k) a b (k :: k).
Apply p =>
p i j (a -> b) -> p j k a -> p i k b
(<*>)

instance Alternative p => Alternative (ContT p k k) where
    empty :: ContT p k k a
empty = ((a -> p k) -> p k) -> ContT p k k a
forall k (f :: k -> *) (i :: k) (j :: k) a.
((a -> f j) -> f i) -> ContT f i j a
ContT (((a -> p k) -> p k) -> ContT p k k a)
-> ((a -> p k) -> p k) -> ContT p k k a
forall a b. (a -> b) -> a -> b
$ p k -> (a -> p k) -> p k
forall (f :: * -> *) a. Applicative f => a -> f a
pure p k
forall (f :: * -> *) a. Alternative f => f a
empty
    ContT f :: (a -> p k) -> p k
f <|> :: ContT p k k a -> ContT p k k a -> ContT p k k a
<|> ContT g :: (a -> p k) -> p k
g = ((a -> p k) -> p k) -> ContT p k k a
forall k (f :: k -> *) (i :: k) (j :: k) a.
((a -> f j) -> f i) -> ContT f i j a
ContT (((a -> p k) -> p k) -> ContT p k k a)
-> ((a -> p k) -> p k) -> ContT p k k a
forall a b. (a -> b) -> a -> b
$ (p k -> p k -> p k)
-> ((a -> p k) -> p k) -> ((a -> p k) -> p k) -> (a -> p k) -> p k
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Base.liftA2 p k -> p k -> p k
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (a -> p k) -> p k
f (a -> p k) -> p k
g

instance Base.Monad (ContT f k k) where
    >>= :: ContT f k k a -> (a -> ContT f k k b) -> ContT f k k b
(>>=) = ContT f k k a -> (a -> ContT f k k b) -> ContT f k k b
forall k (m :: k -> k -> * -> *) (i :: k) (j :: k) a (k :: k) b.
Bind m =>
m i j a -> (a -> m j k b) -> m i k b
(>>=)

instance Alternative p => Base.MonadPlus (ContT p k k) where
    mzero :: ContT p k k a
mzero = ContT p k k a
forall (f :: * -> *) a. Alternative f => f a
empty
    mplus :: ContT p k k a -> ContT p k k a -> ContT p k k a
mplus = ContT p k k a -> ContT p k k a -> ContT p k k a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance Base.MonadFail m => Base.MonadFail (ContT m k k) where
    fail :: String -> ContT m k k a
fail = ((a -> m k) -> m k) -> ContT m k k a
forall k (f :: k -> *) (i :: k) (j :: k) a.
((a -> f j) -> f i) -> ContT f i j a
ContT (((a -> m k) -> m k) -> ContT m k k a)
-> (String -> (a -> m k) -> m k) -> String -> ContT m k k a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. m k -> (a -> m k) -> m k
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m k -> (a -> m k) -> m k)
-> (String -> m k) -> String -> (a -> m k) -> m k
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> m k
forall (m :: * -> *) a. MonadFail m => String -> m a
Base.fail

liftLocal
 :: (Base.Monad m, Base.Applicative p)
 => m r -> (p r -> m i -> m j) -> p r -> ContT m i j a -> ContT m j i a
liftLocal :: m r -> (p r -> m i -> m j) -> p r -> ContT m i j a -> ContT m j i a
liftLocal ask :: m r
ask local :: p r -> m i -> m j
local f :: p r
f (ContT xm :: (a -> m j) -> m i
xm) = ((a -> m i) -> m j) -> ContT m j i a
forall k (f :: k -> *) (i :: k) (j :: k) a.
((a -> f j) -> f i) -> ContT f i j a
ContT (((a -> m i) -> m j) -> ContT m j i a)
-> ((a -> m i) -> m j) -> ContT m j i a
forall a b. (a -> b) -> a -> b
$ \ k :: a -> m i
k -> do
    p r
g <- r -> p r
forall (f :: * -> *) a. Applicative f => a -> f a
pure (r -> p r) -> m r -> m (p r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m r
ask
    p r -> m i -> m j
local p r
f ((a -> m j) -> m i
xm (p r -> m i -> m j
local p r
g (m i -> m j) -> (a -> m i) -> a -> m j
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> m i
k))