module Tetrispy (spy) where

import Parser (command)

import Prelude hiding (catch)

import System
import System.IO

import Monad (when, unless, ap)
import Control.Concurrent
import Control.Exception

import Network

import Text.ParserCombinators.Parsec (parse)

spy :: PortID -> String -> PortID -> IO ()
spy port target targetPort = do
    ls <- listenOn port
    spy' 0 target targetPort ls `finally` sClose ls

spy' :: Int -> String -> PortID -> Socket -> IO ()
spy' num target targetPort ls = do
  (client, clientHost, clientPort) <- accept ls
  server <- connectTo target targetPort
  mapM_ (\h -> hSetBinaryMode h True) [client, server]
  sync <- newMVar ()
  forkIO $ magicPipe server client (dumpData sync $ (show num) ++ " <<<") `finally` hClose server
  forkIO $ magicPipe client server (dumpData sync $ (show num) ++ " >>>") `finally` hClose client
  spy' (num+1) target targetPort ls

dumpData :: MVar () -> String -> String -> IO ()
dumpData sync delim buf = do
  let msg = case parse command delim buf of
              Left err  -> show err
              Right c -> show c

  withMVar sync $ \_ -> putStrLn (delim ++ " " ++ msg)

-- Will return EOF errors unlike hGetLine
tetrinetReadLine :: Handle -> IO String
tetrinetReadLine handle = do
  c <- hGetChar handle
  case c of
    '\xff' -> return ""
    '\x0a' -> return ""
    _ -> do
        cs <- tetrinetReadLine handle
        return (c:cs)

magicPipe :: Handle -> Handle -> (String -> IO ()) -> IO ()
magicPipe from to d = do
  line <- tetrinetReadLine from
  hPutStr to $ line ; hPutChar to '\xff' ; hFlush to
  d line
  magicPipe from to d