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

{- |
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'.
-}
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 <- forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO 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 forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
          String
line <- IO String
getLine
          UTCTime
time <- IO UTCTime
getCurrentTime
          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