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

-- | A clock that never ticks.
module FRP.Rhine.Clock.Realtime.Never where

-- base
import Control.Concurrent (threadDelay)
import Control.Monad (forever)
import Control.Monad.IO.Class
import Data.Void (Void)

-- time
import Data.Time.Clock

-- automaton
import Data.Automaton (constM)

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

-- | A clock that never ticks.
data Never = Never

instance (MonadIO m) => Clock m Never where
  type Time Never = UTCTime
  type Tag Never = Void

  initClock :: Never -> RunningClockInit m (Time Never) (Tag Never)
initClock Never
_ = do
    UTCTime
initialTime <- IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    (Automaton m () (UTCTime, Void), UTCTime)
-> m (Automaton m () (UTCTime, Void), UTCTime)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return
      ( m (UTCTime, Void) -> Automaton m () (UTCTime, Void)
forall (m :: Type -> Type) b a. Functor m => m b -> Automaton m a b
constM (IO (UTCTime, Void) -> m (UTCTime, Void)
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (UTCTime, Void) -> m (UTCTime, Void))
-> (Int -> IO (UTCTime, Void)) -> Int -> m (UTCTime, Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO (UTCTime, Void)
forall (f :: Type -> Type) a b. Applicative f => f a -> f b
forever (IO () -> IO (UTCTime, Void))
-> (Int -> IO ()) -> Int -> IO (UTCTime, Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO ()
threadDelay (Int -> m (UTCTime, Void)) -> Int -> m (UTCTime, Void)
forall a b. (a -> b) -> a -> b
$ Int
10 Int -> Integer -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
9)
      , UTCTime
initialTime
      )

instance GetClockProxy Never