TailRecContT.purs

newtype SuspContT r m a = SuspContT ((a -> m (Either (Unit -> SuspContT r m a) r)) -> m (Either (Unit -> SuspContT r m a) r))

runSuspContT :: forall r m a. (MonadRec m) => SuspContT r m a -> (a -> m r) -> m r
runSuspContT s f = tailRecM go s
  where
    go :: SuspContT r m a -> m (Either (SuspContT r m a) r)
    go (SuspContT c) = do
      (
        either
          (\thunk -> Left $ thunk unit)
          (\r -> Right r)
      ) <$> c ((Right <$> _) <<< f)

toSuspContT :: forall r m a. (MonadRec m) => ContT r m a -> SuspContT r m a
toSuspContT c =
  SuspContT (\k ->
    let k2 a =
          (k a) >>= (
            either
              (\thunk -> runSuspContT (thunk unit) k2)
              return
          )
    in
    Right <$> runContT c k2
  )

fromSuspContT :: forall r m a. (MonadRec m) => SuspContT r m a -> ContT r m a
fromSuspContT c = ContT (\k -> runSuspContT c k)