module Control.Monad.Ology.Specific.StepT where

import Control.Monad.Ology.General.Function
import Control.Monad.Ology.General.IO
import Control.Monad.Ology.General.Trans.Constraint
import Control.Monad.Ology.General.Trans.Hoist
import Control.Monad.Ology.General.Trans.Trans
import Import

-- | A monad that can be run step-by-step until the result.
newtype StepT f m a = MkStepT
    { forall (f :: Type -> Type) (m :: Type -> Type) a.
StepT f m a -> m (Either a (f (StepT f m a)))
unStepT :: m (Either a (f (StepT f m a)))
    }

instance (Functor f, Functor m) => Functor (StepT f m) where
    fmap :: forall a b. (a -> b) -> StepT f m a -> StepT f m b
fmap a -> b
ab (MkStepT m (Either a (f (StepT f m a)))
ma) = forall (f :: Type -> Type) (m :: Type -> Type) a.
m (Either a (f (StepT f m a))) -> StepT f m a
MkStepT forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: Type -> Type -> Type) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
ab forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
ab) m (Either a (f (StepT f m a)))
ma

instance Functor f => TransConstraint Functor (StepT f) where
    hasTransConstraint :: forall (m :: Type -> Type). Functor m => Dict (Functor (StepT f m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance (Functor f, Monad m) => Applicative (StepT f m) where
    pure :: forall a. a -> StepT f m a
pure a
a = forall (f :: Type -> Type) (m :: Type -> Type) a.
m (Either a (f (StepT f m a))) -> StepT f m a
MkStepT forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left a
a
    StepT f m (a -> b)
mab <*> :: forall a b. StepT f m (a -> b) -> StepT f m a -> StepT f m b
<*> StepT f m a
ma = do
        a -> b
ab <- StepT f m (a -> b)
mab
        a
a <- StepT f m a
ma
        forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a -> b
ab a
a

instance (Functor f, Monad m) => Monad (StepT f m) where
    return :: forall a. a -> StepT f m a
return = forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
    MkStepT m (Either a (f (StepT f m a)))
mea >>= :: forall a b. StepT f m a -> (a -> StepT f m b) -> StepT f m b
>>= a -> StepT f m b
f =
        forall (f :: Type -> Type) (m :: Type -> Type) a.
m (Either a (f (StepT f m a))) -> StepT f m a
MkStepT forall a b. (a -> b) -> a -> b
$ do
            Either a (f (StepT f m a))
ea <- m (Either a (f (StepT f m a)))
mea
            case Either a (f (StepT f m a))
ea of
                Left a
a -> forall (f :: Type -> Type) (m :: Type -> Type) a.
StepT f m a -> m (Either a (f (StepT f m a)))
unStepT forall a b. (a -> b) -> a -> b
$ a -> StepT f m b
f a
a
                Right f (StepT f m a)
fsa -> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\StepT f m a
sa -> StepT f m a
sa forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> StepT f m b
f) f (StepT f m a)
fsa

instance Functor f => TransConstraint Monad (StepT f) where
    hasTransConstraint :: forall (m :: Type -> Type). Monad m => Dict (Monad (StepT f m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance (Functor f, MonadIO m) => MonadIO (StepT f m) where
    liftIO :: forall a. IO a -> StepT f m a
liftIO IO a
ioa = forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO a
ioa

instance Functor f => TransConstraint MonadIO (StepT f) where
    hasTransConstraint :: forall (m :: Type -> Type). MonadIO m => Dict (MonadIO (StepT f m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance Functor f => MonadTrans (StepT f) where
    lift :: forall (m :: Type -> Type) a. Monad m => m a -> StepT f m a
lift m a
ma = forall (f :: Type -> Type) (m :: Type -> Type) a.
m (Either a (f (StepT f m a))) -> StepT f m a
MkStepT forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left m a
ma

instance Functor f => MonadTransHoist (StepT f) where
    hoist :: forall (m1 :: Type -> Type) (m2 :: Type -> Type).
(Monad m1, Monad m2) =>
(m1 --> m2) -> StepT f m1 --> StepT f m2
hoist m1 --> m2
f (MkStepT m1 (Either a (f (StepT f m1 a)))
ma) = forall (f :: Type -> Type) (m :: Type -> Type) a.
m (Either a (f (StepT f m a))) -> StepT f m a
MkStepT forall a b. (a -> b) -> a -> b
$ (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall (t :: TransKind) (m1 :: Type -> Type) (m2 :: Type -> Type).
(MonadTransHoist t, Monad m1, Monad m2) =>
(m1 --> m2) -> t m1 --> t m2
hoist m1 --> m2
f) forall a b. (a -> b) -> a -> b
$ m1 --> m2
f m1 (Either a (f (StepT f m1 a)))
ma

-- | Run all the steps until done.
runSteps :: Monad m => Extract f -> StepT f m --> m
runSteps :: forall (m :: Type -> Type) (f :: Type -> Type).
Monad m =>
Extract f -> StepT f m --> m
runSteps Extract f
fxx StepT f m a
step = do
    Either a (f (StepT f m a))
eap <- forall (f :: Type -> Type) (m :: Type -> Type) a.
StepT f m a -> m (Either a (f (StepT f m a)))
unStepT StepT f m a
step
    case Either a (f (StepT f m a))
eap of
        Left a
a -> forall (m :: Type -> Type) a. Monad m => a -> m a
return a
a
        Right f (StepT f m a)
sc -> forall (m :: Type -> Type) (f :: Type -> Type).
Monad m =>
Extract f -> StepT f m --> m
runSteps Extract f
fxx forall a b. (a -> b) -> a -> b
$ Extract f
fxx f (StepT f m a)
sc

-- | A pending step for this result.
pendingStep :: (Functor f, Monad m) => f --> StepT f m
pendingStep :: forall (f :: Type -> Type) (m :: Type -> Type).
(Functor f, Monad m) =>
f --> StepT f m
pendingStep f a
fa = forall (f :: Type -> Type) (m :: Type -> Type) a.
m (Either a (f (StepT f m a))) -> StepT f m a
MkStepT forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: Type -> Type) a. Applicative f => a -> f a
pure f a
fa