{-# 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 = forall (m :: * -> *) b a. Monad m => m b -> MSF m a b
constM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return 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
  ()
_ <- forall (m :: * -> *). Monad m => MSF (MaybeT m) Bool ()
exitIf -< a -> Bool
condition 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 forall (m :: * -> *) a b. Monad m => MSF (MaybeT m) a b
exit    -< ()
  else 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 = 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 = forall (m :: * -> *) a b. Monad m => (a -> m b) -> MSF m a b
arrM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 <- 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 <- 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
  forall (m :: * -> *) a. Monad m => MSF (MaybeT m) (Maybe a) a
inMaybeT -< if Bool
c then forall a. Maybe a
Nothing else 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 = forall (m :: * -> *) a b.
Monad m =>
MSFExcept m a b Void -> MSF m a b
safely forall a b. (a -> b) -> a -> b
$ do
  ()
_ <- forall e (m :: * -> *) a b.
MSF (ExceptT e m) a b -> MSFExcept m a b e
try forall a b. (a -> b) -> 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
  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 (m2 :: * -> *) (m1 :: * -> *) a b.
(Monad m2, Monad m1) =>
(forall c. m1 c -> m2 c) -> MSF m1 a b -> MSF m2 a b
morphS forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just) forall b c a. (b -> c) -> (a -> b) -> a -> 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 = forall (m :: * -> *) e a b.
(Functor m, Monad m) =>
MSF (ExceptT e m) a b -> MSF (MaybeT m) a b
exceptToMaybeS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a b e.
MSFExcept m a b e -> MSF (ExceptT e m) a b
runMSFExcept forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) e a b.
(Functor m, Monad m) =>
MSF (ExceptT e m) a b -> MSF m a (Either e b)
exceptS (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) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall {a}. Either () a -> Maybe a
eitherToMaybe
  where
    eitherToMaybe :: Either () a -> Maybe a
eitherToMaybe (Left ()) = forall a. Maybe a
Nothing
    eitherToMaybe (Right a
b) = 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 = forall (m :: * -> *) e. Monad m => MSFExcept m () () e -> m e
reactimateExcept forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a b.
MSF (ExceptT e m) a b -> MSFExcept m a b e
try forall a b. (a -> b) -> a -> b
$ 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 = forall (m :: * -> *).
(Functor m, Monad m) =>
MSF (MaybeT m) () () -> m ()
reactimateMaybe forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b a.
(Functor m, Monad m) =>
[b] -> MSF (MaybeT m) a b
listToMaybeS [a]
as forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> 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