{-# 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 @automaton@'s "Data.Automaton.Trans.Except",
and reexports everything needed from there.
-}
module FRP.Rhine.ClSF.Except (
  module FRP.Rhine.ClSF.Except,
  module X,
  safe,
  safely,
  exceptS,
  runAutomatonExcept,
  currentInput,
)
where

-- base
import Control.Category qualified as Category

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

-- automaton
import Data.Automaton.Trans.Except hiding (once, once_, throwOn, throwOn', throwS, try)
import Data.Automaton.Trans.Except qualified as AutomatonE

-- 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 = (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 -> Automaton (ExceptT e m) a b
throw :: forall (m :: Type -> Type) e a b.
Monad m =>
e -> Automaton (ExceptT e m) a b
throw = ExceptT e m b -> Automaton (ExceptT e m) a b
forall (m :: Type -> Type) b a. Functor m => m b -> Automaton m a b
constM (ExceptT e m b -> Automaton (ExceptT e m) a b)
-> (e -> ExceptT e m b) -> e -> Automaton (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) => Automaton (ExceptT e m) a a
pass :: forall (m :: Type -> Type) e a.
Monad m =>
Automaton (ExceptT e m) a a
pass = Automaton (ExceptT e m) a a
forall a. Automaton (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 :: forall (m :: Type -> Type) e cl.
Monad m =>
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' :: 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 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 Automaton (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 :: 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 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 Automaton (ReaderT (TimeInfo cl) (ExceptT e m)) 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 :: 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 <- (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 (m :: Type -> Type) a. Monad m => m a -> ExceptT e m a
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 Automaton (ReaderT (TimeInfo cl) (ExceptT e m)) 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 :: 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 -> Automaton (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 @automaton@, 'AutomatonExcept',
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 'AutomatonExcept'.)

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

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

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

-- | Leave the monad context, to use the 'ClSFExcept' as an 'Arrow'.
runClSFExcept :: (Monad m) => ClSFExcept cl a b m e -> ClSF (ExceptT e m) cl a b
runClSFExcept :: forall (m :: Type -> Type) cl a b e.
Monad m =>
ClSFExcept cl a b m e -> ClSF (ExceptT e m) cl a b
runClSFExcept = (forall x.
 ExceptT e (ReaderT (TimeInfo cl) m) x
 -> ReaderT (TimeInfo cl) (ExceptT e m) x)
-> Automaton (ExceptT e (ReaderT (TimeInfo cl) m)) a b
-> Automaton (ReaderT (TimeInfo cl) (ExceptT e m)) a b
forall (m :: Type -> Type) (n :: Type -> Type) a b.
Monad m =>
(forall x. m x -> n x) -> Automaton m a b -> Automaton n a b
hoistS ExceptT e (ReaderT (TimeInfo cl) m) x
-> ReaderT (TimeInfo cl) (ExceptT e m) x
forall x.
ExceptT e (ReaderT (TimeInfo cl) m) x
-> ReaderT (TimeInfo cl) (ExceptT e m) x
forall e r (m :: Type -> Type) a.
ExceptT e (ReaderT r m) a -> ReaderT r (ExceptT e m) a
commuteExceptReader (Automaton (ExceptT e (ReaderT (TimeInfo cl) m)) a b
 -> Automaton (ReaderT (TimeInfo cl) (ExceptT e m)) a b)
-> (ClSFExcept cl a b m e
    -> Automaton (ExceptT e (ReaderT (TimeInfo cl) m)) a b)
-> ClSFExcept cl a b m e
-> Automaton (ReaderT (TimeInfo cl) (ExceptT e m)) a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClSFExcept cl a b m e
-> Automaton (ExceptT e (ReaderT (TimeInfo cl) m)) a b
forall (m :: Type -> Type) a b e.
Monad m =>
AutomatonExcept a b m e -> Automaton (ExceptT e m) a b
runAutomatonExcept

{- | 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 cl a b m e
try :: forall (m :: Type -> Type) e cl a b.
Monad m =>
ClSF (ExceptT e m) cl a b -> ClSFExcept cl a b m e
try = Automaton (ExceptT e (ReaderT (TimeInfo cl) m)) a b
-> AutomatonExcept a b (ReaderT (TimeInfo cl) m) e
forall (m :: Type -> Type) e a b.
Monad m =>
Automaton (ExceptT e m) a b -> AutomatonExcept a b m e
AutomatonE.try (Automaton (ExceptT e (ReaderT (TimeInfo cl) m)) a b
 -> AutomatonExcept a b (ReaderT (TimeInfo cl) m) e)
-> (ClSF (ExceptT e m) cl a b
    -> Automaton (ExceptT e (ReaderT (TimeInfo cl) m)) a b)
-> ClSF (ExceptT e m) cl a b
-> AutomatonExcept a b (ReaderT (TimeInfo cl) m) e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x.
 ReaderT (TimeInfo cl) (ExceptT e m) x
 -> ExceptT e (ReaderT (TimeInfo cl) m) x)
-> ClSF (ExceptT e m) cl a b
-> Automaton (ExceptT e (ReaderT (TimeInfo cl) m)) a b
forall (m :: Type -> Type) (n :: Type -> Type) a b.
Monad m =>
(forall x. m x -> n x) -> Automaton m a b -> Automaton n a b
hoistS ReaderT (TimeInfo cl) (ExceptT e m) x
-> ExceptT e (ReaderT (TimeInfo cl) m) x
forall x.
ReaderT (TimeInfo cl) (ExceptT e m) x
-> ExceptT e (ReaderT (TimeInfo cl) m) x
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 cl a b m e
once :: forall (m :: Type -> Type) a e cl b.
Monad m =>
(a -> m e) -> ClSFExcept cl a b m e
once a -> m e
f = (a -> ReaderT (TimeInfo cl) m e)
-> AutomatonExcept a b (ReaderT (TimeInfo cl) m) e
forall (m :: Type -> Type) a e b.
Monad m =>
(a -> m e) -> AutomatonExcept a b m e
AutomatonE.once ((a -> ReaderT (TimeInfo cl) m e)
 -> AutomatonExcept a b (ReaderT (TimeInfo cl) m) e)
-> (a -> ReaderT (TimeInfo cl) m e)
-> AutomatonExcept a b (ReaderT (TimeInfo cl) m) e
forall a b. (a -> b) -> a -> b
$ m e -> ReaderT (TimeInfo cl) m e
forall (m :: Type -> Type) a.
Monad m =>
m a -> ReaderT (TimeInfo cl) m a
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 cl a b m e
once_ :: forall (m :: Type -> Type) e cl a b.
Monad m =>
m e -> ClSFExcept cl a b m e
once_ = (a -> m e) -> ClSFExcept cl a b m e
forall (m :: Type -> Type) a e cl b.
Monad m =>
(a -> m e) -> ClSFExcept cl a b m e
once ((a -> m e) -> ClSFExcept cl a b m e)
-> (m e -> a -> m e) -> m e -> ClSFExcept cl a b m 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 cl a b m e
step :: forall (m :: Type -> Type) a b e cl.
Monad m =>
(a -> m (b, e)) -> ClSFExcept cl a b m e
step a -> m (b, e)
f = (a -> ReaderT (TimeInfo cl) m (b, e))
-> AutomatonExcept a b (ReaderT (TimeInfo cl) m) e
forall (m :: Type -> Type) a b e.
Monad m =>
(a -> m (b, e)) -> AutomatonExcept a b m e
AutomatonE.step ((a -> ReaderT (TimeInfo cl) m (b, e))
 -> AutomatonExcept a b (ReaderT (TimeInfo cl) m) e)
-> (a -> ReaderT (TimeInfo cl) m (b, e))
-> AutomatonExcept a b (ReaderT (TimeInfo cl) m) e
forall a b. (a -> b) -> a -> b
$ m (b, e) -> ReaderT (TimeInfo cl) m (b, e)
forall (m :: Type -> Type) a.
Monad m =>
m a -> ReaderT (TimeInfo cl) m a
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