{- | A "'Busy'" clock that ticks without waiting. -}

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
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
    (MSF IO () (UTCTime, ()), UTCTime)
-> IO (MSF IO () (UTCTime, ()), UTCTime)
forall (m :: Type -> Type) a. Monad m => a -> m a
return
      ( IO UTCTime -> MSF IO () UTCTime
forall (m :: Type -> Type) b a. Monad m => m b -> MSF m a b
constM IO UTCTime
getCurrentTime
        MSF IO () UTCTime -> MSF IO () () -> MSF IO () (UTCTime, ())
forall (a :: Type -> Type -> Type) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (() -> ()) -> MSF IO () ()
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