--------------------------------------------------------------------------------
-- |
-- Module      :  FRP.Yampa.Hybrid
-- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003
-- 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,               -- :: a -> SF (Event a) a
    dHold,              -- :: a -> SF (Event a) a
    trackAndHold,       -- :: a -> SF (Maybe a) a
    dTrackAndHold,      -- :: a -> SF (Maybe a) a

    -- * Accumulators
    accum,              -- :: a -> SF (Event (a -> a)) (Event a)
    accumHold,          -- :: a -> SF (Event (a -> a)) a
    dAccumHold,         -- :: a -> SF (Event (a -> a)) a
    accumBy,            -- :: (b -> a -> b) -> b -> SF (Event a) (Event b)
    accumHoldBy,        -- :: (b -> a -> b) -> b -> SF (Event a) b
    dAccumHoldBy,       -- :: (b -> a -> b) -> b -> SF (Event a) b
    accumFilter,        -- :: (c -> a -> (c, Maybe b)) -> c
                        --    -> SF (Event a) (Event b)

) where

import Control.Arrow

import FRP.Yampa.InternalCore (SF, epPrim)

import FRP.Yampa.Delays
import FRP.Yampa.Event

------------------------------------------------------------------------------
-- 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 :: a -> SF (Event a) a
hold a
a_init = (() -> 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
a_init
    where
        f :: p -> c -> ((), c, c)
f p
_ c
a = ((), c
a, c
a)

-- !!!
-- !!! 2005-04-10: I DO NO LONGER THINK THIS IS CORRECT!
-- !!! CAN ONE POSSIBLY GET THE DESIRED STRICTNESS PROPERTIES
-- !!! ("DECOUPLING") this way???
-- !!! Also applies to the other "d" functions that were tentatively
-- !!! defined using only epPrim.
-- !!!
-- !!! 2005-06-13: Yes, indeed wrong! (But it's subtle, one has to
-- !!! make sure that the incoming event (and not just the payload
-- !!! of the event) is control dependent on  the output of "dHold"
-- !!! to observe it.
-- !!!
-- !!! 2005-06-09: But if iPre can be defined in terms of sscan,
-- !!! and ep + sscan = sscan, then things might work, and
-- !!! it might be possible to define dHold simply as hold >>> iPre
-- !!! without any performance penalty.

-- | 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 :: 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
{-
-- THIS IS WRONG! SEE ABOVE.
dHold a_init = epPrim f a_init a_init
    where
        f a' a = (a, a', a)
-}

-- | 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]

-- !!! DANGER!!! Event used inside arr! Probably OK because arr will not be
-- !!! optimized to arrE. But still. Maybe rewrite this using, say, scan?
-- !!! or switch? Switching (in hold) for every input sample does not
-- !!! seem like such a great idea anyway.
trackAndHold :: a -> SF (Maybe a) a
trackAndHold :: a -> SF (Maybe a) a
trackAndHold a
a_init = (Maybe a -> Event a) -> SF (Maybe a) (Event a)
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
a_init

-- | 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 :: a -> SF (Maybe a) a
dTrackAndHold a
a_init = a -> SF (Maybe a) a
forall a. a -> SF (Maybe a) a
trackAndHold a
a_init 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
a_init

------------------------------------------------------------------------------
-- 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 :: a -> SF (Event (a -> a)) (Event a)
accum a
a_init = (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
a_init 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 :: a -> SF (Event (a -> a)) a
accumHold a
a_init = (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
a_init a
a_init
    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 :: a -> SF (Event (a -> a)) a
dAccumHold a
a_init = a -> SF (Event (a -> a)) a
forall a. a -> SF (Event (a -> a)) a
accumHold a
a_init 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
a_init
{-
-- WRONG!
-- epPrim DOES and MUST patternmatch
-- on the input at every time step.
-- Test case to check for this added!
dAccumHold a_init = epPrim f a_init a_init
    where
        f a g = (a', a, a')
            where
                a' = g a
-}


-- | Accumulator parameterized by the accumulation function.
accumBy :: (b -> a -> b) -> b -> SF (Event a) (Event b)
accumBy :: (b -> a -> b) -> b -> SF (Event a) (Event b)
accumBy b -> a -> b
g b
b_init = (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
b_init 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 :: (b -> a -> b) -> b -> SF (Event a) b
accumHoldBy b -> a -> b
g b
b_init = (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
b_init b
b_init
    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

-- !!! This cannot be right since epPrim DOES and MUST patternmatch
-- !!! on the input at every time step.
-- !!! Add a test case to check for this!

-- | 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 :: (b -> a -> b) -> b -> SF (Event a) b
dAccumHoldBy b -> a -> b
f b
a_init = (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
a_init 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
a_init
{-
-- WRONG!
-- epPrim DOES and MUST patternmatch
-- on the input at every time step.
-- Test case to check for this added!
dAccumHoldBy g b_init = epPrim f b_init b_init
    where
        f b a = (b', b, b')
            where
                b' = g b a
-}


{- Untested:

accumBy f b = switch (never &&& identity) $ \a ->
              let b' = f b a in NoEvent >-- Event b' --> accumBy f b'

But no real improvement in clarity anyway.

-}

-- accumBy f b = accumFilter (\b -> a -> let b' = f b a in (b', Event b')) b

{-
-- Identity: accumBy f = accumFilter (\b a -> let b' = f b a in (b',Just b'))
accumBy :: (b -> a -> b) -> b -> SF (Event a) (Event b)
accumBy f b_init = SF {sfTF = tf0}
    where
        tf0 NoEvent    = (abAux b_init, NoEvent)
        tf0 (Event a0) = let b' = f b_init a0
                         in (abAux b', Event b')

        abAux b = SF' {sfTF' = tf}
            where
                tf _ NoEvent   = (abAux b, NoEvent)
                tf _ (Event a) = let b' = f b a
                                 in (abAux b', Event b')
-}

{-
accumFilter :: (c -> a -> (c, Maybe b)) -> c -> SF (Event a) (Event b)
accumFilter f c_init = SF {sfTF = tf0}
    where
        tf0 NoEvent    = (afAux c_init, NoEvent)
        tf0 (Event a0) = case f c_init a0 of
                             (c', Nothing) -> (afAux c', NoEvent)
                             (c', Just b0) -> (afAux c', Event b0)

        afAux c = SF' {sfTF' = tf}
            where
                tf _ NoEvent   = (afAux c, NoEvent)
                tf _ (Event a) = case f c a of
                                     (c', Nothing) -> (afAux c', NoEvent)
                                     (c', Just b)  -> (afAux c', Event b)
-}

-- | 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 :: (c -> a -> (c, Maybe b)) -> c -> SF (Event a) (Event b)
accumFilter c -> a -> (c, Maybe b)
g c
c_init = (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
c_init 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)



-- Vim modeline
-- vim:set tabstop=8 expandtab: