{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}

-- | A "'Busy'" clock that ticks without waiting.
module FRP.Rhine.Clock.Realtime.Busy where

-- base
import Data.Time.Clock

-- rhine
import FRP.Rhine.Clock
import FRP.Rhine.Clock.Proxy

{- |
A clock that ticks without waiting.
All time passed between ticks amounts to computation time,
side effects, time measurement and framework overhead.
-}
data Busy = Busy

instance Clock IO Busy where
  type Time Busy = UTCTime
  type Tag Busy = ()

  initClock :: Busy -> RunningClockInit IO (Time Busy) (Tag Busy)
initClock Busy
_ = do
    UTCTime
initialTime <- IO UTCTime
getCurrentTime
    forall (m :: Type -> Type) a. Monad m => a -> m a
return
      ( forall (m :: Type -> Type) b a. Monad m => m b -> MSF m a b
constM IO UTCTime
getCurrentTime
          forall (a :: Type -> Type -> Type) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall (a :: Type -> Type -> Type) b c.
Arrow a =>
(b -> c) -> a b c
arr (forall a b. a -> b -> a
const ())
      , UTCTime
initialTime
      )

instance GetClockProxy Busy