{-# LANGUAGE Arrows #-}
-- |
-- Copyright  : (c) Ivan Perez, 2019-2022
--              (c) Ivan Perez and Manuel Baerenz, 2016-2018
-- License    : BSD3
-- Maintainer : ivan.perez@keera.co.uk
--
-- Discrete to continuous-time signal functions.
module FRP.BearRiver.Hybrid
    (
      -- * Wave-form generation
      hold
    , dHold
    , trackAndHold
    , dTrackAndHold

      -- * Accumulators
    , accum
    , accumHold
    , dAccumHold
    , accumBy
    , accumHoldBy
    , dAccumHoldBy
    , accumFilter
    )
  where

-- External imports
import Control.Arrow (arr, returnA, (<<<), (>>>))

-- Internal imports (dunai)
import Data.MonadicStreamFunction (accumulateWith, feedback)

-- Internal imports (bearriver)
import FRP.BearRiver.Arrow        (dup)
import FRP.BearRiver.Delays       (iPre)
import FRP.BearRiver.Event        (Event (..), event)
import FRP.BearRiver.InternalCore (SF)

-- * Discrete to continuous-time signal functions

-- ** Wave-form generation

-- | Zero-order hold.
--
-- Converts a discrete-time signal into a continuous-time signal, by holding
-- the last value until it changes in the input signal. The given parameter may
-- be used for time zero, and until the first event occurs in the input signal,
-- so hold is always well-initialized.
--
-- >>> embed (hold 1) (deltaEncode 0.1 [NoEvent, NoEvent, Event 2, NoEvent, Event 3, NoEvent])
-- [1,1,2,2,3,3]
hold :: Monad m => a -> SF m (Event a) a
hold :: forall (m :: * -> *) a. Monad m => a -> SF m (Event a) a
hold a
a = a
-> MSF (ClockInfo m) (Event a, a) (a, a)
-> MSF (ClockInfo m) (Event a) a
forall (m :: * -> *) c a b.
Monad m =>
c -> MSF m (a, c) (b, c) -> MSF m a b
feedback a
a (MSF (ClockInfo m) (Event a, a) (a, a)
 -> MSF (ClockInfo m) (Event a) a)
-> MSF (ClockInfo m) (Event a, a) (a, a)
-> MSF (ClockInfo m) (Event a) a
forall a b. (a -> b) -> a -> b
$ ((Event a, a) -> (a, a)) -> MSF (ClockInfo m) (Event a, a) (a, a)
forall b c. (b -> c) -> MSF (ClockInfo m) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (((Event a, a) -> (a, a)) -> MSF (ClockInfo m) (Event a, a) (a, a))
-> ((Event a, a) -> (a, a))
-> MSF (ClockInfo m) (Event a, a) (a, a)
forall a b. (a -> b) -> a -> b
$ \(Event a
e, a
a') ->
  a -> (a, a)
forall a. a -> (a, a)
dup (a -> (a -> a) -> Event a -> a
forall a b. a -> (b -> a) -> Event b -> a
event a
a' a -> a
forall a. a -> a
id Event a
e)

-- | Zero-order hold with a delay.
--
-- Converts a discrete-time signal into a continuous-time signal, by holding the
-- last value until it changes in the input signal. The given parameter is used
-- for time zero (until the first event occurs in the input signal), so 'dHold'
-- shifts the discrete input by an infinitesimal delay.
--
-- >>> embed (dHold 1) (deltaEncode 0.1 [NoEvent, NoEvent, Event 2, NoEvent, Event 3, NoEvent])
-- [1,1,1,2,2,3]
dHold :: Monad m => a -> SF m (Event a) a
dHold :: forall (m :: * -> *) a. Monad m => a -> SF m (Event a) a
dHold a
a0 = a -> SF m (Event a) a
forall (m :: * -> *) a. Monad m => a -> SF m (Event a) a
hold a
a0 SF m (Event a) a -> MSF (ClockInfo m) a a -> SF m (Event a) a
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a -> MSF (ClockInfo m) a a
forall (m :: * -> *) a. Monad m => a -> SF m a a
iPre a
a0

-- | Tracks input signal when available, holding the last value when the input
-- is 'Nothing'.
--
-- This behaves similarly to 'hold', but there is a conceptual difference, as it
-- takes a signal of input @Maybe a@ (for some @a@) and not @Event@.
--
-- >>> embed (trackAndHold 1) (deltaEncode 0.1 [Nothing, Nothing, Just 2, Nothing, Just 3, Nothing])
-- [1,1,2,2,3,3]
trackAndHold :: Monad m => a -> SF m (Maybe a) a
trackAndHold :: forall (m :: * -> *) a. Monad m => a -> SF m (Maybe a) a
trackAndHold a
aInit = (Maybe a -> Event a) -> MSF (ClockInfo m) (Maybe a) (Event a)
forall b c. (b -> c) -> MSF (ClockInfo m) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Event a -> (a -> Event a) -> Maybe a -> Event a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Event a
forall a. Event a
NoEvent a -> Event a
forall a. a -> Event a
Event) MSF (ClockInfo m) (Maybe a) (Event a)
-> MSF (ClockInfo m) (Event a) a -> MSF (ClockInfo m) (Maybe a) a
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a -> MSF (ClockInfo m) (Event a) a
forall (m :: * -> *) a. Monad m => a -> SF m (Event a) a
hold a
aInit

-- | Tracks input signal when available, holding the last value when the input
-- is 'Nothing', with a delay.
--
-- This behaves similarly to 'hold', but there is a conceptual difference, as it
-- takes a signal of input @Maybe a@ (for some @a@) and not @Event@.
--
-- >>> embed (dTrackAndHold 1) (deltaEncode 0.1 [Nothing, Nothing, Just 2, Nothing, Just 3, Nothing])
-- [1,1,1,2,2,3]
dTrackAndHold :: Monad m => a -> SF m (Maybe a) a
dTrackAndHold :: forall (m :: * -> *) a. Monad m => a -> SF m (Maybe a) a
dTrackAndHold a
aInit = a -> SF m (Maybe a) a
forall (m :: * -> *) a. Monad m => a -> SF m (Maybe a) a
trackAndHold a
aInit SF m (Maybe a) a -> MSF (ClockInfo m) a a -> SF m (Maybe a) a
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a -> MSF (ClockInfo m) a a
forall (m :: * -> *) a. Monad m => a -> SF m a a
iPre a
aInit

-- ** Accumulators

-- | Given an initial value in an accumulator, it returns a signal function that
-- processes an event carrying transformation functions. Every time an 'Event'
-- is received, the function inside it is applied to the accumulator, whose new
-- value is outputted in an 'Event'.
accum :: Monad m => a -> SF m (Event (a -> a)) (Event a)
accum :: forall (m :: * -> *) a.
Monad m =>
a -> SF m (Event (a -> a)) (Event a)
accum a
aInit = a
-> MSF (ClockInfo m) (Event (a -> a), a) (Event a, a)
-> MSF (ClockInfo m) (Event (a -> a)) (Event a)
forall (m :: * -> *) c a b.
Monad m =>
c -> MSF m (a, c) (b, c) -> MSF m a b
feedback a
aInit (MSF (ClockInfo m) (Event (a -> a), a) (Event a, a)
 -> MSF (ClockInfo m) (Event (a -> a)) (Event a))
-> MSF (ClockInfo m) (Event (a -> a), a) (Event a, a)
-> MSF (ClockInfo m) (Event (a -> a)) (Event a)
forall a b. (a -> b) -> a -> b
$ ((Event (a -> a), a) -> (Event a, a))
-> MSF (ClockInfo m) (Event (a -> a), a) (Event a, a)
forall b c. (b -> c) -> MSF (ClockInfo m) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (((Event (a -> a), a) -> (Event a, a))
 -> MSF (ClockInfo m) (Event (a -> a), a) (Event a, a))
-> ((Event (a -> a), a) -> (Event a, a))
-> MSF (ClockInfo m) (Event (a -> a), a) (Event a, a)
forall a b. (a -> b) -> a -> b
$ \(Event (a -> a)
f, a
a) -> case Event (a -> a)
f of
    Event (a -> a)
NoEvent -> (Event a
forall a. Event a
NoEvent, a
a)
    Event a -> a
f' -> let a' :: a
a' = a -> a
f' a
a
                in (a -> Event a
forall a. a -> Event a
Event a
a', a
a')

-- | Zero-order hold accumulator (always produces the last outputted value until
-- an event arrives).
accumHold :: Monad m => a -> SF m (Event (a -> a)) a
accumHold :: forall (m :: * -> *) a. Monad m => a -> SF m (Event (a -> a)) a
accumHold a
aInit = a
-> MSF (ClockInfo m) (Event (a -> a), a) (a, a)
-> MSF (ClockInfo m) (Event (a -> a)) a
forall (m :: * -> *) c a b.
Monad m =>
c -> MSF m (a, c) (b, c) -> MSF m a b
feedback a
aInit (MSF (ClockInfo m) (Event (a -> a), a) (a, a)
 -> MSF (ClockInfo m) (Event (a -> a)) a)
-> MSF (ClockInfo m) (Event (a -> a), a) (a, a)
-> MSF (ClockInfo m) (Event (a -> a)) a
forall a b. (a -> b) -> a -> b
$ ((Event (a -> a), a) -> (a, a))
-> MSF (ClockInfo m) (Event (a -> a), a) (a, a)
forall b c. (b -> c) -> MSF (ClockInfo m) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (((Event (a -> a), a) -> (a, a))
 -> MSF (ClockInfo m) (Event (a -> a), a) (a, a))
-> ((Event (a -> a), a) -> (a, a))
-> MSF (ClockInfo m) (Event (a -> a), a) (a, a)
forall a b. (a -> b) -> a -> b
$ \(Event (a -> a)
f, a
a) -> case Event (a -> a)
f of
    Event (a -> a)
NoEvent -> (a
a, a
a)
    Event a -> a
f' -> let a' :: a
a' = a -> a
f' a
a
                in (a
a', a
a')

-- | Zero-order hold accumulator with delayed initialization (always produces
-- the last outputted value until an event arrives, but the very initial output
-- is always the given accumulator).
dAccumHold :: Monad m => a -> SF m (Event (a -> a)) a
dAccumHold :: forall (m :: * -> *) a. Monad m => a -> SF m (Event (a -> a)) a
dAccumHold a
aInit = a -> SF m (Event (a -> a)) a
forall (m :: * -> *) a. Monad m => a -> SF m (Event (a -> a)) a
accumHold a
aInit SF m (Event (a -> a)) a
-> MSF (ClockInfo m) a a -> SF m (Event (a -> a)) a
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a -> MSF (ClockInfo m) a a
forall (m :: * -> *) a. Monad m => a -> SF m a a
iPre a
aInit

-- | Accumulator parameterized by the accumulation function.
accumBy :: Monad m => (b -> a -> b) -> b -> SF m (Event a) (Event b)
accumBy :: forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> SF m (Event a) (Event b)
accumBy b -> a -> b
f b
b = SF m a b -> SF m (Event a) (Event b)
forall (m :: * -> *) a b.
Monad m =>
SF m a b -> SF m (Event a) (Event b)
mapEventS (SF m a b -> SF m (Event a) (Event b))
-> SF m a b -> SF m (Event a) (Event b)
forall a b. (a -> b) -> a -> b
$ (a -> b -> b) -> b -> SF m a b
forall (m :: * -> *) a s.
Monad m =>
(a -> s -> s) -> s -> MSF m a s
accumulateWith ((b -> a -> b) -> a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> a -> b
f) b
b

-- | Zero-order hold accumulator parameterized by the accumulation function.
accumHoldBy :: Monad m => (b -> a -> b) -> b -> SF m (Event a) b
accumHoldBy :: forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> SF m (Event a) b
accumHoldBy b -> a -> b
f b
b = b
-> MSF (ClockInfo m) (Event a, b) (b, b)
-> MSF (ClockInfo m) (Event a) b
forall (m :: * -> *) c a b.
Monad m =>
c -> MSF m (a, c) (b, c) -> MSF m a b
feedback b
b (MSF (ClockInfo m) (Event a, b) (b, b)
 -> MSF (ClockInfo m) (Event a) b)
-> MSF (ClockInfo m) (Event a, b) (b, b)
-> MSF (ClockInfo m) (Event a) b
forall a b. (a -> b) -> a -> b
$ ((Event a, b) -> (b, b)) -> MSF (ClockInfo m) (Event a, b) (b, b)
forall b c. (b -> c) -> MSF (ClockInfo m) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (((Event a, b) -> (b, b)) -> MSF (ClockInfo m) (Event a, b) (b, b))
-> ((Event a, b) -> (b, b))
-> MSF (ClockInfo m) (Event a, b) (b, b)
forall a b. (a -> b) -> a -> b
$ \(Event a
a, b
b') ->
  let b'' :: b
b'' = b -> (a -> b) -> Event a -> b
forall a b. a -> (b -> a) -> Event b -> a
event b
b' (b -> a -> b
f b
b') Event a
a
  in (b
b'', b
b'')

-- | Zero-order hold accumulator parameterized by the accumulation function with
-- delayed initialization (initial output sample is always the given
-- accumulator).
dAccumHoldBy :: Monad m => (b -> a -> b) -> b -> SF m (Event a) b
dAccumHoldBy :: forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> SF m (Event a) b
dAccumHoldBy b -> a -> b
f b
aInit = (b -> a -> b) -> b -> SF m (Event a) b
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> SF m (Event a) b
accumHoldBy b -> a -> b
f b
aInit SF m (Event a) b -> MSF (ClockInfo m) b b -> SF m (Event a) b
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> b -> MSF (ClockInfo m) b b
forall (m :: * -> *) a. Monad m => a -> SF m a a
iPre b
aInit

-- | Accumulator parameterized by the accumulator function with filtering,
-- possibly discarding some of the input events based on whether the second
-- component of the result of applying the accumulation function is 'Nothing' or
-- 'Just' x for some x.
accumFilter :: Monad m
            => (c -> a -> (c, Maybe b)) -> c -> SF m (Event a) (Event b)
accumFilter :: forall (m :: * -> *) c a b.
Monad m =>
(c -> a -> (c, Maybe b)) -> c -> SF m (Event a) (Event b)
accumFilter c -> a -> (c, Maybe b)
g c
cInit = c
-> MSF (ClockInfo m) (Event a, c) (Event b, c)
-> MSF (ClockInfo m) (Event a) (Event b)
forall (m :: * -> *) c a b.
Monad m =>
c -> MSF m (a, c) (b, c) -> MSF m a b
feedback c
cInit (MSF (ClockInfo m) (Event a, c) (Event b, c)
 -> MSF (ClockInfo m) (Event a) (Event b))
-> MSF (ClockInfo m) (Event a, c) (Event b, c)
-> MSF (ClockInfo m) (Event a) (Event b)
forall a b. (a -> b) -> a -> b
$ ((Event a, c) -> (Event b, c))
-> MSF (ClockInfo m) (Event a, c) (Event b, c)
forall b c. (b -> c) -> MSF (ClockInfo m) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (((Event a, c) -> (Event b, c))
 -> MSF (ClockInfo m) (Event a, c) (Event b, c))
-> ((Event a, c) -> (Event b, c))
-> MSF (ClockInfo m) (Event a, c) (Event b, c)
forall a b. (a -> b) -> a -> b
$ \(Event a
a, c
c) ->
  case Event a
a of
    Event a
NoEvent -> (Event b
forall a. Event a
NoEvent, c
c)
    Event a
a' -> case c -> a -> (c, Maybe b)
g c
c a
a' of
                  (c
c', Maybe b
Nothing) -> (Event b
forall a. Event a
NoEvent, c
c')
                  (c
c', Just b
b)  -> (b -> Event b
forall a. a -> Event a
Event b
b, c
c')

-- * Events

-- | Apply an 'SF' to every input. Freezes temporarily if the input is
-- 'NoEvent', and continues as soon as an 'Event' is received.
mapEventS :: Monad m => SF m a b -> SF m (Event a) (Event b)
mapEventS :: forall (m :: * -> *) a b.
Monad m =>
SF m a b -> SF m (Event a) (Event b)
mapEventS SF m a b
msf = proc Event a
eventA -> case Event a
eventA of
  Event a
a -> (b -> Event b) -> MSF (ClockInfo m) b (Event b)
forall b c. (b -> c) -> MSF (ClockInfo m) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr b -> Event b
forall a. a -> Event a
Event MSF (ClockInfo m) b (Event b)
-> SF m a b -> MSF (ClockInfo m) a (Event b)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< SF m a b
msf -< a
a
  Event a
NoEvent -> MSF (ClockInfo m) (Event b) (Event b)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA           -< Event b
forall a. Event a
NoEvent