-- |
-- Module      : FRP.BearRiver.Delays
-- Copyright   : (c) Ivan Perez, 2014-2023
--               (c) George Giorgidze, 2007-2012
--               (c) Henrik Nilsson, 2005-2006
--               (c) Antony Courtney and Henrik Nilsson, Yale University, 2003-2004
-- License     : BSD-style (see the LICENSE file in the distribution)
--
-- Maintainer  : ivan.perez@keera.co.uk
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
--
-- SF primitives and combinators to delay signals, introducing new values in
-- them.
module FRP.BearRiver.Delays
    (
      -- * Basic delays
      pre
    , iPre
    , fby

      -- * Timed delays
    , delay
    )
  where

-- External imports
import Control.Arrow ((>>>))

-- Internal imports (dunai)
import Control.Monad.Trans.MSF                 (ask)
import Data.MonadicStreamFunction.InternalCore (MSF (..))

-- Internal imports
import FRP.BearRiver.Basic        (identity, (-->))
import FRP.BearRiver.InternalCore (SF (..), Time)
import FRP.BearRiver.Scan         (sscanPrim)

infixr 0 `fby`

-- * Delays

-- | Uninitialized delay operator.
--
-- The output has an infinitesimal delay (1 sample), and the value at time zero
-- is undefined.
pre :: Monad m => SF m a a
pre :: forall (m :: * -> *) a. Monad m => SF m a a
pre = (a -> a -> Maybe (a, a)) -> a -> a -> SF m a a
forall (m :: * -> *) c a b.
Monad m =>
(c -> a -> Maybe (c, b)) -> c -> b -> SF m a b
sscanPrim a -> a -> Maybe (a, a)
forall {b} {a}. b -> a -> Maybe (a, b)
f a
forall {a}. a
uninit a
forall {a}. a
uninit
  where
    f :: b -> a -> Maybe (a, b)
f b
c a
a = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
a, b
c)
    uninit :: a
uninit = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"bearriver: pre: Uninitialized pre operator."

-- | Initialized delay operator.
--
-- Creates an SF that delays the input signal, introducing an infinitesimal
-- delay (one sample), using the given argument to fill in the initial output at
-- time zero.
iPre :: Monad m => a -> SF m a a
iPre :: forall (m :: * -> *) a. Monad m => a -> SF m a a
iPre = (a -> SF m a a -> SF m a a
forall (m :: * -> *) b a. Monad m => b -> SF m a b -> SF m a b
--> SF m a a
forall (m :: * -> *) a. Monad m => SF m a a
pre)

-- | Lucid-Synchrone-like initialized delay (read "followed by").
--
-- Initialized delay combinator, introducing an infinitesimal delay (one sample)
-- in given 'SF', using the given argument to fill in the initial output at time
-- zero.
--
-- The difference with 'iPre' is that 'fby' takes an 'SF' as argument.
fby :: Monad m => b -> SF m a b -> SF m a b
b
b0 fby :: forall (m :: * -> *) b a. Monad m => b -> SF m a b -> SF m a b
`fby` SF m a b
sf = b
b0 b -> SF m a b -> SF m a b
forall (m :: * -> *) b a. Monad m => b -> SF m a b -> SF m a b
--> SF m a b
sf SF m a b -> MSF (ClockInfo m) b b -> SF m a b
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> MSF (ClockInfo m) b b
forall (m :: * -> *) a. Monad m => SF m a a
pre

-- * Timed delays

-- | Delay a signal by a fixed time 't', using the second parameter to fill in
-- the initial 't' seconds.
delay :: Monad m => Time -> a -> SF m a a
delay :: forall (m :: * -> *) a. Monad m => Time -> a -> SF m a a
delay Time
q a
aInit | Time
q Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
0     = [Char] -> SF m a a
forall a. HasCallStack => [Char] -> a
error [Char]
"bearriver: delay: Negative delay."
              | Time
q Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
0    = SF m a a
forall (m :: * -> *) a. Monad m => SF m a a
identity
              | Bool
otherwise = (a -> ClockInfo m (a, SF m a a)) -> SF m a a
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF a -> ClockInfo m (a, SF m a a)
forall {m :: * -> *} {m :: * -> *}.
(Monad m, Monad m) =>
a -> m (a, MSF (ReaderT Time m) a a)
tf0
  where
    tf0 :: a -> m (a, MSF (ReaderT Time m) a a)
tf0 a
a0 = (a, MSF (ReaderT Time m) a a) -> m (a, MSF (ReaderT Time m) a a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
aInit, [(Time, a)] -> [(Time, a)] -> Time -> a -> MSF (ReaderT Time m) a a
forall {m :: * -> *} {t} {b}.
(Monad m, Ord t, Num t) =>
[(t, b)] -> [(t, b)] -> t -> b -> MSF (ReaderT t m) b b
delayAux [] [(Time
q, a
a0)] Time
0 a
aInit)

    -- Invariants:
    -- tDiff measure the time since the latest output sample ideally should have
    -- been output. Whenever that equals or exceeds the time delta for the next
    -- buffered sample, it is time to output a new sample (although not
    -- necessarily the one first in the queue: it might be necessary to "catch
    -- up" by discarding samples.  0 <= tDiff < bdt, where bdt is the buffered
    -- time delta for the sample on the front of the buffer queue.
    --
    -- Sum of time deltas in the queue >= q.
    delayAux :: [(t, b)] -> [(t, b)] -> t -> b -> MSF (ReaderT t m) b b
delayAux [(t, b)]
_ [] t
_ b
_ = MSF (ReaderT t m) b b
forall a. HasCallStack => a
undefined
    delayAux [(t, b)]
rbuf buf :: [(t, b)]
buf@((t
bdt, b
ba) : [(t, b)]
buf') t
tDiff b
aPrev = (b -> ReaderT t m (b, MSF (ReaderT t m) b b))
-> MSF (ReaderT t m) b b
forall (m :: * -> *) a b. (a -> m (b, MSF m a b)) -> MSF m a b
MSF b -> ReaderT t m (b, MSF (ReaderT t m) b b)
forall {m :: * -> *}.
Monad m =>
b -> ReaderT t m (b, MSF (ReaderT t m) b b)
tf -- True
      where
        tf :: b -> ReaderT t m (b, MSF (ReaderT t m) b b)
tf b
a = do
          t
dt <- ReaderT t m t
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
          let tDiff' :: t
tDiff' = t
tDiff t -> t -> t
forall a. Num a => a -> a -> a
+ t
dt
              rbuf' :: [(t, b)]
rbuf'  = (t
dt, b
a) (t, b) -> [(t, b)] -> [(t, b)]
forall a. a -> [a] -> [a]
: [(t, b)]
rbuf
          if (t
tDiff' t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
bdt)
            then (b, MSF (ReaderT t m) b b)
-> ReaderT t m (b, MSF (ReaderT t m) b b)
forall a. a -> ReaderT t m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
aPrev, [(t, b)] -> [(t, b)] -> t -> b -> MSF (ReaderT t m) b b
delayAux [(t, b)]
rbuf' [(t, b)]
buf t
tDiff' b
aPrev)
            else [(t, b)]
-> [(t, b)] -> t -> b -> ReaderT t m (b, MSF (ReaderT t m) b b)
forall {m :: * -> *}.
Monad m =>
[(t, b)] -> [(t, b)] -> t -> b -> m (b, MSF (ReaderT t m) b b)
nextSmpl [(t, b)]
rbuf' [(t, b)]
buf' (t
tDiff' t -> t -> t
forall a. Num a => a -> a -> a
- t
bdt) b
ba
          where

            nextSmpl :: [(t, b)] -> [(t, b)] -> t -> b -> m (b, MSF (ReaderT t m) b b)
nextSmpl [(t, b)]
rbuf [] t
tDiff b
a =
              [(t, b)] -> [(t, b)] -> t -> b -> m (b, MSF (ReaderT t m) b b)
nextSmpl [] ([(t, b)] -> [(t, b)]
forall a. [a] -> [a]
reverse [(t, b)]
rbuf) t
tDiff b
a
            nextSmpl [(t, b)]
rbuf buf :: [(t, b)]
buf@((t
bdt, b
ba) : [(t, b)]
buf') t
tDiff b
a
              | t
tDiff t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
bdt = (b, MSF (ReaderT t m) b b) -> m (b, MSF (ReaderT t m) b b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
a, [(t, b)] -> [(t, b)] -> t -> b -> MSF (ReaderT t m) b b
delayAux [(t, b)]
rbuf [(t, b)]
buf t
tDiff b
a)
              | Bool
otherwise   = [(t, b)] -> [(t, b)] -> t -> b -> m (b, MSF (ReaderT t m) b b)
nextSmpl [(t, b)]
rbuf [(t, b)]
buf' (t
tDiff t -> t -> t
forall a. Num a => a -> a -> a
- t
bdt) b
ba