Clock.hs

-- |
-- Module:     Control.Wire.Prefab.Clock
-- Copyright:  (c) 2011 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
--
-- Various clocks.

module Control.Wire.Prefab.Clock
    ( -- * Clock wires
      dtime,
      dtimeFrom,
      time,
      timeFrom,
      timeOffset
    )
    where

import Control.Arrow
import Control.Wire.Classes
import Control.Wire.Types


-- | Time deltas starting from the first instant.

dtime :: (ArrowClock (>~), Time (>~) ~ t, Num t) => Wire e (>~) a t
dtime =
    mkGen $ proc _ -> do
        t <- arrTime -< ()
        returnA -< (Right 0, dtimeFrom t)


-- | Time deltas starting from the given instant.

dtimeFrom :: (ArrowClock (>~), Time (>~) ~ t, Num t) => t -> Wire e (>~) a t
dtimeFrom t' =
    mkGen $ proc _ -> do
        t <- arrTime -< ()
        let dt = t - t'
        returnA -< t' `seq` (Right dt, dtimeFrom t)


-- | Current time with the given origin at the first instant.

timeFrom :: (ArrowClock (>~), Time (>~) ~ t, Num t) => t -> Wire e (>~) a t
timeFrom t0 =
    mkGen $ proc _ -> do
        t <- arrTime -< ()
        returnA -< t0 `seq` (Right t0, timeOffset (t0 - t))


-- | Current time with the given offset.

timeOffset :: (ArrowClock (>~), Time (>~) ~ t, Num t) => t -> Wire e (>~) a t
timeOffset offset = mkFix $ proc _ -> Right . (+ offset) ^<< arrTime -< ()


-- | Current time with origin 0 at the first instant.

time :: (ArrowClock (>~), Time (>~) ~ t, Num t) => Wire e (>~) a t
time = timeFrom 0