-- | The Console process has two main purposes. It is a telnet-like
--   interface with the user and it is our first simple logging device
--   for what happens inside the system.
{-# LANGUAGE ScopedTypeVariables #-}
module Process.Console
    ( start
    )
where

import Control.Concurrent
import Control.Concurrent.CML
import Control.Monad.Reader

import Prelude hiding (catch)
import System.Log.Logger


import Process
import qualified Process.Status as St
import Supervisor


data Cmd = Quit -- ^ Quit the program
         | Show -- ^ Show current state
         | Help -- ^ Print Help message
         | Unknown String -- ^ Unknown command
         deriving (Eq, Show)

type CmdChannel = Channel Cmd

data CF = CF { cmdCh :: CmdChannel
             , wrtCh :: Channel String }

instance Logging CF where
    logName _ = "Process.Console"

-- | Start the logging process and return a channel to it. Sending on this
--   Channel means writing stuff out on stdOut
start :: Channel () -> Channel St.ST -> SupervisorChan -> IO ThreadId
start waitC statusC supC = do
    cmdC <- readerP -- We shouldn't be doing this in the long run
    wrtC <- writerP
    spawnP (CF cmdC wrtC) () (catchP (forever lp) (defaultStopHandler supC))
  where
    lp = syncP =<< chooseP [quitEvent, helpEvent, unknownEvent, showEvent]
    quitEvent = do
        ch <- asks cmdCh
        ev <- recvP ch (==Quit)
        wrapP ev 
            (\_ -> syncP =<< sendP waitC ())
    helpEvent = do
        ch <- asks cmdCh
        wrtC <- asks wrtCh
        ev <- recvP ch (==Help)
        wrapP ev
            (\_ -> syncP =<< sendPC wrtCh helpMessage)
    unknownEvent = do
        ch <- asks cmdCh
        wrtC <- asks wrtCh
        ev <- recvP ch (\m -> case m of
                                Unknown _ -> True
                                _         -> False)
        wrapP ev
            (\(Unknown cmd) -> syncP =<< (sendPC wrtCh $ "Unknown command: " ++ cmd))
    showEvent = do
        ch <- asks cmdCh
        wrtC <- asks wrtCh
        ev <- recvP ch (==Show)
        wrapP ev
            (\_ -> do
                st <- syncP =<< recvP statusC (const True)
                syncP =<< sendPC wrtCh (show st))

helpMessage :: String
helpMessage = concat
    [ "Command Help:\n"
    , "\n"
    , "  help    - Show this help\n"
    , "  quit    - Quit the program\n"
    , "  show    - Show the current downloading status\n"
    ]

writerP :: IO (Channel String)
writerP = do wrtCh <- channel
             spawn $ lp wrtCh
             return wrtCh
  where lp wCh = forever (do m <- sync $ receive wCh (const True)
                             putStrLn m)

readerP :: IO CmdChannel
readerP = do cmdCh <- channel
             spawn $ lp cmdCh
             return cmdCh
  where lp cmdCh = forever $
           do c <- getLine
              case c of
                "help" -> sync $ transmit cmdCh Help
                "quit" -> sync $ transmit cmdCh Quit
                "show" -> sync $ transmit cmdCh Show
                cmd    -> do logM "Process.Console.readerP" INFO $
                                     "Unrecognized command: " ++ show cmd
                             sync $ transmit cmdCh (Unknown cmd)