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 Control.Monad.Ology.General.Trans.Tunnel
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) = m (Either b (f (StepT f m b))) -> StepT f m b
forall (f :: Type -> Type) (m :: Type -> Type) a.
m (Either a (f (StepT f m a))) -> StepT f m a
MkStepT (m (Either b (f (StepT f m b))) -> StepT f m b)
-> m (Either b (f (StepT f m b))) -> StepT f m b
forall a b. (a -> b) -> a -> b
$ (Either a (f (StepT f m a)) -> Either b (f (StepT f m b)))
-> m (Either a (f (StepT f m a))) -> m (Either b (f (StepT f m b)))
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b)
-> (f (StepT f m a) -> f (StepT f m b))
-> Either a (f (StepT f m a))
-> Either b (f (StepT f m b))
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
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 ((f (StepT f m a) -> f (StepT f m b))
 -> Either a (f (StepT f m a)) -> Either b (f (StepT f m b)))
-> (f (StepT f m a) -> f (StepT f m b))
-> Either a (f (StepT f m a))
-> Either b (f (StepT f m b))
forall a b. (a -> b) -> a -> b
$ (StepT f m a -> StepT f m b) -> f (StepT f m a) -> f (StepT f m b)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((StepT f m a -> StepT f m b)
 -> f (StepT f m a) -> f (StepT f m b))
-> (StepT f m a -> StepT f m b)
-> f (StepT f m a)
-> f (StepT f m b)
forall a b. (a -> b) -> a -> b
$ (a -> b) -> StepT f m a -> StepT f m b
forall a b. (a -> b) -> StepT f m a -> StepT f m 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 = Dict (Functor (StepT f m))
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 = m (Either a (f (StepT f m a))) -> StepT f m a
forall (f :: Type -> Type) (m :: Type -> Type) a.
m (Either a (f (StepT f m a))) -> StepT f m a
MkStepT (m (Either a (f (StepT f m a))) -> StepT f m a)
-> m (Either a (f (StepT f m a))) -> StepT f m a
forall a b. (a -> b) -> a -> b
$ Either a (f (StepT f m a)) -> m (Either a (f (StepT f m a)))
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either a (f (StepT f m a)) -> m (Either a (f (StepT f m a))))
-> Either a (f (StepT f m a)) -> m (Either a (f (StepT f m a)))
forall a b. (a -> b) -> a -> b
$ a -> Either a (f (StepT f m a))
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
        b -> StepT f m b
forall a. a -> StepT f m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (b -> StepT f m b) -> b -> StepT f m b
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 = a -> StepT f m a
forall a. a -> StepT f m a
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 =
        m (Either b (f (StepT f m b))) -> StepT f m b
forall (f :: Type -> Type) (m :: Type -> Type) a.
m (Either a (f (StepT f m a))) -> StepT f m a
MkStepT (m (Either b (f (StepT f m b))) -> StepT f m b)
-> m (Either b (f (StepT f m b))) -> StepT f m b
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 -> StepT f m b -> m (Either b (f (StepT f m b)))
forall (f :: Type -> Type) (m :: Type -> Type) a.
StepT f m a -> m (Either a (f (StepT f m a)))
unStepT (StepT f m b -> m (Either b (f (StepT f m b))))
-> StepT f m b -> m (Either b (f (StepT f m b)))
forall a b. (a -> b) -> a -> b
$ a -> StepT f m b
f a
a
                Right f (StepT f m a)
fsa -> Either b (f (StepT f m b)) -> m (Either b (f (StepT f m b)))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either b (f (StepT f m b)) -> m (Either b (f (StepT f m b))))
-> Either b (f (StepT f m b)) -> m (Either b (f (StepT f m b)))
forall a b. (a -> b) -> a -> b
$ f (StepT f m b) -> Either b (f (StepT f m b))
forall a b. b -> Either a b
Right (f (StepT f m b) -> Either b (f (StepT f m b)))
-> f (StepT f m b) -> Either b (f (StepT f m b))
forall a b. (a -> b) -> a -> b
$ (StepT f m a -> StepT f m b) -> f (StepT f m a) -> f (StepT f m b)
forall a b. (a -> b) -> f a -> f 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 StepT f m a -> (a -> StepT f m b) -> StepT f m b
forall a b. StepT f m a -> (a -> StepT f m b) -> StepT f m b
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 = Dict (Monad (StepT f m))
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 = m a -> StepT f m a
forall (m :: Type -> Type) a. Monad m => m a -> StepT f m a
forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StepT f m a) -> m a -> StepT f m a
forall a b. (a -> b) -> a -> b
$ IO a -> m a
forall a. IO a -> m a
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 = Dict (MonadIO (StepT f m))
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 = m (Either a (f (StepT f m a))) -> StepT f m a
forall (f :: Type -> Type) (m :: Type -> Type) a.
m (Either a (f (StepT f m a))) -> StepT f m a
MkStepT (m (Either a (f (StepT f m a))) -> StepT f m a)
-> m (Either a (f (StepT f m a))) -> StepT f m a
forall a b. (a -> b) -> a -> b
$ (a -> Either a (f (StepT f m a)))
-> m a -> m (Either a (f (StepT f m a)))
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either a (f (StepT f m a))
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) = m2 (Either a (f (StepT f m2 a))) -> StepT f m2 a
forall (f :: Type -> Type) (m :: Type -> Type) a.
m (Either a (f (StepT f m a))) -> StepT f m a
MkStepT (m2 (Either a (f (StepT f m2 a))) -> StepT f m2 a)
-> m2 (Either a (f (StepT f m2 a))) -> StepT f m2 a
forall a b. (a -> b) -> a -> b
$ ((Either a (f (StepT f m1 a)) -> Either a (f (StepT f m2 a)))
-> m2 (Either a (f (StepT f m1 a)))
-> m2 (Either a (f (StepT f m2 a)))
forall a b. (a -> b) -> m2 a -> m2 b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either a (f (StepT f m1 a)) -> Either a (f (StepT f m2 a)))
 -> m2 (Either a (f (StepT f m1 a)))
 -> m2 (Either a (f (StepT f m2 a))))
-> (Either a (f (StepT f m1 a)) -> Either a (f (StepT f m2 a)))
-> m2 (Either a (f (StepT f m1 a)))
-> m2 (Either a (f (StepT f m2 a)))
forall a b. (a -> b) -> a -> b
$ (f (StepT f m1 a) -> f (StepT f m2 a))
-> Either a (f (StepT f m1 a)) -> Either a (f (StepT f m2 a))
forall a b. (a -> b) -> Either a a -> Either a b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f (StepT f m1 a) -> f (StepT f m2 a))
 -> Either a (f (StepT f m1 a)) -> Either a (f (StepT f m2 a)))
-> (f (StepT f m1 a) -> f (StepT f m2 a))
-> Either a (f (StepT f m1 a))
-> Either a (f (StepT f m2 a))
forall a b. (a -> b) -> a -> b
$ (StepT f m1 a -> StepT f m2 a)
-> f (StepT f m1 a) -> f (StepT f m2 a)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((StepT f m1 a -> StepT f m2 a)
 -> f (StepT f m1 a) -> f (StepT f m2 a))
-> (StepT f m1 a -> StepT f m2 a)
-> f (StepT f m1 a)
-> f (StepT f m2 a)
forall a b. (a -> b) -> a -> b
$ (m1 --> m2) -> StepT f m1 --> StepT f m2
forall (m1 :: Type -> Type) (m2 :: Type -> Type).
(Monad m1, Monad m2) =>
(m1 --> m2) -> StepT f m1 --> StepT f m2
forall (t :: TransKind) (m1 :: Type -> Type) (m2 :: Type -> Type).
(MonadTransHoist t, Monad m1, Monad m2) =>
(m1 --> m2) -> t m1 --> t m2
hoist m1 a -> m2 a
m1 --> m2
f) (m2 (Either a (f (StepT f m1 a)))
 -> m2 (Either a (f (StepT f m2 a))))
-> m2 (Either a (f (StepT f m1 a)))
-> m2 (Either a (f (StepT f m2 a)))
forall a b. (a -> b) -> a -> b
$ m1 (Either a (f (StepT f m1 a)))
-> m2 (Either a (f (StepT f m1 a)))
m1 --> m2
f m1 (Either a (f (StepT f m1 a)))
ma

underTunnelStepT ::
       forall t m turn r. (MonadTransTunnel t, Monad m, Functor turn)
    => ((forall m1 a. Monad m1 => t m1 a -> m1 (Tunnel t a)) -> StepT turn m (Tunnel t r))
    -> StepT turn (t m) r
underTunnelStepT :: forall (t :: TransKind) (m :: Type -> Type) (turn :: Type -> Type)
       r.
(MonadTransTunnel t, Monad m, Functor turn) =>
((forall (m1 :: Type -> Type) a.
  Monad m1 =>
  t m1 a -> m1 (Tunnel t a))
 -> StepT turn m (Tunnel t r))
-> StepT turn (t m) r
underTunnelStepT (forall (m1 :: Type -> Type) a.
 Monad m1 =>
 t m1 a -> m1 (Tunnel t a))
-> StepT turn m (Tunnel t r)
call = let
    conv :: Either (Tunnel t r) (turn (StepT turn m (Tunnel t r))) -> Tunnel t (Either r (turn (StepT turn (t m) r)))
    conv :: Either (Tunnel t r) (turn (StepT turn m (Tunnel t r)))
-> Tunnel t (Either r (turn (StepT turn (t m) r)))
conv (Left Tunnel t r
tr) = (r -> Either r (turn (StepT turn (t m) r)))
-> Tunnel t r -> Tunnel t (Either r (turn (StepT turn (t m) r)))
forall a b. (a -> b) -> Tunnel t a -> Tunnel t b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap r -> Either r (turn (StepT turn (t m) r))
forall a b. a -> Either a b
Left Tunnel t r
tr
    conv (Right turn (StepT turn m (Tunnel t r))
turn) = Either r (turn (StepT turn (t m) r))
-> Tunnel t (Either r (turn (StepT turn (t m) r)))
forall a. a -> Tunnel t a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either r (turn (StepT turn (t m) r))
 -> Tunnel t (Either r (turn (StepT turn (t m) r))))
-> Either r (turn (StepT turn (t m) r))
-> Tunnel t (Either r (turn (StepT turn (t m) r)))
forall a b. (a -> b) -> a -> b
$ turn (StepT turn (t m) r) -> Either r (turn (StepT turn (t m) r))
forall a b. b -> Either a b
Right (turn (StepT turn (t m) r) -> Either r (turn (StepT turn (t m) r)))
-> turn (StepT turn (t m) r)
-> Either r (turn (StepT turn (t m) r))
forall a b. (a -> b) -> a -> b
$ (StepT turn m (Tunnel t r) -> StepT turn (t m) r)
-> turn (StepT turn m (Tunnel t r)) -> turn (StepT turn (t m) r)
forall a b. (a -> b) -> turn a -> turn b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\StepT turn m (Tunnel t r)
step -> ((forall (m1 :: Type -> Type) a.
  Monad m1 =>
  t m1 a -> m1 (Tunnel t a))
 -> StepT turn m (Tunnel t r))
-> StepT turn (t m) r
forall (t :: TransKind) (m :: Type -> Type) (turn :: Type -> Type)
       r.
(MonadTransTunnel t, Monad m, Functor turn) =>
((forall (m1 :: Type -> Type) a.
  Monad m1 =>
  t m1 a -> m1 (Tunnel t a))
 -> StepT turn m (Tunnel t r))
-> StepT turn (t m) r
underTunnelStepT (((forall (m1 :: Type -> Type) a.
   Monad m1 =>
   t m1 a -> m1 (Tunnel t a))
  -> StepT turn m (Tunnel t r))
 -> StepT turn (t m) r)
-> ((forall (m1 :: Type -> Type) a.
     Monad m1 =>
     t m1 a -> m1 (Tunnel t a))
    -> StepT turn m (Tunnel t r))
-> StepT turn (t m) r
forall a b. (a -> b) -> a -> b
$ \forall (m1 :: Type -> Type) a.
Monad m1 =>
t m1 a -> m1 (Tunnel t a)
_ -> StepT turn m (Tunnel t r)
step) turn (StepT turn m (Tunnel t r))
turn
    in t m (Either r (turn (StepT turn (t m) r))) -> StepT turn (t m) r
forall (f :: Type -> Type) (m :: Type -> Type) a.
m (Either a (f (StepT f m a))) -> StepT f m a
MkStepT (t m (Either r (turn (StepT turn (t m) r))) -> StepT turn (t m) r)
-> t m (Either r (turn (StepT turn (t m) r))) -> StepT turn (t m) r
forall a b. (a -> b) -> a -> b
$ ((forall (m1 :: Type -> Type) a.
  Monad m1 =>
  t m1 a -> m1 (Tunnel t a))
 -> m (Tunnel t (Either r (turn (StepT turn (t m) r)))))
-> t m (Either r (turn (StepT turn (t m) r)))
forall (m :: Type -> Type) r.
Monad m =>
((forall (m1 :: Type -> Type) a.
  Monad m1 =>
  t m1 a -> m1 (Tunnel t a))
 -> m (Tunnel t r))
-> t m r
forall (t :: TransKind) (m :: Type -> Type) r.
(MonadTransTunnel t, Monad m) =>
((forall (m1 :: Type -> Type) a.
  Monad m1 =>
  t m1 a -> m1 (Tunnel t a))
 -> m (Tunnel t r))
-> t m r
tunnel (((forall (m1 :: Type -> Type) a.
   Monad m1 =>
   t m1 a -> m1 (Tunnel t a))
  -> m (Tunnel t (Either r (turn (StepT turn (t m) r)))))
 -> t m (Either r (turn (StepT turn (t m) r))))
-> ((forall (m1 :: Type -> Type) a.
     Monad m1 =>
     t m1 a -> m1 (Tunnel t a))
    -> m (Tunnel t (Either r (turn (StepT turn (t m) r)))))
-> t m (Either r (turn (StepT turn (t m) r)))
forall a b. (a -> b) -> a -> b
$ \forall (m1 :: Type -> Type) a.
Monad m1 =>
t m1 a -> m1 (Tunnel t a)
tun -> (Either (Tunnel t r) (turn (StepT turn m (Tunnel t r)))
 -> Tunnel t (Either r (turn (StepT turn (t m) r))))
-> m (Either (Tunnel t r) (turn (StepT turn m (Tunnel t r))))
-> m (Tunnel t (Either r (turn (StepT turn (t m) r))))
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Either (Tunnel t r) (turn (StepT turn m (Tunnel t r)))
-> Tunnel t (Either r (turn (StepT turn (t m) r)))
conv (m (Either (Tunnel t r) (turn (StepT turn m (Tunnel t r))))
 -> m (Tunnel t (Either r (turn (StepT turn (t m) r)))))
-> m (Either (Tunnel t r) (turn (StepT turn m (Tunnel t r))))
-> m (Tunnel t (Either r (turn (StepT turn (t m) r))))
forall a b. (a -> b) -> a -> b
$ StepT turn m (Tunnel t r)
-> m (Either (Tunnel t r) (turn (StepT turn m (Tunnel t r))))
forall (f :: Type -> Type) (m :: Type -> Type) a.
StepT f m a -> m (Either a (f (StepT f m a)))
unStepT (StepT turn m (Tunnel t r)
 -> m (Either (Tunnel t r) (turn (StepT turn m (Tunnel t r)))))
-> StepT turn m (Tunnel t r)
-> m (Either (Tunnel t r) (turn (StepT turn m (Tunnel t r))))
forall a b. (a -> b) -> a -> b
$ (forall (m1 :: Type -> Type) a.
 Monad m1 =>
 t m1 a -> m1 (Tunnel t a))
-> StepT turn m (Tunnel t r)
call t m1 a -> m1 (Tunnel t a)
forall (m1 :: Type -> Type) a.
Monad m1 =>
t m1 a -> m1 (Tunnel t a)
tun

-- | 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 <- StepT f m a -> m (Either a (f (StepT f m a)))
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 -> a -> m a
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return a
a
        Right f (StepT f m a)
sc -> Extract f -> StepT f m --> m
forall (m :: Type -> Type) (f :: Type -> Type).
Monad m =>
Extract f -> StepT f m --> m
runSteps f a -> a
Extract f
fxx (StepT f m a -> m a) -> StepT f m a -> m a
forall a b. (a -> b) -> a -> b
$ f (StepT f m a) -> StepT f m a
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 = m (Either a (f (StepT f m a))) -> StepT f m a
forall (f :: Type -> Type) (m :: Type -> Type) a.
m (Either a (f (StepT f m a))) -> StepT f m a
MkStepT (m (Either a (f (StepT f m a))) -> StepT f m a)
-> m (Either a (f (StepT f m a))) -> StepT f m a
forall a b. (a -> b) -> a -> b
$ Either a (f (StepT f m a)) -> m (Either a (f (StepT f m a)))
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either a (f (StepT f m a)) -> m (Either a (f (StepT f m a))))
-> Either a (f (StepT f m a)) -> m (Either a (f (StepT f m a)))
forall a b. (a -> b) -> a -> b
$ f (StepT f m a) -> Either a (f (StepT f m a))
forall a b. b -> Either a b
Right (f (StepT f m a) -> Either a (f (StepT f m a)))
-> f (StepT f m a) -> Either a (f (StepT f m a))
forall a b. (a -> b) -> a -> b
$ (a -> StepT f m a) -> f a -> f (StepT f m a)
forall a b. (a -> b) -> f a -> f b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> StepT f m a
forall a. a -> StepT f m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure f a
fa