-- | The simplest input: keypresses. Nice for testing.

module Midair.GetChar (
     runGetChar
   , GetChar(..)
   ) where

import Midair.Core
import Midair.Handy

import Control.Concurrent (forkIO, ThreadId)
import Control.Concurrent.STM
import Control.Monad
import System.IO (hSetBuffering, BufferMode(NoBuffering), stdin)


data GetChar = GetChar Char
 deriving (Show, Read, Eq, Ord)

runGetChar :: SFlow GetChar (Fx a) -> IO (ThreadId, ThreadId, TVar (SFlow GetChar (Fx a)))
runGetChar startGraph = do
   hSetBuffering stdin NoBuffering

   getCharTChan <- newTChanIO
   getCharTid <- forkIO $ forever $ do
      c <- getChar
      atomically $ writeTChan getCharTChan $ GetChar c

   startNodeRef <- mkNodeRef startGraph

   graphTVar <- newTVarIO startNodeRef
   tid <- forkIO . forever . (runFx =<<) . atomically $
      readTChan getCharTChan >>= \msg -> do
         fireGraph graphTVar msg
   return (getCharTid, tid, graphTVar)