{-# LANGUAGE ViewPatterns #-}

module Main (main) where

import Safe
import Data.List
import System.IO
import System.Exit
import Web.DDP.Deadpan
import System.Environment
import Data.Maybe
import Control.Concurrent.Chan
import qualified System.Console.Haskeline   as R

main :: IO ()
main = getArgs >>= go

go :: [String] -> IO ()
go xs | hashelp xs            = help
go (getVersion -> (v, [url])) = void $ run (getURI url) v
go _                          = help >> exitFailure

-- TODO: No sane person would use this Maybe Maybe monstrosity, but aren't we all a little mad?

run :: Either Error Params -> Maybe (Maybe Version) -> IO ()
run (Left  err   ) _               = hPutStrLn stderr err >> exitFailure
run _              (Just Nothing)  = hPutStrLn stderr "Incorrect version specified..." >> exitFailure
run (Right params) (Just (Just v)) = runPingClientVersion params v (logEverything >> sendMessages)
run (Right params) Nothing         = runPingClient        params   (logEverything >> sendMessages)

-- TODO: Allow a full DSL to be used rather than just messages?
--
sendMessages :: DeadpanApp ()
sendMessages = do
  c <- liftIO newChan
  let settings = R.defaultSettings { R.autoAddHistory = True }
  void $ fork $ liftIO $ R.runInputT settings (inOutLoop c)
  contents <- liftIO (getChanContents c)
  mapM_ sendPossibleMessage (catMaybes (takeWhile isJust contents))

inOutLoop :: Chan (Maybe String) -> R.InputT IO ()
inOutLoop c = do
  maybeLine <- R.getInputLine ""
  case maybeLine of
    Nothing     -> liftIO $ writeChan c Nothing -- EOF / control-d
    Just "exit" -> liftIO $ writeChan c Nothing
    Just "help" -> liftIO instructions >> inOutLoop c
    Just ""     -> inOutLoop c
    Just line   -> liftIO (writeChan c (Just line)) >> inOutLoop c

sendPossibleMessage :: String -> DeadpanApp ()
sendPossibleMessage msgStr = do
  let decoded = decodeString msgStr
  case decoded of Just m  -> sendData m
                  Nothing -> liftIO $ putStrLn "Invalid Message"

getVersion :: [String] -> (Maybe (Maybe Version), [String])
getVersion ss = (extractVersion ss, deleteVersion ss)

extractVersion :: [String] -> Maybe (Maybe Version)
extractVersion ("-v"        : x : _ ) = Just $ readMay x
extractVersion ("--version" : x : _ ) = Just $ readMay x
extractVersion (              _ : xs) = extractVersion xs
extractVersion _                      = Nothing

deleteVersion :: [String] -> [String]
deleteVersion ("-v"        : _ : xs) = deleteVersion xs
deleteVersion ("--version" : _ : xs) = deleteVersion xs
deleteVersion (              x : xs) = x : deleteVersion xs
deleteVersion xs                     = xs

hashelp :: [String] -> Bool
hashelp xs = any (`elem` xs) (words "-h --help")

help :: IO ()
help = hPutStrLn stderr $ "Usage: deadpan [-h | --help] [ ( -v | --version ) "
    ++ "( " ++ intercalate " | " (map show $ reverse [minBound :: Version ..]) ++ " )"
    ++ " ] <URL>"

instructions :: IO ()
instructions = hPutStrLn stderr $ unlines [ "Input EJSON messages to send to the server."
                                          , "\"exit\" to exit."
                                          , "\"help\" for instructions."
                                          ]