{- | This module provides exception handling, and thus control flow,
to synchronous signal functions.

The API presented here closely follows dunai's 'Control.Monad.Trans.MSF.Except',
and reexports everything needed from there.
-}

{-# LANGUAGE Arrows #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}

module FRP.Rhine.ClSF.Except
  ( module FRP.Rhine.ClSF.Except
  , module X
  , safe, safely, exceptS, runMSFExcept, currentInput
  )
  where

-- base
import qualified Control.Category as Category

-- transformers
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except as X
import Control.Monad.Trans.Reader

-- dunai
import Data.MonadicStreamFunction
import Control.Monad.Trans.MSF.Except hiding (try, once, once_, throwOn, throwOn', throwS)
-- TODO Find out whether there is a cleverer way to handle exports
import qualified Control.Monad.Trans.MSF.Except as MSFE

-- rhine
import FRP.Rhine.ClSF.Core
import FRP.Rhine.ClSF.Except.Util

-- * Throwing exceptions


-- | Immediately throw the incoming exception.
throwS :: Monad m => ClSF (ExceptT e m) cl e a
throwS :: ClSF (ExceptT e m) cl e a
throwS = (e -> ExceptT e m a) -> ClSF (ExceptT e m) cl e a
forall (m :: Type -> Type) a b cl.
Monad m =>
(a -> m b) -> ClSF m cl a b
arrMCl e -> ExceptT e m a
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE

-- | Immediately throw the given exception.
throw :: Monad m => e -> MSF (ExceptT e m) a b
throw :: e -> MSF (ExceptT e m) a b
throw = ExceptT e m b -> MSF (ExceptT e m) a b
forall (m :: Type -> Type) b a. Monad m => m b -> MSF m a b
constM (ExceptT e m b -> MSF (ExceptT e m) a b)
-> (e -> ExceptT e m b) -> e -> MSF (ExceptT e m) a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ExceptT e m b
forall (m :: Type -> Type) e a. Monad m => e -> ExceptT e m a
throwE

-- | Do not throw an exception.
pass :: Monad m => MSF (ExceptT e m) a a
pass :: MSF (ExceptT e m) a a
pass = MSF (ExceptT e m) a a
forall k (cat :: k -> k -> Type) (a :: k). Category cat => cat a a
Category.id

-- | Throw the given exception when the 'Bool' turns true.
throwOn :: Monad m => e -> ClSF (ExceptT e m) cl Bool ()
throwOn :: e -> ClSF (ExceptT e m) cl Bool ()
throwOn e
e = proc Bool
b -> ClSF (ExceptT e m) cl (Bool, e) ()
forall (m :: Type -> Type) e cl.
Monad m =>
ClSF (ExceptT e m) cl (Bool, e) ()
throwOn' -< (Bool
b, e
e)

-- | Variant of 'throwOn', where the exception can vary every tick.
throwOn' :: Monad m => ClSF (ExceptT e m) cl (Bool, e) ()
throwOn' :: ClSF (ExceptT e m) cl (Bool, e) ()
throwOn' = proc (Bool
b, e
e) -> if Bool
b
  then ClSF (ExceptT e m) cl e ()
forall (m :: Type -> Type) e cl a.
Monad m =>
ClSF (ExceptT e m) cl e a
throwS  -< e
e
  else MSF (ReaderT (TimeInfo cl) (ExceptT e m)) () ()
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< ()

-- | Throw the exception 'e' whenever the function evaluates to 'True'.
throwOnCond :: Monad m => (a -> Bool) -> e -> ClSF (ExceptT e m) cl a a
throwOnCond :: (a -> Bool) -> e -> ClSF (ExceptT e m) cl a a
throwOnCond a -> Bool
cond e
e = proc a
a -> if a -> Bool
cond a
a
  then ClSF (ExceptT e m) cl e a
forall (m :: Type -> Type) e cl a.
Monad m =>
ClSF (ExceptT e m) cl e a
throwS  -< e
e
  else ClSF (ExceptT e m) cl a a
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< a
a

-- | Variant of 'throwOnCond' for Kleisli arrows.
-- | Throws the exception when the input is 'True'.
throwOnCondM :: Monad m => (a -> m Bool) -> e -> ClSF (ExceptT e m) cl a a
throwOnCondM :: (a -> m Bool) -> e -> ClSF (ExceptT e m) cl a a
throwOnCondM a -> m Bool
cond e
e = proc a
a -> do
  Bool
b <- (a -> ExceptT e m Bool) -> ClSF (ExceptT e m) cl a Bool
forall (m :: Type -> Type) a b cl.
Monad m =>
(a -> m b) -> ClSF m cl a b
arrMCl (m Bool -> ExceptT e m Bool
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> ExceptT e m Bool)
-> (a -> m Bool) -> a -> ExceptT e m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m Bool
cond) -< a
a
  if Bool
b
    then ClSF (ExceptT e m) cl e a
forall (m :: Type -> Type) e cl a.
Monad m =>
ClSF (ExceptT e m) cl e a
throwS  -< e
e
    else ClSF (ExceptT e m) cl a a
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< a
a

-- | When the input is @Just e@, throw the exception @e@.
throwMaybe :: Monad m => ClSF (ExceptT e m) cl (Maybe e) (Maybe a)
throwMaybe :: ClSF (ExceptT e m) cl (Maybe e) (Maybe a)
throwMaybe = proc Maybe e
me -> case Maybe e
me of
  Maybe e
Nothing -> MSF (ReaderT (TimeInfo cl) (ExceptT e m)) (Maybe a) (Maybe a)
forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< Maybe a
forall a. Maybe a
Nothing
  Just e
e  -> ClSF (ExceptT e m) cl e (Maybe a)
forall (m :: Type -> Type) e cl a.
Monad m =>
ClSF (ExceptT e m) cl e a
throwS  -< e
e

-- * Monad interface

{- | A synchronous exception-throwing signal function.
It is based on a @newtype@ from Dunai, 'MSFExcept',
to exhibit a monad interface /in the exception type/.
`return` then corresponds to throwing an exception,
and `(>>=)` is exception handling.
(For more information, see the documentation of 'MSFExcept'.)

* @m@:  The monad that the signal function may take side effects in
* @cl@: The clock on which the signal function ticks
* @a@:  The input type
* @b@:  The output type
* @e@:  The type of exceptions that can be thrown
-}
type ClSFExcept m cl a b e = MSFExcept (ReaderT (TimeInfo cl) m) a b e

{- | A clock polymorphic 'ClSFExcept',
or equivalently an exception-throwing behaviour.
Any clock with time domain @time@ may occur.
-}
type BehaviourFExcept m time a b e
  = forall cl. time ~ Time cl => ClSFExcept m cl a b e

-- | Compatibility to U.S. american spelling.
type BehaviorFExcept m time a b e = BehaviourFExcept m time a b e


-- | Leave the monad context, to use the 'ClSFExcept' as an 'Arrow'.
runClSFExcept :: Monad m => ClSFExcept m cl a b e -> ClSF (ExceptT e m) cl a b
runClSFExcept :: ClSFExcept m cl a b e -> ClSF (ExceptT e m) cl a b
runClSFExcept = (forall c.
 ExceptT e (ReaderT (TimeInfo cl) m) c
 -> ReaderT (TimeInfo cl) (ExceptT e m) c)
-> MSF (ExceptT e (ReaderT (TimeInfo cl) m)) a b
-> ClSF (ExceptT e m) cl a b
forall (m2 :: Type -> Type) (m1 :: Type -> Type) 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 (ReaderT (TimeInfo cl) m) c
-> ReaderT (TimeInfo cl) (ExceptT e m) c
forall e r (m :: Type -> Type) a.
ExceptT e (ReaderT r m) a -> ReaderT r (ExceptT e m) a
commuteExceptReader (MSF (ExceptT e (ReaderT (TimeInfo cl) m)) a b
 -> ClSF (ExceptT e m) cl a b)
-> (ClSFExcept m cl a b e
    -> MSF (ExceptT e (ReaderT (TimeInfo cl) m)) a b)
-> ClSFExcept m cl a b e
-> ClSF (ExceptT e m) cl a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClSFExcept m cl a b e
-> MSF (ExceptT e (ReaderT (TimeInfo cl) m)) a b
forall (m :: Type -> Type) a b e.
MSFExcept m a b e -> MSF (ExceptT e m) a b
runMSFExcept

-- | Enter the monad context in the exception
--   for 'ClSF's in the 'ExceptT' monad.
--   The 'ClSF' will be run until it encounters an exception.
try :: Monad m => ClSF (ExceptT e m) cl a b -> ClSFExcept m cl a b e
try :: ClSF (ExceptT e m) cl a b -> ClSFExcept m cl a b e
try = MSF (ExceptT e (ReaderT (TimeInfo cl) m)) a b
-> ClSFExcept m cl a b e
forall e (m :: Type -> Type) a b.
MSF (ExceptT e m) a b -> MSFExcept m a b e
MSFE.try (MSF (ExceptT e (ReaderT (TimeInfo cl) m)) a b
 -> ClSFExcept m cl a b e)
-> (ClSF (ExceptT e m) cl a b
    -> MSF (ExceptT e (ReaderT (TimeInfo cl) m)) a b)
-> ClSF (ExceptT e m) cl a b
-> ClSFExcept m cl a b e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall c.
 ReaderT (TimeInfo cl) (ExceptT e m) c
 -> ExceptT e (ReaderT (TimeInfo cl) m) c)
-> ClSF (ExceptT e m) cl a b
-> MSF (ExceptT e (ReaderT (TimeInfo cl) m)) a b
forall (m2 :: Type -> Type) (m1 :: Type -> Type) a b.
(Monad m2, Monad m1) =>
(forall c. m1 c -> m2 c) -> MSF m1 a b -> MSF m2 a b
morphS forall c.
ReaderT (TimeInfo cl) (ExceptT e m) c
-> ExceptT e (ReaderT (TimeInfo cl) m) c
forall r e (m :: Type -> Type) a.
ReaderT r (ExceptT e m) a -> ExceptT e (ReaderT r m) a
commuteReaderExcept

-- | Within the same tick, perform a monadic action,
--   and immediately throw the value as an exception.
once :: Monad m => (a -> m e) -> ClSFExcept m cl a b e
once :: (a -> m e) -> ClSFExcept m cl a b e
once a -> m e
f = (a -> ReaderT (TimeInfo cl) m e) -> ClSFExcept m cl a b e
forall (m :: Type -> Type) a e b.
Monad m =>
(a -> m e) -> MSFExcept m a b e
MSFE.once ((a -> ReaderT (TimeInfo cl) m e) -> ClSFExcept m cl a b e)
-> (a -> ReaderT (TimeInfo cl) m e) -> ClSFExcept m cl a b e
forall a b. (a -> b) -> a -> b
$ m e -> ReaderT (TimeInfo cl) m e
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m e -> ReaderT (TimeInfo cl) m e)
-> (a -> m e) -> a -> ReaderT (TimeInfo cl) m e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m e
f

-- | A variant of 'once' without input.
once_ :: Monad m => m e -> ClSFExcept m cl a b e
once_ :: m e -> ClSFExcept m cl a b e
once_ = (a -> m e) -> ClSFExcept m cl a b e
forall (m :: Type -> Type) a e cl b.
Monad m =>
(a -> m e) -> ClSFExcept m cl a b e
once ((a -> m e) -> ClSFExcept m cl a b e)
-> (m e -> a -> m e) -> m e -> ClSFExcept m cl a b e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m e -> a -> m e
forall a b. a -> b -> a
const


-- | Advances a single tick with the given Kleisli arrow,
--   and then throws an exception.
step :: Monad m => (a -> m (b, e)) -> ClSFExcept m cl a b e
step :: (a -> m (b, e)) -> ClSFExcept m cl a b e
step a -> m (b, e)
f = (a -> ReaderT (TimeInfo cl) m (b, e)) -> ClSFExcept m cl a b e
forall (m :: Type -> Type) a b e.
Monad m =>
(a -> m (b, e)) -> MSFExcept m a b e
MSFE.step ((a -> ReaderT (TimeInfo cl) m (b, e)) -> ClSFExcept m cl a b e)
-> (a -> ReaderT (TimeInfo cl) m (b, e)) -> ClSFExcept m cl a b e
forall a b. (a -> b) -> a -> b
$ m (b, e) -> ReaderT (TimeInfo cl) m (b, e)
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (b, e) -> ReaderT (TimeInfo cl) m (b, e))
-> (a -> m (b, e)) -> a -> ReaderT (TimeInfo cl) m (b, e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (b, e)
f