{- |
In Rhine, event sources are clocks, and so is the console.
If this clock is used,
every input line on the console triggers one tick of the 'StdinClock'.
-}

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
module FRP.Rhine.Clock.Realtime.Stdin where

-- time
import Data.Time.Clock

-- transformers
import Control.Monad.IO.Class

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

{- |
A clock that ticks for every line entered on the console,
outputting the entered line as its 'Tag'.
-}
data StdinClock = StdinClock

instance MonadIO m => Clock m StdinClock where
  type Time StdinClock = UTCTime
  type Tag  StdinClock = String

  initClock :: StdinClock -> RunningClockInit m (Time StdinClock) (Tag StdinClock)
initClock StdinClock
_ = do
    UTCTime
initialTime <- IO UTCTime -> m UTCTime
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    (MSF m () (UTCTime, String), UTCTime)
-> m (MSF m () (UTCTime, String), UTCTime)
forall (m :: Type -> Type) a. Monad m => a -> m a
return
      ( m (UTCTime, String) -> MSF m () (UTCTime, String)
forall (m :: Type -> Type) b a. Monad m => m b -> MSF m a b
constM (m (UTCTime, String) -> MSF m () (UTCTime, String))
-> m (UTCTime, String) -> MSF m () (UTCTime, String)
forall a b. (a -> b) -> a -> b
$ IO (UTCTime, String) -> m (UTCTime, String)
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (UTCTime, String) -> m (UTCTime, String))
-> IO (UTCTime, String) -> m (UTCTime, String)
forall a b. (a -> b) -> a -> b
$ do
          String
line <- IO String
getLine
          UTCTime
time <- IO UTCTime
getCurrentTime
          (UTCTime, String) -> IO (UTCTime, String)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (UTCTime
time, String
line)
      , UTCTime
initialTime
      )

instance GetClockProxy StdinClock

instance Semigroup StdinClock where
  StdinClock
_ <> :: StdinClock -> StdinClock -> StdinClock
<> StdinClock
_ = StdinClock
StdinClock