Except.hs

{-# 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 = arrMCl throwE

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

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

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

-- | Variant of 'throwOn', where the exception can vary every tick.
throwOn' :: Monad m => ClSF (ExceptT e m) cl (Bool, e) ()
throwOn' = proc (b, e) ->
  if b
    then throwS -< e
    else 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 cond e = proc a ->
  if cond a
    then throwS -< e
    else returnA -< 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 cond e = proc a -> do
  b <- arrMCl (lift . cond) -< a
  if b
    then throwS -< e
    else returnA -< a

-- | When the input is @Just e@, throw the exception @e@.
throwMaybe :: Monad m => ClSF (ExceptT e m) cl (Maybe e) (Maybe a)
throwMaybe = proc me -> case me of
  Nothing -> returnA -< Nothing
  Just e -> throwS -< 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 = morphS commuteExceptReader . 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 = MSFE.try . morphS 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 f = MSFE.once $ lift . f

-- | A variant of 'once' without input.
once_ :: Monad m => m e -> ClSFExcept m cl a b e
once_ = once . 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 f = MSFE.step $ lift . f