-- |
-- Module      :  FRP.Yampa.Scan
-- 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)
--
-- Simple, stateful signal processing.
--
-- Scanning implements elementary, step-based accumulating over signal
-- functions by means of an auxiliary function applied to each input and to an
-- accumulator. For comparison with other FRP libraries and with stream
-- processing abstractions, think of fold.
module FRP.Yampa.Scan
    ( sscan
    , sscanPrim
    )
  where

import FRP.Yampa.InternalCore (SF(..), sfSScan)

-- ** Simple, stateful signal processing

-- | Applies a function point-wise, using the last output as next input. This
-- creates a well-formed loop based on a pure, auxiliary function.
sscan :: (b -> a -> b) -> b -> SF a b
sscan :: forall b a. (b -> a -> b) -> b -> SF a b
sscan b -> a -> b
f b
b_init = forall c a b. (c -> a -> Maybe (c, b)) -> c -> b -> SF a b
sscanPrim b -> a -> Maybe (b, b)
f' b
b_init b
b_init
  where
    f' :: b -> a -> Maybe (b, b)
f' b
b a
a = let b' :: b
b' = b -> a -> b
f b
b a
a in forall a. a -> Maybe a
Just (b
b', b
b')

-- | Generic version of 'sscan', in which the auxiliary function produces
-- an internal accumulator and an "held" output.
--
-- Applies a function point-wise, using the last known 'Just' output to form
-- the output, and next input accumulator. If the output is 'Nothing', the last
-- known accumulators are used. This creates a well-formed loop based on a
-- pure, auxiliary function.
sscanPrim :: (c -> a -> Maybe (c, b)) -> c -> b -> SF a b
sscanPrim :: forall c a b. (c -> a -> Maybe (c, b)) -> c -> b -> SF a b
sscanPrim c -> a -> Maybe (c, b)
f c
c_init b
b_init = SF {sfTF :: a -> Transition a b
sfTF = a -> Transition a b
tf0}
  where
    tf0 :: a -> Transition a b
tf0 a
a0 = case c -> a -> Maybe (c, b)
f c
c_init a
a0 of
               Maybe (c, b)
Nothing       -> (forall c a b. (c -> a -> Maybe (c, b)) -> c -> b -> SF' a b
sfSScan c -> a -> Maybe (c, b)
f c
c_init b
b_init, b
b_init)
               Just (c
c', b
b') -> (forall c a b. (c -> a -> Maybe (c, b)) -> c -> b -> SF' a b
sfSScan c -> a -> Maybe (c, b)
f c
c' b
b', b
b')