-- |
-- Module      : FRP.Yampa.Time
-- 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)
--
-- 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.Yampa.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.Yampa.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.Yampa.Integration.iterFrom'.
module FRP.Yampa.Time
    ( localTime
    , time
    )
  where

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

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

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

-- | Alternative name for localTime.
time :: SF a Time
time :: forall a. SF a Time
time = SF a Time
forall a. SF a Time
localTime