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

{- | 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.
-}
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 Control.Monad.Trans.MSF.Except hiding (once, once_, throwOn, throwOn', throwS, try)
import Data.MonadicStreamFunction

-- 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
import FRP.Rhine.Clock

-- * Throwing exceptions

-- | Immediately throw the incoming exception.
throwS :: Monad m => ClSF (ExceptT e m) cl e a
throwS :: forall (m :: Type -> Type) e cl a.
Monad m =>
ClSF (ExceptT e m) cl e a
throwS = forall (m :: Type -> Type) a b cl.
Monad m =>
(a -> m b) -> ClSF m cl a b
arrMCl 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 :: forall (m :: Type -> Type) e a b.
Monad m =>
e -> MSF (ExceptT e m) a b
throw = forall (m :: Type -> Type) b a. Monad m => m b -> MSF m a b
constM forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: Type -> Type) e a. Monad m => MSF (ExceptT e m) a a
pass = 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 :: forall (m :: Type -> Type) e cl.
Monad m =>
e -> ClSF (ExceptT e m) cl Bool ()
throwOn e
e = proc Bool
b -> 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' :: forall (m :: Type -> Type) e cl.
Monad m =>
ClSF (ExceptT e m) cl (Bool, e) ()
throwOn' = proc (Bool
b, e
e) ->
  if Bool
b
    then forall (m :: Type -> Type) e cl a.
Monad m =>
ClSF (ExceptT e m) cl e a
throwS -< e
e
    else 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 :: forall (m :: Type -> Type) a e cl.
Monad m =>
(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 forall (m :: Type -> Type) e cl a.
Monad m =>
ClSF (ExceptT e m) cl e a
throwS -< e
e
    else 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 :: forall (m :: Type -> Type) a e cl.
Monad m =>
(a -> m Bool) -> e -> ClSF (ExceptT e m) cl a a
throwOnCondM a -> m Bool
cond e
e = proc a
a -> do
  Bool
b <- forall (m :: Type -> Type) a b cl.
Monad m =>
(a -> m b) -> ClSF m cl a b
arrMCl (forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m Bool
cond) -< a
a
  if Bool
b
    then forall (m :: Type -> Type) e cl a.
Monad m =>
ClSF (ExceptT e m) cl e a
throwS -< e
e
    else 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 :: forall (m :: Type -> Type) e cl a.
Monad m =>
ClSF (ExceptT e m) cl (Maybe e) (Maybe a)
throwMaybe = proc Maybe e
me -> case Maybe e
me of
  Maybe e
Nothing -> forall (a :: Type -> Type -> Type) b. Arrow a => a b b
returnA -< forall a. Maybe a
Nothing
  Just e
e -> 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 :: forall (m :: Type -> Type) cl a b e.
Monad m =>
ClSFExcept m cl a b e -> ClSF (ExceptT e m) cl a b
runClSFExcept = 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 e r (m :: Type -> Type) a.
ExceptT e (ReaderT r m) a -> ReaderT r (ExceptT e m) a
commuteExceptReader forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: Type -> Type) e cl a b.
Monad m =>
ClSF (ExceptT e m) cl a b -> ClSFExcept m cl a b e
try = forall e (m :: Type -> Type) a b.
MSF (ExceptT e m) a b -> MSFExcept m a b e
MSFE.try forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 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 :: forall (m :: Type -> Type) a e cl b.
Monad m =>
(a -> m e) -> ClSFExcept m cl a b e
once a -> m e
f = forall (m :: Type -> Type) a e b.
Monad m =>
(a -> m e) -> MSFExcept m a b e
MSFE.once forall a b. (a -> b) -> a -> b
$ forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift 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_ :: forall (m :: Type -> Type) e cl a b.
Monad m =>
m e -> ClSFExcept m cl a b e
once_ = forall (m :: Type -> Type) a e cl b.
Monad m =>
(a -> m e) -> ClSFExcept m cl a b e
once forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: Type -> Type) a b e cl.
Monad m =>
(a -> m (b, e)) -> ClSFExcept m cl a b e
step a -> m (b, e)
f = forall (m :: Type -> Type) a b e.
Monad m =>
(a -> m (b, e)) -> MSFExcept m a b e
MSFE.step forall a b. (a -> b) -> a -> b
$ forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (b, e)
f