{-# 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

-- text
import Data.Text qualified as Text
import Data.Text.IO qualified as Text

-- automaton
import Data.Automaton (constM)

-- 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 = Text.Text

  initClock :: StdinClock -> RunningClockInit m (Time StdinClock) (Tag StdinClock)
initClock StdinClock
_ = 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, Text), UTCTime)
-> m (Automaton m () (UTCTime, Text), UTCTime)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return
      ( m (UTCTime, Text) -> Automaton m () (UTCTime, Text)
forall (m :: Type -> Type) b a. Functor m => m b -> Automaton m a b
constM (m (UTCTime, Text) -> Automaton m () (UTCTime, Text))
-> m (UTCTime, Text) -> Automaton m () (UTCTime, Text)
forall a b. (a -> b) -> a -> b
$ IO (UTCTime, Text) -> m (UTCTime, Text)
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (UTCTime, Text) -> m (UTCTime, Text))
-> IO (UTCTime, Text) -> m (UTCTime, Text)
forall a b. (a -> b) -> a -> b
$ do
          Text
line <- IO Text
Text.getLine
          UTCTime
time <- IO UTCTime
getCurrentTime
          (UTCTime, Text) -> IO (UTCTime, Text)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (UTCTime
time, Text
line)
      , UTCTime
initialTime
      )

instance GetClockProxy StdinClock

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