-- |
-- Module      : FRP.Yampa.Hybrid
-- Copyright   : (c) Ivan Perez, 2014-2022
--               (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)
--
-- Discrete to continuous-time signal functions.
module FRP.Yampa.Hybrid
    (
      -- * Wave-form generation
      hold
    , dHold
    , trackAndHold
    , dTrackAndHold

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

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

-- Internal imports
import FRP.Yampa.Delays       (iPre)
import FRP.Yampa.Event        (Event (..))
import FRP.Yampa.InternalCore (SF, epPrim)

-- * 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 :: a -> SF (Event a) a
hold :: forall a. a -> SF (Event a) a
hold a
aInit = (() -> a -> ((), a, a)) -> () -> a -> SF (Event a) a
forall c a b. (c -> a -> (c, b, b)) -> c -> b -> SF (Event a) b
epPrim () -> a -> ((), a, a)
forall {p} {c}. p -> c -> ((), c, c)
f () a
aInit
  where
    f :: p -> c -> ((), c, c)
f p
_ c
a = ((), c
a, c
a)

-- | 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 :: a -> SF (Event a) a
dHold :: forall a. a -> SF (Event a) a
dHold a
a0 = a -> SF (Event a) a
forall a. a -> SF (Event a) a
hold a
a0 SF (Event a) a -> SF a a -> SF (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 -> SF a a
forall a. a -> SF 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 :: a -> SF (Maybe a) a
trackAndHold :: forall a. a -> SF (Maybe a) a
trackAndHold a
aInit = (Maybe a -> Event a) -> SF (Maybe a) (Event a)
forall b c. (b -> c) -> SF 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) SF (Maybe a) (Event a) -> SF (Event a) a -> SF (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 -> SF (Event a) a
forall a. a -> SF (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 :: a -> SF (Maybe a) a
dTrackAndHold :: forall a. a -> SF (Maybe a) a
dTrackAndHold a
aInit = a -> SF (Maybe a) a
forall a. a -> SF (Maybe a) a
trackAndHold a
aInit SF (Maybe a) a -> SF a a -> SF (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 -> SF a a
forall a. a -> SF 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 :: a -> SF (Event (a -> a)) (Event a)
accum :: forall a. a -> SF (Event (a -> a)) (Event a)
accum a
aInit = (a -> (a -> a) -> (a, Event a, Event a))
-> a -> Event a -> SF (Event (a -> a)) (Event a)
forall c a b. (c -> a -> (c, b, b)) -> c -> b -> SF (Event a) b
epPrim a -> (a -> a) -> (a, Event a, Event a)
forall {p} {a} {a}. p -> (p -> a) -> (a, Event a, Event a)
f a
aInit Event a
forall a. Event a
NoEvent
  where
    f :: p -> (p -> a) -> (a, Event a, Event a)
f p
a p -> a
g = (a
a', a -> Event a
forall a. a -> Event a
Event a
a', Event a
forall a. Event a
NoEvent) -- Accumulator, output if Event, output if
                                    -- no event
      where
        a' :: a
a' = p -> a
g p
a

-- | Zero-order hold accumulator (always produces the last outputted value until
-- an event arrives).
accumHold :: a -> SF (Event (a -> a)) a
accumHold :: forall a. a -> SF (Event (a -> a)) a
accumHold a
aInit = (a -> (a -> a) -> (a, a, a)) -> a -> a -> SF (Event (a -> a)) a
forall c a b. (c -> a -> (c, b, b)) -> c -> b -> SF (Event a) b
epPrim a -> (a -> a) -> (a, a, a)
forall {p} {c}. p -> (p -> c) -> (c, c, c)
f a
aInit a
aInit
  where
    f :: p -> (p -> c) -> (c, c, c)
f p
a p -> c
g = (c
a', c
a', c
a') -- Accumulator, output if Event, output if no event
      where
        a' :: c
a' = p -> c
g p
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 :: a -> SF (Event (a -> a)) a
dAccumHold :: forall a. a -> SF (Event (a -> a)) a
dAccumHold a
aInit = a -> SF (Event (a -> a)) a
forall a. a -> SF (Event (a -> a)) a
accumHold a
aInit SF (Event (a -> a)) a -> SF a a -> SF (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 -> SF a a
forall a. a -> SF a a
iPre a
aInit

-- | Accumulator parameterized by the accumulation function.
accumBy :: (b -> a -> b) -> b -> SF (Event a) (Event b)
accumBy :: forall b a. (b -> a -> b) -> b -> SF (Event a) (Event b)
accumBy b -> a -> b
g b
bInit = (b -> a -> (b, Event b, Event b))
-> b -> Event b -> SF (Event a) (Event b)
forall c a b. (c -> a -> (c, b, b)) -> c -> b -> SF (Event a) b
epPrim b -> a -> (b, Event b, Event b)
forall {a}. b -> a -> (b, Event b, Event a)
f b
bInit Event b
forall a. Event a
NoEvent
  where
    f :: b -> a -> (b, Event b, Event a)
f b
b a
a = (b
b', b -> Event b
forall a. a -> Event a
Event b
b', Event a
forall a. Event a
NoEvent)
      where
        b' :: b
b' = b -> a -> b
g b
b a
a

-- | Zero-order hold accumulator parameterized by the accumulation function.
accumHoldBy :: (b -> a -> b) -> b -> SF (Event a) b
accumHoldBy :: forall b a. (b -> a -> b) -> b -> SF (Event a) b
accumHoldBy b -> a -> b
g b
bInit = (b -> a -> (b, b, b)) -> b -> b -> SF (Event a) b
forall c a b. (c -> a -> (c, b, b)) -> c -> b -> SF (Event a) b
epPrim b -> a -> (b, b, b)
f b
bInit b
bInit
  where
    f :: b -> a -> (b, b, b)
f b
b a
a = (b
b', b
b', b
b')
      where
        b' :: b
b' = b -> a -> b
g b
b a
a

-- | Zero-order hold accumulator parameterized by the accumulation function with
-- delayed initialization (initial output sample is always the given
-- accumulator).
dAccumHoldBy :: (b -> a -> b) -> b -> SF (Event a) b
dAccumHoldBy :: forall b a. (b -> a -> b) -> b -> SF (Event a) b
dAccumHoldBy b -> a -> b
f b
aInit = (b -> a -> b) -> b -> SF (Event a) b
forall b a. (b -> a -> b) -> b -> SF (Event a) b
accumHoldBy b -> a -> b
f b
aInit SF (Event a) b -> SF b b -> SF (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 -> SF b b
forall a. a -> SF 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 :: (c -> a -> (c, Maybe b)) -> c -> SF (Event a) (Event b)
accumFilter :: forall c a b.
(c -> a -> (c, Maybe b)) -> c -> SF (Event a) (Event b)
accumFilter c -> a -> (c, Maybe b)
g c
cInit = (c -> a -> (c, Event b, Event b))
-> c -> Event b -> SF (Event a) (Event b)
forall c a b. (c -> a -> (c, b, b)) -> c -> b -> SF (Event a) b
epPrim c -> a -> (c, Event b, Event b)
forall {a}. c -> a -> (c, Event b, Event a)
f c
cInit Event b
forall a. Event a
NoEvent
  where
    f :: c -> a -> (c, Event b, Event a)
f c
c a
a = case c -> a -> (c, Maybe b)
g c
c a
a of
              (c
c', Maybe b
Nothing) -> (c
c', Event b
forall a. Event a
NoEvent, Event a
forall a. Event a
NoEvent)
              (c
c', Just b
b)  -> (c
c', b -> Event b
forall a. a -> Event a
Event b
b, Event a
forall a. Event a
NoEvent)