-- | An 'Automaton' with 'Maybe' or 'MaybeT' in its monad stack can terminate execution at any step.
module Data.Automaton.Trans.Maybe (
  module Data.Automaton.Trans.Maybe,
  module Control.Monad.Trans.Maybe,
  maybeToExceptS,
)
where

-- base
import Control.Arrow (arr, returnA, (>>>))

-- transformers
import Control.Monad.Trans.Maybe hiding (
  liftCallCC,
  liftCatch,
  liftListen,
  liftPass,
 )

-- automaton
import Data.Automaton (Automaton, arrM, constM, hoistS, liftS)
import Data.Automaton.Trans.Except (
  ExceptT,
  exceptS,
  listToAutomatonExcept,
  maybeToExceptS,
  reactimateExcept,
  runAutomatonExcept,
  runExceptT,
  safe,
  safely,
  try,
 )

-- * Throwing 'Nothing' as an exception ("exiting")

-- | Throw the exception immediately.
exit :: (Monad m) => Automaton (MaybeT m) a b
exit :: forall (m :: Type -> Type) a b. Monad m => Automaton (MaybeT m) a b
exit = MaybeT m b -> Automaton (MaybeT m) a b
forall (m :: Type -> Type) b a. Functor m => m b -> Automaton m a b
constM (MaybeT m b -> Automaton (MaybeT m) a b)
-> MaybeT m b -> Automaton (MaybeT m) a b
forall a b. (a -> b) -> a -> b
$ m (Maybe b) -> MaybeT m b
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe b) -> MaybeT m b) -> m (Maybe b) -> MaybeT m b
forall a b. (a -> b) -> a -> b
$ Maybe b -> m (Maybe b)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing

-- | Throw the exception when the condition becomes true on the input.
exitWhen :: (Monad m) => (a -> Bool) -> Automaton (MaybeT m) a a
exitWhen :: forall (m :: Type -> Type) a.
Monad m =>
(a -> Bool) -> Automaton (MaybeT m) a a
exitWhen a -> Bool
condition = proc a
a -> do
  ()
_ <- Automaton (MaybeT m) Bool ()
forall (m :: Type -> Type). Monad m => Automaton (MaybeT m) Bool ()
exitIf -< a -> Bool
condition a
a
  Automaton (MaybeT m) a a
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< a
a

-- | Exit when the incoming value is 'True'.
exitIf :: (Monad m) => Automaton (MaybeT m) Bool ()
exitIf :: forall (m :: Type -> Type). Monad m => Automaton (MaybeT m) Bool ()
exitIf = proc Bool
condition ->
  if Bool
condition
    then Automaton (MaybeT m) () ()
forall (m :: Type -> Type) a b. Monad m => Automaton (MaybeT m) a b
exit -< ()
    else Automaton (MaybeT m) () ()
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< ()

-- | @Just a@ is passed along, 'Nothing' causes the whole 'Automaton' to exit.
maybeExit :: (Monad m) => Automaton (MaybeT m) (Maybe a) a
maybeExit :: forall (m :: Type -> Type) a.
Monad m =>
Automaton (MaybeT m) (Maybe a) a
maybeExit = Automaton (MaybeT m) (Maybe a) a
forall (m :: Type -> Type) a.
Monad m =>
Automaton (MaybeT m) (Maybe a) a
inMaybeT

-- | Embed a 'Maybe' value in the 'MaybeT' layer. Identical to 'maybeExit'.
inMaybeT :: (Monad m) => Automaton (MaybeT m) (Maybe a) a
inMaybeT :: forall (m :: Type -> Type) a.
Monad m =>
Automaton (MaybeT m) (Maybe a) a
inMaybeT = (Maybe a -> MaybeT m a) -> Automaton (MaybeT m) (Maybe a) a
forall (m :: Type -> Type) a b.
Functor m =>
(a -> m b) -> Automaton m a b
arrM ((Maybe a -> MaybeT m a) -> Automaton (MaybeT m) (Maybe a) a)
-> (Maybe a -> MaybeT m a) -> Automaton (MaybeT m) (Maybe a) a
forall a b. (a -> b) -> a -> b
$ m (Maybe a) -> MaybeT m a
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> MaybeT m a)
-> (Maybe a -> m (Maybe a)) -> Maybe a -> MaybeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return

-- * Catching Maybe exceptions

-- | Run the first automaton until the second one produces 'True' from the output of the first.
untilMaybe :: (Monad m) => Automaton m a b -> Automaton m b Bool -> Automaton (MaybeT m) a b
untilMaybe :: forall (m :: Type -> Type) a b.
Monad m =>
Automaton m a b -> Automaton m b Bool -> Automaton (MaybeT m) a b
untilMaybe Automaton m a b
automaton Automaton m b Bool
cond = proc a
a -> do
  b
b <- Automaton m a b -> Automaton (MaybeT m) a b
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a
       b.
(MonadTrans t, Monad m, Functor (t m)) =>
Automaton m a b -> Automaton (t m) a b
liftS Automaton m a b
automaton -< a
a
  Bool
c <- Automaton m b Bool -> Automaton (MaybeT m) b Bool
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a
       b.
(MonadTrans t, Monad m, Functor (t m)) =>
Automaton m a b -> Automaton (t m) a b
liftS Automaton m b Bool
cond -< b
b
  Automaton (MaybeT m) (Maybe b) b
forall (m :: Type -> Type) a.
Monad m =>
Automaton (MaybeT m) (Maybe a) a
inMaybeT -< if Bool
c then Maybe b
forall a. Maybe a
Nothing else b -> Maybe b
forall a. a -> Maybe a
Just b
b

{- | When an exception occurs in the first 'automaton', the second 'automaton' is executed
from there.
-}
catchMaybe ::
  (Functor m, Monad m) =>
  Automaton (MaybeT m) a b ->
  Automaton m a b ->
  Automaton m a b
catchMaybe :: forall (m :: Type -> Type) a b.
(Functor m, Monad m) =>
Automaton (MaybeT m) a b -> Automaton m a b -> Automaton m a b
catchMaybe Automaton (MaybeT m) a b
automaton1 Automaton m a b
automaton2 = AutomatonExcept a b m Void -> Automaton m a b
forall (m :: Type -> Type) a b.
Monad m =>
AutomatonExcept a b m Void -> Automaton m a b
safely (AutomatonExcept a b m Void -> Automaton m a b)
-> AutomatonExcept a b m Void -> Automaton m a b
forall a b. (a -> b) -> a -> b
$ Automaton (ExceptT () m) a b -> AutomatonExcept a b m ()
forall (m :: Type -> Type) e a b.
Monad m =>
Automaton (ExceptT e m) a b -> AutomatonExcept a b m e
try (Automaton (MaybeT m) a b -> Automaton (ExceptT () m) a b
forall (m :: Type -> Type) a b.
(Functor m, Monad m) =>
Automaton (MaybeT m) a b -> Automaton (ExceptT () m) a b
maybeToExceptS Automaton (MaybeT m) a b
automaton1) AutomatonExcept a b m ()
-> AutomatonExcept a b m Void -> AutomatonExcept a b m Void
forall a b.
AutomatonExcept a b m a
-> AutomatonExcept a b m b -> AutomatonExcept a b m b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Automaton m a b -> AutomatonExcept a b m Void
forall (m :: Type -> Type) a b e.
Monad m =>
Automaton m a b -> AutomatonExcept a b m e
safe Automaton m a b
automaton2

-- * Converting to and from 'MaybeT'

-- | Convert exceptions into `Nothing`, discarding the exception value.
exceptToMaybeS ::
  (Functor m, Monad m) =>
  Automaton (ExceptT e m) a b ->
  Automaton (MaybeT m) a b
exceptToMaybeS :: forall (m :: Type -> Type) e a b.
(Functor m, Monad m) =>
Automaton (ExceptT e m) a b -> Automaton (MaybeT m) a b
exceptToMaybeS =
  (forall x. ExceptT e m x -> MaybeT m x)
-> Automaton (ExceptT e m) a b -> Automaton (MaybeT m) a b
forall (m :: Type -> Type) (n :: Type -> Type) a b.
Monad m =>
(forall x. m x -> n x) -> Automaton m a b -> Automaton n a b
hoistS ((forall x. ExceptT e m x -> MaybeT m x)
 -> Automaton (ExceptT e m) a b -> Automaton (MaybeT m) a b)
-> (forall x. ExceptT e m x -> MaybeT m x)
-> Automaton (ExceptT e m) a b
-> Automaton (MaybeT m) a b
forall a b. (a -> b) -> a -> b
$ m (Maybe x) -> MaybeT m x
forall (m :: Type -> Type) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe x) -> MaybeT m x)
-> (ExceptT e m x -> m (Maybe x)) -> ExceptT e m x -> MaybeT m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either e x -> Maybe x) -> m (Either e x) -> m (Maybe x)
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((e -> Maybe x) -> (x -> Maybe x) -> Either e x -> Maybe x
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe x -> e -> Maybe x
forall a b. a -> b -> a
const Maybe x
forall a. Maybe a
Nothing) x -> Maybe x
forall a. a -> Maybe a
Just) (m (Either e x) -> m (Maybe x))
-> (ExceptT e m x -> m (Either e x))
-> ExceptT e m x
-> m (Maybe x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT e m x -> m (Either e x)
forall e (m :: Type -> Type) a. ExceptT e m a -> m (Either e a)
runExceptT

{- | Converts a list to an 'Automaton' in 'MaybeT', which outputs an element of the
list at each step, throwing 'Nothing' when the list ends.
-}
listToMaybeS :: (Functor m, Monad m) => [b] -> Automaton (MaybeT m) a b
listToMaybeS :: forall (m :: Type -> Type) b a.
(Functor m, Monad m) =>
[b] -> Automaton (MaybeT m) a b
listToMaybeS = Automaton (ExceptT () m) a b -> Automaton (MaybeT m) a b
forall (m :: Type -> Type) e a b.
(Functor m, Monad m) =>
Automaton (ExceptT e m) a b -> Automaton (MaybeT m) a b
exceptToMaybeS (Automaton (ExceptT () m) a b -> Automaton (MaybeT m) a b)
-> ([b] -> Automaton (ExceptT () m) a b)
-> [b]
-> Automaton (MaybeT m) a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AutomatonExcept a b m () -> Automaton (ExceptT () m) a b
forall (m :: Type -> Type) a b e.
Monad m =>
AutomatonExcept a b m e -> Automaton (ExceptT e m) a b
runAutomatonExcept (AutomatonExcept a b m () -> Automaton (ExceptT () m) a b)
-> ([b] -> AutomatonExcept a b m ())
-> [b]
-> Automaton (ExceptT () m) a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> AutomatonExcept a b m ()
forall (m :: Type -> Type) b a.
Monad m =>
[b] -> AutomatonExcept a b m ()
listToAutomatonExcept

-- * Running 'MaybeT'

{- | Remove the 'MaybeT' layer by outputting 'Nothing' when the exception occurs.

The current state is then tested again on the next input.
-}
runMaybeS :: (Functor m, Monad m) => Automaton (MaybeT m) a b -> Automaton m a (Maybe b)
runMaybeS :: forall (m :: Type -> Type) a b.
(Functor m, Monad m) =>
Automaton (MaybeT m) a b -> Automaton m a (Maybe b)
runMaybeS Automaton (MaybeT m) a b
automaton = Automaton (ExceptT () m) a b -> Automaton m a (Either () b)
forall (m :: Type -> Type) e a b.
(Functor m, Monad m) =>
Automaton (ExceptT e m) a b -> Automaton m a (Either e b)
exceptS (Automaton (MaybeT m) a b -> Automaton (ExceptT () m) a b
forall (m :: Type -> Type) a b.
(Functor m, Monad m) =>
Automaton (MaybeT m) a b -> Automaton (ExceptT () m) a b
maybeToExceptS Automaton (MaybeT m) a b
automaton) Automaton m a (Either () b)
-> Automaton m (Either () b) (Maybe b) -> Automaton m a (Maybe b)
forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Either () b -> Maybe b) -> Automaton m (Either () b) (Maybe b)
forall b c. (b -> c) -> Automaton m b c
forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr Either () b -> Maybe b
forall {a}. Either () a -> Maybe a
eitherToMaybe
  where
    eitherToMaybe :: Either () a -> Maybe a
eitherToMaybe (Left ()) = Maybe a
forall a. Maybe a
Nothing
    eitherToMaybe (Right a
b) = a -> Maybe a
forall a. a -> Maybe a
Just a
b

-- | 'reactimate's an 'Automaton' in the 'MaybeT' monad until it throws 'Nothing'.
reactimateMaybe ::
  (Functor m, Monad m) =>
  Automaton (MaybeT m) () () ->
  m ()
reactimateMaybe :: forall (m :: Type -> Type).
(Functor m, Monad m) =>
Automaton (MaybeT m) () () -> m ()
reactimateMaybe Automaton (MaybeT m) () ()
automaton = AutomatonExcept () () m () -> m ()
forall (m :: Type -> Type) e.
Monad m =>
AutomatonExcept () () m e -> m e
reactimateExcept (AutomatonExcept () () m () -> m ())
-> AutomatonExcept () () m () -> m ()
forall a b. (a -> b) -> a -> b
$ Automaton (ExceptT () m) () () -> AutomatonExcept () () m ()
forall (m :: Type -> Type) e a b.
Monad m =>
Automaton (ExceptT e m) a b -> AutomatonExcept a b m e
try (Automaton (ExceptT () m) () () -> AutomatonExcept () () m ())
-> Automaton (ExceptT () m) () () -> AutomatonExcept () () m ()
forall a b. (a -> b) -> a -> b
$ Automaton (MaybeT m) () () -> Automaton (ExceptT () m) () ()
forall (m :: Type -> Type) a b.
(Functor m, Monad m) =>
Automaton (MaybeT m) a b -> Automaton (ExceptT () m) a b
maybeToExceptS Automaton (MaybeT m) () ()
automaton

{- | Run an 'Automaton' fed from a list, discarding results. Useful when one needs to
combine effects and streams (i.e., for testing purposes).
-}
embed_ :: (Functor m, Monad m) => Automaton m a () -> [a] -> m ()
embed_ :: forall (m :: Type -> Type) a.
(Functor m, Monad m) =>
Automaton m a () -> [a] -> m ()
embed_ Automaton m a ()
automaton [a]
as = Automaton (MaybeT m) () () -> m ()
forall (m :: Type -> Type).
(Functor m, Monad m) =>
Automaton (MaybeT m) () () -> m ()
reactimateMaybe (Automaton (MaybeT m) () () -> m ())
-> Automaton (MaybeT m) () () -> m ()
forall a b. (a -> b) -> a -> b
$ [a] -> Automaton (MaybeT m) () a
forall (m :: Type -> Type) b a.
(Functor m, Monad m) =>
[b] -> Automaton (MaybeT m) a b
listToMaybeS [a]
as Automaton (MaybeT m) () a
-> Automaton (MaybeT m) a () -> Automaton (MaybeT m) () ()
forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Automaton m a () -> Automaton (MaybeT m) a ()
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a
       b.
(MonadTrans t, Monad m, Functor (t m)) =>
Automaton m a b -> Automaton (t m) a b
liftS Automaton m a ()
automaton