-- |
-- Copyright  : (c) Ivan Perez, 2019-2023
--              (c) Ivan Perez and Manuel Baerenz, 2016-2018
-- License    : BSD3
-- Maintainer : ivan.perez@keera.co.uk
--
-- Maintainer  : ivan.perez@keera.co.uk
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
--
-- SF primitives that producing the current running time.
--
-- Time is global for an 'SF', so, every constituent 'SF' will use the same
-- global clock. However, when used in combination with
-- 'FRP.BearRiver.Switches.switch'ing, the SF switched into will be started at
-- the time of switching, so any reference to 'localTime' or 'time' from that
-- 'SF' will count using the time of switching as the start time.
--
-- Take also into account that, because 'FRP.BearRiver.Integration.derivative'
-- is the derivative of a signal /over time/, differentiating 'localTime' will
-- always produce the value one (@1@). If you really, really, really need to
-- know the time delta, and need to abandon the hybrid\/FRP abstraction, see
-- 'FRP.BearRiver.Integration.iterFrom'.
module FRP.BearRiver.Time
    ( localTime
    , time
    )
  where

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

-- Internal imports
import FRP.BearRiver.Basic        (constant)
import FRP.BearRiver.Integration  (integral)
import FRP.BearRiver.InternalCore (SF, Time)

-- | Outputs the time passed since the signal function instance was started.
localTime :: Monad m => SF m a Time
localTime :: forall (m :: * -> *) a. Monad m => SF m a Time
localTime = Time -> SF m a Time
forall (m :: * -> *) b a. Monad m => b -> SF m a b
constant Time
1.0 SF m a Time -> MSF (ClockInfo m) Time Time -> SF m a Time
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> MSF (ClockInfo m) Time Time
forall (m :: * -> *) s a.
(Monad m, Fractional s, VectorSpace a s) =>
SF m a a
integral

-- | Alternative name for localTime.
time :: Monad m => SF m a Time
time :: forall (m :: * -> *) a. Monad m => SF m a Time
time = SF m a Time
forall (m :: * -> *) a. Monad m => SF m a Time
localTime