{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DoAndIfThenElse #-}

module Main
where

import Control.Concurrent (threadDelay)
import Control.DeepSeq (deepseq)
import Control.Exception.Base (bracket)
import Control.Monad (forever, when)
import Data.List (isPrefixOf)
import Data.Maybe (isNothing)
import Data.Monoid ((<>))
import Network (
  connectTo,
  PortID (PortNumber) )
import System.Console.CmdArgs (def)
import System.Directory (doesFileExist)
import System.Exit (ExitCode(..), exitWith)
import System.FilePath ((</>))
import System.IO (
  BufferMode (NoBuffering),
  Handle,
  hClose,
  hGetChar,
  hGetLine,
  hPutStr,
  hSetBuffering,
  stderr,
  stdout )
import System.IO.Error (catchIOError)

import CommandLine (get_args)
import Configuration (Configuration(..), merge_optional)
import ExitCodes (
  exit_no_feed_hosts,
  exit_no_password,
  exit_no_username )
import FeedHosts (FeedHosts(..))
import qualified OptionalConfiguration as OC (
  OptionalConfiguration(..),
  from_rc )
import Terminal (hPutRedLn, putGreenLn)
import TSN.Xml (parse_xmlfid, xml_prologue)


report_error :: String -> IO ()
report_error = hPutRedLn stderr


recv_line :: Handle -> IO String
recv_line h = do
  line <- hGetLine h
  putStrLn line
  return line


save_document :: Configuration -> String -> IO ()
save_document cfg doc = do
  case maybe_path of
    Nothing ->
      report_error "ERROR: document missing XML_File_ID element."
    Just path -> do
      already_exists <- doesFileExist path
      when already_exists $ do
        let msg = "WARNING: file " ++ path ++ " already exists. Overwriting."
        report_error msg
      writeFile path doc
  where
    xmlfid = fmap show (parse_xmlfid doc)
    filename = fmap (++ ".xml") xmlfid
    maybe_path = fmap ((output_directory cfg) </>) filename

-- | Loop forever, writing the buffer to file whenever a new XML
--   prologue is seen.
loop :: Configuration -> Handle -> [String] -> IO ()
loop !cfg !h !buffer = do
  line <- recv_line h

  if (xml_prologue `isPrefixOf` line && not (null buffer))
  then do
    -- This is the beginning of a new document, and we have an "old"
    -- one to save. The buffer is in reverse (newest first) order,
    -- though, so we have to reverse it first. We then concatenate all
    -- of its lines into one big string.
    let document = concat $ reverse buffer
    save_document cfg document
    loop cfg h [line] -- empty the buffer before looping again
  else
    loop cfg h (line : buffer) -- append line to the head of the buffer and loop


log_in :: Configuration -> Handle -> IO ()
log_in cfg h = do
  prompt1 <- recv_prompt h

  if prompt1 /= username_prompt then
    report_error "ERROR: didn't receive username prompt."
  else do
    send_line h (username cfg)
    prompt2 <- recv_prompt h

    if prompt2 /= password_prompt then
      report_error "ERROR: didn't receive password prompt."
    else do
      send_line h (password cfg)
      banner <- recv_line h -- "The Sports Network"
      banner `deepseq` return ()
  where
    username_prompt = "Username: "
    password_prompt = "Password: "

    send_line :: Handle -> String -> IO ()
    send_line h' s = do
      hPutStr h' (s ++ "\r\n")
      putGreenLn s

    recv_chars :: Int -> Handle -> IO String
    recv_chars n h' = do
      s <- sequence [ hGetChar h' | _ <- [1..n] ]
      putStr s
      return s

    recv_prompt :: Handle -> IO String
    recv_prompt = recv_chars 10

connect_and_loop :: Configuration -> IO ()
connect_and_loop cfg =
  bracket acquire_handle release_handle action
  where
    --acquire_handle = connectTo "feed1.sportsnetwork.com" (PortNumber 4500)
    acquire_handle = connectTo "feed2.sportsnetwork.com" (PortNumber 4500)
    --acquire_handle = connectTo "127.0.0.1" (PortNumber 13337)
    release_handle = hClose
    action h = do
      -- No buffering anywhere.
      hSetBuffering h NoBuffering
      log_in cfg h
      loop cfg h []


-- | A wrapper around threadDelay which takes seconds instead of
--   microseconds as its argument.
thread_sleep :: Int -> IO ()
thread_sleep seconds = do
  let microseconds = seconds * (10 ^ (6 :: Int))
  threadDelay microseconds


main :: IO ()
main = do
  rc_cfg <- OC.from_rc
  cmd_cfg <- get_args

  -- Merge the config file options with the command-line ones,
  -- prefering the command-line ones.
  let opt_config = rc_cfg <> cmd_cfg

  when (null $ get_feed_hosts (OC.feed_hosts opt_config)) $ do
    report_error "ERROR: no feed hosts supplied."
    exitWith (ExitFailure exit_no_feed_hosts)

  when (isNothing (OC.password opt_config)) $ do
    report_error "ERROR: no password supplied."
    exitWith (ExitFailure exit_no_password)

  when (isNothing (OC.username opt_config)) $ do
    report_error "ERROR: no username supplied."
    exitWith (ExitFailure exit_no_username)

  -- Finally, update a default config with any options that have been
  -- set in either the config file or on the command-line.
  let cfg = (def :: Configuration) `merge_optional` opt_config

  hSetBuffering stderr NoBuffering
  hSetBuffering stdout NoBuffering

  forever $ do
    catchIOError (connect_and_loop cfg) (report_error . show)
    thread_sleep 10 -- Wait 10s before attempting to reconnect.