> {-# LANGUAGE OverloadedStrings, FlexibleContexts #-}
> module Main where

> import Control.Concurrent
> import Control.Concurrent.STM
> import qualified Data.Text as T
> import qualified Data.Text.IO as TIO
> import Control.Exception
> import System.IO.Error (IOError)
> import qualified System.IO.Error as E
> import Data.Time
> import System.IO
> import System.Environment
> import System.Locale
> import qualified Data.Concurrent.Queue as Q

> data Msg = Line T.Text
>          | Tick

> data EMsg = Done
>           | Error IOError

> gitLine :: IO (Either IOError T.Text)
> gitLine = try TIO.getLine

> ticksProc :: (Q.PutQueue q STM) => Int -> q Msg -> IO ()
> ticksProc interval chan = do
>   threadDelay (interval * 100)
>   atomically $ Q.put chan $! Tick
>   ticksProc interval chan

> linesProc :: (Q.PutQueue q STM) => q EMsg -> q Msg -> IO ()
> linesProc echan chan = do
>   l <- gitLine
>   case l of
>     Left err 
>       | E.isEOFError err -> do
>         atomically $ Q.put echan Done
>       | otherwise -> do
>         atomically $ Q.put echan $ Error err
>     Right line -> do
>       atomically $ Q.put chan $ Line line
>       linesProc echan chan

> output :: (Q.TakeQueue q STM) => (T.Text -> IO ()) -> q EMsg -> q Msg -> T.Text -> IO ()
> output disp echan chan state = do
>   a <- atomically $ do
>       m <- Q.take chan
>       return $ do
>         case m of
>           Tick -> do
>             disp state
>             output disp echan chan state
>           Line line -> do
>             disp line
>             output disp echan chan line
>     `orElse` do
>       m <- Q.take echan
>       return $ do
>         case m of
>           Error e ->
>             throwIO e
>           Done ->
>             return ()
>   a

> display :: T.Text -> T.Text -> IO ()
> display sep txt = do
>   time <- getZonedTime
>   TIO.putStrLn $ T.concat [txt, sep, T.pack $ formatTime defaultTimeLocale (iso8601DateFormat $ Just "%H:%M:%S") time]
>   hFlush stdout

> main :: IO ()
> main = do
>   istate <- getArgs
>   chan <- newEmptyTMVarIO
>   echan <- newEmptyTMVarIO
>   _ <- forkIO $ linesProc echan chan
>   _ <- forkIO $ ticksProc 500 chan
>   output (display $ T.pack $ unwords $ istate) echan chan ""