{-# LANGUAGE OverloadedStrings #-}

-- | debug-me session control window

module ControlWindow where

import Types
import CmdLine
import ControlSocket
import VirtualTerminal

import System.IO
import System.Environment
import System.Process
import System.Posix
import Control.Concurrent.Async
import Control.Concurrent.STM
import Control.Concurrent.STM.TMChan
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.ByteString.UTF8 (fromString)
import Control.Monad
import Data.Monoid
import Prelude

winDesc :: String
winDesc = "debug-me session control and chat window"

controlWindow :: ControlOpts -> IO ()
controlWindow _ = do
	putStrLn $ "** " ++ winDesc
	socketfile <- defaultSocketFile
	ichan <- newTMChanIO
	ochan <- newTMChanIO
	promptchan <- newTChanIO
	responsechan <- newTChanIO
	-- Let the debug-me that's being controlled know that the control
	-- window is open.
	atomically $ writeTMChan ochan ControlWindowOpened
	_ <- connectControlSocket socketfile ichan ochan
		`race` displayInput ichan promptchan responsechan
		`race` collectOutput ochan promptchan responsechan
	return ()

-- | Opens the control window, or if that can't be done, tells the user
-- to run debug-me --control.
--
-- Returns once either of the TMChans is closed.
openControlWindow :: IO (TMChan ControlInput, TMChan ControlOutput)
openControlWindow = do
	socketfile <- defaultSocketFile
	soc <- bindSocket socketfile
	ichan <- newTMChanIO
	ochan <- newTMChanIO
	_ <- async $ serveControlSocket soc ichan ochan
	myexe <- getExecutablePath
	mproc <- runInVirtualTerminal winDesc myexe ["--control"]
	case mproc of
		Nothing -> putStrLn "You need to open another shell prompt, and run: debug-me --control"
		Just p -> void $ createProcess p
	-- Wait for message from control process.
	v <- atomically $ readTMChan ochan
	case v of
		Just ControlWindowOpened -> return ()
		_ -> error "unexpected message from control process"
	return (ichan, ochan)

type Prompt = ()
type Response = L.ByteString

type PromptChan = TChan Prompt
type ResponseChan = TChan Response

displayInput :: TMChan ControlInput -> PromptChan -> ResponseChan -> IO ()
displayInput ichan promptchan responsechan = loop
  where
	loop = go =<< atomically (readTMChan ichan)
	go Nothing = return ()
	go (Just (ControlInputAction (SessionKey (GpgSigned _ devgpgsig)))) = do
		error "TODO verify developer key"
	go (Just (ControlInputAction (ChatMessage username msg))) = do
		B.putStr $ "<" <> val username <> "> " <> val msg
		putStr "\n"
		hFlush stdout
		loop
	go v = do
		print v
		loop

collectOutput :: TMChan ControlOutput -> PromptChan -> ResponseChan -> IO ()
collectOutput ochan promptchan responsechan = do
	myusername <- fromString <$> getLoginName
	withLines stdin $ mapM_ $ processline myusername
  where
	processline myusername l
		| "/" `L.isPrefixOf` l = atomically $ do
			-- Is any particular input being prompted for now?
			mp <- tryReadTChan promptchan
			case mp of
				Nothing -> return ()
				Just _ -> writeTChan responsechan (L.drop 1 l)
		| otherwise = atomically $
			writeTMChan ochan $ ControlOutputAction $
				ChatMessage (Val myusername) (Val $ L.toStrict l)