-- |
-- Module      :  FRP.Yampa.Basic
-- 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)
--
-- Defines basic signal functions, and elementary ways of altering them.
--
-- This module defines very basic ways of creating and modifying signal
-- functions. In particular, it defines ways of creating constant output
-- producing SFs, and SFs that just pass the signal through unmodified.
--
-- It also defines ways of altering the input and the output signal only
-- by inserting one value in the signal, or by transforming it.
module FRP.Yampa.Basic
    (
      -- * Basic signal functions
      identity
    , constant

      -- ** Initialization
    , (-->)
    , (-:>)
    , (>--)
    , (-=>)
    , (>=-)
    , initially
    )
  where

import FRP.Yampa.InternalCore (SF(..), SF'(..), sfConst, sfId)

infixr 0 -->, -:>, >--, -=>, >=-

-- * Basic signal functions

-- | Identity: identity = arr id
--
-- Using 'identity' is preferred over lifting id, since the arrow combinators
-- know how to optimise certain networks based on the transformations being
-- applied.
identity :: SF a a
identity :: forall a. SF a a
identity = SF {sfTF :: a -> Transition a a
sfTF = \a
a -> (forall a. SF' a a
sfId, a
a)}

{-# ANN constant "HLint: ignore Use const" #-}
-- | Identity: constant b = arr (const b)
--
-- Using 'constant' is preferred over lifting const, since the arrow combinators
-- know how to optimise certain networks based on the transformations being
-- applied.
constant :: b -> SF a b
constant :: forall b a. b -> SF a b
constant b
b = SF {sfTF :: a -> Transition a b
sfTF = \a
_ -> (forall b a. b -> SF' a b
sfConst b
b, b
b)}

-- * Initialization

-- | Initialization operator (cf. Lustre/Lucid Synchrone).
--
-- The output at time zero is the first argument, and from
-- that point on it behaves like the signal function passed as
-- second argument.
(-->) :: b -> SF a b -> SF a b
b
b0 --> :: forall b a. b -> SF a b -> SF a b
--> (SF {sfTF :: forall a b. SF a b -> a -> Transition a b
sfTF = a -> Transition a b
tf10}) = SF {sfTF :: a -> Transition a b
sfTF = \a
a0 -> (forall a b. (a, b) -> a
fst (a -> Transition a b
tf10 a
a0), b
b0)}

-- | Output pre-insert operator.
--
-- Insert a sample in the output, and from that point on, behave
-- like the given sf.
(-:>) :: b -> SF a b -> SF a b
b
b0 -:> :: forall b a. b -> SF a b -> SF a b
-:> (SF {sfTF :: forall a b. SF a b -> a -> Transition a b
sfTF = a -> Transition a b
tf10}) = SF {sfTF :: a -> Transition a b
sfTF = \a
_a0 -> (SF' a b
ct, b
b0)}
  where ct :: SF' a b
ct = forall a b. (DTime -> a -> Transition a b) -> SF' a b
SF' forall a b. (a -> b) -> a -> b
$ \DTime
_dt a
a0 -> a -> Transition a b
tf10 a
a0

-- | Input initialization operator.
--
-- The input at time zero is the first argument, and from
-- that point on it behaves like the signal function passed as
-- second argument.
(>--) :: a -> SF a b -> SF a b
a
a0 >-- :: forall a b. a -> SF a b -> SF a b
>-- (SF {sfTF :: forall a b. SF a b -> a -> Transition a b
sfTF = a -> Transition a b
tf10}) = SF {sfTF :: a -> Transition a b
sfTF = \a
_ -> a -> Transition a b
tf10 a
a0}

-- | Transform initial output value.
--
-- Applies a transformation 'f' only to the first output value at
-- time zero.
(-=>) :: (b -> b) -> SF a b -> SF a b
b -> b
f -=> :: forall b a. (b -> b) -> SF a b -> SF a b
-=> (SF {sfTF :: forall a b. SF a b -> a -> Transition a b
sfTF = a -> Transition a b
tf10}) =
  SF {sfTF :: a -> Transition a b
sfTF = \a
a0 -> let (SF' a b
sf1, b
b0) = a -> Transition a b
tf10 a
a0 in (SF' a b
sf1, b -> b
f b
b0)}

-- | Transform initial input value.
--
-- Applies a transformation 'f' only to the first input value at
-- time zero.
{-# ANN (>=-) "HLint: ignore Avoid lambda" #-}
(>=-) :: (a -> a) -> SF a b -> SF a b
a -> a
f >=- :: forall a b. (a -> a) -> SF a b -> SF a b
>=- (SF {sfTF :: forall a b. SF a b -> a -> Transition a b
sfTF = a -> Transition a b
tf10}) = SF {sfTF :: a -> Transition a b
sfTF = \a
a0 -> a -> Transition a b
tf10 (a -> a
f a
a0)}

-- | Override initial value of input signal.
initially :: a -> SF a a
initially :: forall a. a -> SF a a
initially = (forall b a. b -> SF a b -> SF a b
--> forall a. SF a a
identity)