-- |
-- Copyright  : (c) Ivan Perez, 2019-2022
--              (c) Ivan Perez and Manuel Baerenz, 2016-2018
-- License    : BSD3
-- Maintainer : ivan.perez@keera.co.uk
module FRP.Yampa (module X, SF, FutureSF, embed, reactimate) where

-- External imports
import Control.Monad.Reader  (mapReaderT)
import Data.Functor.Identity (Identity, runIdentity)

-- Internal imports
import           FRP.BearRiver      as X hiding (FutureSF, SF, embed, loopPre,
                                          reactimate)
import qualified FRP.BearRiver      as BR
import           FRP.BearRiver.Loop as X

-- | Signal function (conceptually, a function between signals that respects
-- causality).
type SF = BR.SF Identity

-- | Future signal function (conceptually, a function between future signals
-- that respects causality).
--
-- A future signal is a signal that is only defined for positive times.
type FutureSF = BR.SF Identity

-- | Given a signal function and a pair with an initial input sample for the
-- input signal, and a list of sampling times, possibly with new input samples
-- at those times, it produces a list of output samples.
--
-- This is a simplified, purely-functional version of 'reactimate'.
embed :: SF a b -> (a, [(DTime, Maybe a)]) -> [b]
embed :: forall a b. SF a b -> (a, [(DTime, Maybe a)]) -> [b]
embed SF a b
sf = Identity [b] -> [b]
forall a. Identity a -> a
runIdentity (Identity [b] -> [b])
-> ((a, [(DTime, Maybe a)]) -> Identity [b])
-> (a, [(DTime, Maybe a)])
-> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SF a b -> (a, [(DTime, Maybe a)]) -> Identity [b]
forall (m :: * -> *) a b.
Monad m =>
SF m a b -> (a, [(DTime, Maybe a)]) -> m [b]
BR.embed SF a b
sf

-- * Reactimation

-- | Convenience function to run a signal function indefinitely, using actions
-- to obtain new input and process the output.
--
-- This function first runs the initialization action, which provides the
-- initial input for the signal transformer at time 0.
--
-- Afterwards, an input sensing action is used to obtain new input (if any) and
-- the time since the last iteration. The argument to the input sensing function
-- indicates if it can block. If no new input is received, it is assumed to be
-- the same as in the last iteration.
--
-- After applying the signal function to the input, the actuation action is
-- executed. The first argument indicates if the output has changed, the second
-- gives the actual output). Actuation functions may choose to ignore the first
-- argument altogether. This action should return True if the reactimation must
-- stop, and False if it should continue.
--
-- Note that this becomes the program's /main loop/, which makes using this
-- function incompatible with GLUT, Gtk and other graphics libraries. It may
-- also impose a sizeable constraint in larger projects in which different
-- subparts run at different time steps. If you need to control the main loop
-- yourself for these or other reasons, use 'reactInit' and 'react'.
reactimate :: Monad m
           => m a                          -- ^ Initialization action
           -> (Bool -> m (DTime, Maybe a)) -- ^ Input sensing action
           -> (Bool -> b -> m Bool)        -- ^ Actuation (output processing)
                                           --   action
           -> SF a b                       -- ^ Signal function
           -> m ()
reactimate :: forall (m :: * -> *) a b.
Monad m =>
m a
-> (Bool -> m (DTime, Maybe a))
-> (Bool -> b -> m Bool)
-> SF a b
-> m ()
reactimate m a
senseI Bool -> m (DTime, Maybe a)
sense Bool -> b -> m Bool
actuate SF a b
sf =
    m a
-> (Bool -> m (DTime, Maybe a))
-> (Bool -> b -> m Bool)
-> SF m a b
-> m ()
forall (m :: * -> *) a b.
Monad m =>
m a
-> (Bool -> m (DTime, Maybe a))
-> (Bool -> b -> m Bool)
-> SF m a b
-> m ()
BR.reactimate m a
senseI Bool -> m (DTime, Maybe a)
sense Bool -> b -> m Bool
actuate (SF a b -> SF m a b
forall (m :: * -> *) a b. Monad m => SF a b -> SF m a b
foldIdentity SF a b
sf)
  where
    foldIdentity :: Monad m => SF a b -> BR.SF m a b
    foldIdentity :: forall (m :: * -> *) a b. Monad m => SF a b -> SF m a b
foldIdentity = (forall c. ClockInfo Identity c -> ClockInfo m c)
-> MSF (ClockInfo Identity) a b -> MSF (ClockInfo m) a b
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 c. ClockInfo Identity c -> ClockInfo m c)
 -> MSF (ClockInfo Identity) a b -> MSF (ClockInfo m) a b)
-> (forall c. ClockInfo Identity c -> ClockInfo m c)
-> MSF (ClockInfo Identity) a b
-> MSF (ClockInfo m) a b
forall a b. (a -> b) -> a -> b
$ (Identity c -> m c)
-> ReaderT DTime Identity c -> ReaderT DTime m c
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((Identity c -> m c)
 -> ReaderT DTime Identity c -> ReaderT DTime m c)
-> (Identity c -> m c)
-> ReaderT DTime Identity c
-> ReaderT DTime m c
forall a b. (a -> b) -> a -> b
$ c -> m c
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> m c) -> (Identity c -> c) -> Identity c -> m c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity c -> c
forall a. Identity a -> a
runIdentity