{-# LANGUAGE Arrows #-}
-- |
-- Copyright  : (c) Ivan Perez and Manuel Baerenz, 2016
-- License    : BSD3
-- Maintainer : ivan.perez@keera.co.uk
--
-- The 'Maybe' monad is very versatile. It can stand for default arguments,
-- for absent values, and for (nondescript) exceptions. The latter viewpoint
-- is most natural in the context of 'MSF's.
module Control.Monad.Trans.MSF.Maybe
    ( module Control.Monad.Trans.MSF.Maybe
    , module Control.Monad.Trans.Maybe
    , maybeToExceptS
    )
  where

-- External imports
import Control.Arrow             (returnA, (>>>), arr)
import Control.Monad.Trans.Maybe hiding (liftCallCC, liftCatch, liftListen,
                                  liftPass)

-- Internal imports
import Control.Monad.Trans.MSF.Except (ExceptT, exceptS, listToMSFExcept,
                                       maybeToExceptS, reactimateExcept,
                                       runExceptT, runMSFExcept, safe, safely,
                                       try)
import Data.MonadicStreamFunction     (MSF, arrM, constM, liftTransS, morphS)

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

-- | Throw the exception immediately.
exit :: Monad m => MSF (MaybeT m) a b
exit :: forall (m :: * -> *) a b. Monad m => MSF (MaybeT m) a b
exit = MaybeT m b -> MSF (MaybeT m) a b
forall (m :: * -> *) b a. Monad m => m b -> MSF m a b
constM (MaybeT m b -> MSF (MaybeT m) a b)
-> MaybeT m b -> MSF (MaybeT m) a b
forall a b. (a -> b) -> a -> b
$ m (Maybe b) -> MaybeT m b
forall (m :: * -> *) 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 :: * -> *) 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) -> MSF (MaybeT m) a a
exitWhen :: forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> MSF (MaybeT m) a a
exitWhen a -> Bool
condition = proc a
a -> do
  ()
_ <- MSF (MaybeT m) Bool ()
forall (m :: * -> *). Monad m => MSF (MaybeT m) Bool ()
exitIf -< a -> Bool
condition a
a
  MSF (MaybeT m) a a
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA     -< a
a

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

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

-- | Embed a 'Maybe' value in the 'MaybeT' layer. Identical to 'maybeExit'.
inMaybeT :: Monad m => MSF (MaybeT m) (Maybe a) a
inMaybeT :: forall (m :: * -> *) a. Monad m => MSF (MaybeT m) (Maybe a) a
inMaybeT = (Maybe a -> MaybeT m a) -> MSF (MaybeT m) (Maybe a) a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> MSF m a b
arrM ((Maybe a -> MaybeT m a) -> MSF (MaybeT m) (Maybe a) a)
-> (Maybe a -> MaybeT m a) -> MSF (MaybeT m) (Maybe a) a
forall a b. (a -> b) -> a -> b
$ m (Maybe a) -> MaybeT m a
forall (m :: * -> *) 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 :: * -> *) a. Monad m => a -> m a
return

-- * Catching Maybe exceptions

-- | Run the first @msf@ until the second one produces 'True' from the output
-- of the first.
untilMaybe :: Monad m => MSF m a b -> MSF m b Bool -> MSF (MaybeT m) a b
untilMaybe :: forall (m :: * -> *) a b.
Monad m =>
MSF m a b -> MSF m b Bool -> MSF (MaybeT m) a b
untilMaybe MSF m a b
msf MSF m b Bool
cond = proc a
a -> do
  b
b <- MSF m a b -> MSF (MaybeT m) a b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(MonadTrans t, Monad m, Monad (t m)) =>
MSF m a b -> MSF (t m) a b
liftTransS MSF m a b
msf  -< a
a
  Bool
c <- MSF m b Bool -> MSF (MaybeT m) b Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(MonadTrans t, Monad m, Monad (t m)) =>
MSF m a b -> MSF (t m) a b
liftTransS MSF m b Bool
cond -< b
b
  MSF (MaybeT m) (Maybe b) b
forall (m :: * -> *) a. Monad m => MSF (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 'msf', the second 'msf' is executed
-- from there.
catchMaybe :: (Functor m, Monad m)
           => MSF (MaybeT m) a b
           -> MSF m a b
           -> MSF m a b
catchMaybe :: forall (m :: * -> *) a b.
(Functor m, Monad m) =>
MSF (MaybeT m) a b -> MSF m a b -> MSF m a b
catchMaybe MSF (MaybeT m) a b
msf1 MSF m a b
msf2 = MSFExcept m a b Void -> MSF m a b
forall (m :: * -> *) a b.
Monad m =>
MSFExcept m a b Void -> MSF m a b
safely (MSFExcept m a b Void -> MSF m a b)
-> MSFExcept m a b Void -> MSF m a b
forall a b. (a -> b) -> a -> b
$ do
  ()
_ <- MSF (ExceptT () m) a b -> MSFExcept m a b ()
forall e (m :: * -> *) a b.
MSF (ExceptT e m) a b -> MSFExcept m a b e
try (MSF (ExceptT () m) a b -> MSFExcept m a b ())
-> MSF (ExceptT () m) a b -> MSFExcept m a b ()
forall a b. (a -> b) -> a -> b
$ MSF (MaybeT m) a b -> MSF (ExceptT () m) a b
forall (m :: * -> *) a b.
(Functor m, Monad m) =>
MSF (MaybeT m) a b -> MSF (ExceptT () m) a b
maybeToExceptS MSF (MaybeT m) a b
msf1
  MSF m a b -> MSFExcept m a b Void
forall (m :: * -> *) a b e.
Monad m =>
MSF m a b -> MSFExcept m a b e
safe MSF m a b
msf2

-- * Converting to and from 'MaybeT'

-- | Convert exceptions into `Nothing`, discarding the exception value.
exceptToMaybeS :: (Functor m, Monad m)
               => MSF (ExceptT e m) a b
               -> MSF (MaybeT m) a b
exceptToMaybeS :: forall (m :: * -> *) e a b.
(Functor m, Monad m) =>
MSF (ExceptT e m) a b -> MSF (MaybeT m) a b
exceptToMaybeS =
  (forall c. ExceptT e m c -> MaybeT m c)
-> MSF (ExceptT e m) a b -> MSF (MaybeT m) a b
forall (m2 :: * -> *) (m1 :: * -> *) a b.
(Monad m2, Monad m1) =>
(forall c. m1 c -> m2 c) -> MSF m1 a b -> MSF m2 a b
morphS ((forall c. ExceptT e m c -> MaybeT m c)
 -> MSF (ExceptT e m) a b -> MSF (MaybeT m) a b)
-> (forall c. ExceptT e m c -> MaybeT m c)
-> MSF (ExceptT e m) a b
-> MSF (MaybeT m) a b
forall a b. (a -> b) -> a -> b
$ m (Maybe c) -> MaybeT m c
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe c) -> MaybeT m c)
-> (ExceptT e m c -> m (Maybe c)) -> ExceptT e m c -> MaybeT m c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either e c -> Maybe c) -> m (Either e c) -> m (Maybe c)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((e -> Maybe c) -> (c -> Maybe c) -> Either e c -> Maybe c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe c -> e -> Maybe c
forall a b. a -> b -> a
const Maybe c
forall a. Maybe a
Nothing) c -> Maybe c
forall a. a -> Maybe a
Just) (m (Either e c) -> m (Maybe c))
-> (ExceptT e m c -> m (Either e c))
-> ExceptT e m c
-> m (Maybe c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT e m c -> m (Either e c)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT

-- | Converts a list to an 'MSF' in 'MaybeT', which outputs an element of the
-- list at each step, throwing 'Nothing' when the list ends.
listToMaybeS :: (Functor m, Monad m) => [b] -> MSF (MaybeT m) a b
listToMaybeS :: forall (m :: * -> *) b a.
(Functor m, Monad m) =>
[b] -> MSF (MaybeT m) a b
listToMaybeS = MSF (ExceptT () m) a b -> MSF (MaybeT m) a b
forall (m :: * -> *) e a b.
(Functor m, Monad m) =>
MSF (ExceptT e m) a b -> MSF (MaybeT m) a b
exceptToMaybeS (MSF (ExceptT () m) a b -> MSF (MaybeT m) a b)
-> ([b] -> MSF (ExceptT () m) a b) -> [b] -> MSF (MaybeT m) a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MSFExcept m a b () -> MSF (ExceptT () m) a b
forall (m :: * -> *) a b e.
MSFExcept m a b e -> MSF (ExceptT e m) a b
runMSFExcept (MSFExcept m a b () -> MSF (ExceptT () m) a b)
-> ([b] -> MSFExcept m a b ()) -> [b] -> MSF (ExceptT () m) a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> MSFExcept m a b ()
forall (m :: * -> *) b a. Monad m => [b] -> MSFExcept m a b ()
listToMSFExcept

-- * Running 'MaybeT'

-- | Remove the 'MaybeT' layer by outputting 'Nothing' when the exception
-- occurs. The continuation in which the exception occurred is then tested on
-- the next input.
runMaybeS :: (Functor m, Monad m) => MSF (MaybeT m) a b -> MSF m a (Maybe b)
runMaybeS :: forall (m :: * -> *) a b.
(Functor m, Monad m) =>
MSF (MaybeT m) a b -> MSF m a (Maybe b)
runMaybeS MSF (MaybeT m) a b
msf = MSF (ExceptT () m) a b -> MSF m a (Either () b)
forall (m :: * -> *) e a b.
(Functor m, Monad m) =>
MSF (ExceptT e m) a b -> MSF m a (Either e b)
exceptS (MSF (MaybeT m) a b -> MSF (ExceptT () m) a b
forall (m :: * -> *) a b.
(Functor m, Monad m) =>
MSF (MaybeT m) a b -> MSF (ExceptT () m) a b
maybeToExceptS MSF (MaybeT m) a b
msf) MSF m a (Either () b)
-> MSF m (Either () b) (Maybe b) -> MSF m a (Maybe b)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Either () b -> Maybe b) -> MSF m (Either () b) (Maybe b)
forall b c. (b -> c) -> MSF m b c
forall (a :: * -> * -> *) 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

-- | Reactimates an 'MSF' in the 'MaybeT' monad until it throws 'Nothing'.
reactimateMaybe :: (Functor m, Monad m)
                => MSF (MaybeT m) () ()
                -> m ()
reactimateMaybe :: forall (m :: * -> *).
(Functor m, Monad m) =>
MSF (MaybeT m) () () -> m ()
reactimateMaybe MSF (MaybeT m) () ()
msf = MSFExcept m () () () -> m ()
forall (m :: * -> *) e. Monad m => MSFExcept m () () e -> m e
reactimateExcept (MSFExcept m () () () -> m ()) -> MSFExcept m () () () -> m ()
forall a b. (a -> b) -> a -> b
$ MSF (ExceptT () m) () () -> MSFExcept m () () ()
forall e (m :: * -> *) a b.
MSF (ExceptT e m) a b -> MSFExcept m a b e
try (MSF (ExceptT () m) () () -> MSFExcept m () () ())
-> MSF (ExceptT () m) () () -> MSFExcept m () () ()
forall a b. (a -> b) -> a -> b
$ MSF (MaybeT m) () () -> MSF (ExceptT () m) () ()
forall (m :: * -> *) a b.
(Functor m, Monad m) =>
MSF (MaybeT m) a b -> MSF (ExceptT () m) a b
maybeToExceptS MSF (MaybeT m) () ()
msf

-- | Run an 'MSF' 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) => MSF m a () -> [a] -> m ()
embed_ :: forall (m :: * -> *) a.
(Functor m, Monad m) =>
MSF m a () -> [a] -> m ()
embed_ MSF m a ()
msf [a]
as = MSF (MaybeT m) () () -> m ()
forall (m :: * -> *).
(Functor m, Monad m) =>
MSF (MaybeT m) () () -> m ()
reactimateMaybe (MSF (MaybeT m) () () -> m ()) -> MSF (MaybeT m) () () -> m ()
forall a b. (a -> b) -> a -> b
$ [a] -> MSF (MaybeT m) () a
forall (m :: * -> *) b a.
(Functor m, Monad m) =>
[b] -> MSF (MaybeT m) a b
listToMaybeS [a]
as MSF (MaybeT m) () a -> MSF (MaybeT m) a () -> MSF (MaybeT m) () ()
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> MSF m a () -> MSF (MaybeT m) a ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(MonadTrans t, Monad m, Monad (t m)) =>
MSF m a b -> MSF (t m) a b
liftTransS MSF m a ()
msf