{-# LANGUAGE DoAndIfThenElse       #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Main (main) where

import           Control.Concurrent
import           Control.Concurrent.STM
import           Control.Exception                   as E hiding (bracket)
import           Control.Monad.State
import           Data.Maybe
import           Data.Time.Clock
import           Data.Version                        (showVersion)
import           Network.BSD
import           Nomyx.Language                      hiding (getCurrentTime)
import           Nomyx.Core.Engine                   hiding (runEvaluate)
import           Nomyx.Core.Engine.Evaluation        hiding (runEvaluate)
import           Nomyx.Core.Engine.Test              as LT
import           Nomyx.Core.Engine.Interpret
import           Nomyx.Core.Multi                    as Multi
import           Nomyx.Core.Profile
import           Nomyx.Core.Serialize                as Serialize
import           Nomyx.Core.Session
import           Nomyx.Core.Test
import           Nomyx.Core.Types
import           Nomyx.Core.Utils
import           Nomyx.Web.MainPage
import           Nomyx.Api.Server                    (serveApi, putSwaggerYaml)
import           Paths_nomyx_server                  as PN
import           Paths_nomyx_language                as PNL
import           Paths_nomyx_web                     as PNW
import           Paths_nomyx_library                 as PNLib
import           Safe
import           System.Console.GetOpt
import           System.Directory                    (canonicalizePath,
                                                      doesFileExist,
                                                      removeDirectoryRecursive,
                                                      removeFile)
import           System.Environment
import           System.Exit
import           System.FilePath                     ((</>))
import           System.Log.Logger
import           System.Log.Formatter
import           System.Log.Handler hiding (setLevel)
import           System.Log.Handler.Simple
import           System.Log.Handler.Log4jXML
import           System.IO
import           Imprevu.Evaluation.TimeEval
import           Imprevu.Evaluation.EventEval
import           Imprevu.Evaluation.Types
import           Control.Lens

-- | Entry point of the program.
main :: IO Bool
main = do
   args <- getArgs
   (flags, _) <- nomyxOpts args
   if Version `elem` flags then putStrLn $ "Nomyx " ++ showVersion PN.version
   else if Help `elem` flags then putStrLn $ usageInfo header options
   else if API `elem` flags then putSwaggerYaml
   else do
      putStrLn "Welcome to Nomyx!"
      putStrLn "Type \"Nomyx --help\" for usage options"
      start flags
   return True

start :: [Flag] -> IO ()
start flags = do
   defWebDir    <- PNW.getDataDir
   defSourceDir <- PNL.getDataDir
   defLib       <- PNLib.getDataFileName "templates.yaml"
   hostName     <- getHostName
   let port        = read $ fromMaybe "8000" (findPort flags)
   let host        = fromMaybe hostName      (findHost flags)
   let adminPass   = fromMaybe "NXPSD"       (findAdminPass flags)
   let sendMail    = SendMails `elem` flags
   let webDir      = fromMaybe defWebDir     (findWebDir flags)    -- data directory: web ressources and profiles
   let sourceDir   = fromMaybe defSourceDir  (findSourceDir flags) -- source directory: Nomyx-Language files
   let libraryPath = fromMaybe defLib        (findLibrary flags)
   let watchdog    = fromMaybe 10 (read <$> findWatchdog flags)
   let mLoad       = findLoadTest flags
   let verbose     = Verbose `elem` flags
   let isTTY       = not $ NoTTY `elem` flags
   let mailHost    = fromMaybe "" (findMailHost flags)
   let mailLogin   = fromMaybe "" (findMailLogin flags)
   let mailPass    = fromMaybe "" (findMailPass flags)
   -- save directory: Nomyx.save and uploaded files
   saveDir <- case findTarFile flags of
      Just tarFile -> untar tarFile
      Nothing -> case findSaveDir flags of
         Just f -> canonicalizePath f
         Nothing -> PN.getDataDir
   let mailSettings = MailSettings sendMail mailHost mailLogin mailPass 
   let settings    = Settings (Network host port) mailSettings adminPass saveDir webDir sourceDir watchdog
   when verbose $ putStrLn $ "Directories:\n" ++ "save dir = " ++  saveDir ++ "\nweb dir = " ++ webDir ++ "\nsource dir = " ++ sourceDir
   if Test `elem` flags
      then runTests mLoad watchdog
      else if DeleteSaveFile `elem` flags then cleanFile saveDir
      else mainLoop settings saveDir host port libraryPath isTTY


mainLoop :: Settings -> FilePath -> HostName -> Port -> FilePath -> Bool -> IO ()
mainLoop settings saveDir host port lib isTTY = do
   startLog $ saveDir </> "nomyx-log.xml"
   serverCommandUsage
   --creating game structures
   multi <- Main.loadMulti settings lib
   --main loop
   withAcid (Just $ saveDir </> profilesDir) $ \acid -> do
     ts <- atomically $ newTVar (Session multi acid)
     --start the web server
     forkIO $ launchWebServer ts (Network host port)
     forkIO $ launchTimeEvents' ts
     when isTTY $ void $ forkIO $ serverLoop ts
     --start the REST API
     serveApi ts

launchTimeEvents' :: TVar Session -> IO ()
launchTimeEvents' tv = do
    now <- getCurrentTime
    debug "tick"
    s <- atomically $ readTVar tv
    let gs = toListOf (multi . gameInfos . traverse . loggedGame . game) s
    let ss = mapM_ (applyTimeEvent now) gs
    s' <- execStateT ss s
    atomically $ writeTVar tv s'
    save (_multi s')
    --sleep 5 second roughly
    threadDelay 5000000
    launchTimeEvents' tv


loadMulti :: Settings -> FilePath -> IO Multi
loadMulti set libPath = do
   fileExists <- doesFileExist $ getSaveFile set
   if fileExists then do
      info $ "Loading game: " ++ getSaveFile set
      Serialize.loadMulti set `E.catch` (errMsg set)
   else do
      lib <- readLibrary libPath
      let defMulti = defaultMulti set lib
      execStateT (newGame' "Default game" (GameDesc "This is the default game." "") 0 True) defMulti where

errMsg :: Settings -> ErrorCall -> IO Multi
errMsg set e = do
  err $ "Error while loading logged events, log file discarded\n" ++ show (e::ErrorCall)
  return $ defaultMulti set (Library [rAutoActivate] [])

runTests :: Maybe String -> Int -> IO ()
runTests mTestName delay = do
   ts <- playTests mTestName delay
   info $ "\nNomyx Game Tests results:\n" ++ concatMap (\(a,b) -> a ++ ": " ++ show b ++ "\n") ts
   let pass = all snd ts
   info $ "All Tests Pass: " ++ show pass
   if pass then exitSuccess else exitFailure

cleanFile :: FilePath -> IO ()
cleanFile saveDir = do
   info "Deleting save files"
   let catchExp io = io `catch` (\(e::SomeException)-> print e)
   catchExp $ removeDirectoryRecursive $ saveDir </> profilesDir
   catchExp $ removeDirectoryRecursive $ saveDir </> uploadDir
   catchExp $ removeDirectoryRecursive $ saveDir </> authDir
   catchExp $ removeFile               $ saveDir </> saveFile
   catchExp $ removeFile               $ "nomyx-log.xml"

-- | a loop that will handle server commands
serverLoop :: TVar Session -> IO ()
serverLoop ts = do
   s <- getLine
   case s of
      "d" -> do
         s <- atomically $ readTVar ts
         print $ _multi s
         pfs <- getAllProfiles s
         print pfs
      _ -> putStrLn "command not recognized"
   serverLoop ts

serverCommandUsage :: IO ()
serverCommandUsage = do
   putStrLn "Server commands:"
   putStrLn "d      -> debug"
   putStrLn "Ctrl-C -> quit"

-- | Launch mode
data Flag = Verbose
          | Version
          | Test
          | HostName String
          | Port String
          | LoadTest String
          | DeleteSaveFile
          | AdminPass String
          | Help
          | SaveDir FilePath
          | WebDir FilePath
          | SourceDir FilePath
          | TarFile FilePath
          | API
          | Watchdog String
          | LibraryPath FilePath
          | NoTTY
          | SendMails
          | MailHost String
          | MailLogin String
          | MailPass String
       deriving (Show, Eq)

-- | launch options description
options :: [OptDescr Flag]
options =
     [ Option "v" ["verbose"]   (NoArg Verbose)                     "chatty output on stderr"
     , Option "V" ["version"]   (NoArg Version)                     "show version number"
     , Option "h" ["host"]      (ReqArg HostName "Hostname")        "specify host name"
     , Option "p" ["port"]      (ReqArg Port "Port")                "specify port"
     , Option "n" ["delete"]    (NoArg DeleteSaveFile)              "delete all save files"
     , Option "t" ["tests"]     (NoArg Test)                        "perform routine check"
     , Option "l" ["loadtest"]  (ReqArg LoadTest "TestName")        "specify name of test to load (in combination with -t i.e. -t -l \"testName\")"
     , Option "a" ["adminPass"] (ReqArg AdminPass "AdminPass")      "specify the admin password (default is NXPSD)"
     , Option "?" ["help"]      (NoArg Help)                        "display usage options (this screen)"
     , Option "r" ["saveDir"]   (ReqArg SaveDir "SaveDir")          "specify save directory (for Nomyx.save and uploads)"
     , Option "f" ["dataDir"]   (ReqArg WebDir "WebDir")            "specify data directory (for profiles and website files)"
     , Option "s" ["sourceDir"] (ReqArg SourceDir "SourceDir")      "specify source directory (for Nomyx-Language files)"
     , Option "T" ["tar"]       (ReqArg TarFile "TarFile")          "specify tar file (containing Nomyx.save and uploads)"
     , Option ""  ["api"]       (NoArg API)                         "get swagger API file"
     , Option ""  ["watchdog"]  (ReqArg Watchdog "5")               "time in seconds before killing the compilation thread"
     , Option ""  ["library"]   (ReqArg LibraryPath "Library path") "specify the path of a library of rules (yaml file)"
     , Option ""  ["noTTY"]     (NoArg NoTTY)                       "Start headless"
     , Option "m" ["mails"]     (NoArg SendMails)                   "send mails to players when a new rule is posted (default is no)"
     , Option ""  ["mailHost"]  (ReqArg MailHost "MailHost")        "mail host (e.g. smtp.gmail.com)"
     , Option ""  ["mailLogin"] (ReqArg MailLogin "MailLogin")      "mail login (e.g. nomyx@gmail.com)"
     , Option ""  ["mailPass"]  (ReqArg MailPass "MailPass")        "mail password"
     ]

nomyxOpts :: [String] -> IO ([Flag], [String])
nomyxOpts argv =
       case getOpt Permute options argv of
          (o,n,[]  ) -> return (o,n)
          (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))

header :: String
header = "Usage: Nomyx [OPTION...]"

findPort, findHost, findLoadTest, findSaveDir, findWebDir, findSourceDir, findAdminPass, findTarFile, findWatchdog  :: [Flag] -> Maybe String
findPort      fs = listToMaybe [a | Port          a <- fs]
findHost      fs = listToMaybe [a | HostName      a <- fs]
findLoadTest  fs = listToMaybe [a | LoadTest      a <- fs]
findSaveDir   fs = listToMaybe [a | SaveDir       a <- fs]
findWebDir    fs = listToMaybe [a | WebDir        a <- fs]
findSourceDir fs = listToMaybe [a | SourceDir     a <- fs]
findAdminPass fs = listToMaybe [a | AdminPass     a <- fs]
findTarFile   fs = listToMaybe [a | TarFile       a <- fs]
findWatchdog  fs = listToMaybe [a | Watchdog      a <- fs]
findLibrary   fs = listToMaybe [a | LibraryPath   a <- fs]
findMailHost  fs = listToMaybe [a | MailHost      a <- fs]
findMailLogin fs = listToMaybe [a | MailLogin     a <- fs]
findMailPass  fs = listToMaybe [a | MailPass      a <- fs]

warn, info :: (MonadIO m) => String -> m ()
debug s = liftIO $ debugM "Nomyx.Main" s
info s = liftIO $ infoM "Nomyx.Main" s
warn s = liftIO $ warningM "Nomyx.Main" s
err s = liftIO $ errorM "Nomyx.Main" s
   

startLog :: FilePath -> IO ()
startLog fp = do
   stdoutHandler <- do
        lh <- streamHandler stdout INFO
        return $ setFormatter lh (simpleLogFormatter "[$time : $loggername : $prio] $msg")
   log4jHandler <- log4jFileHandler fp DEBUG
   
   updateGlobalLogger rootLoggerName removeHandler
   updateGlobalLogger "Nomyx"        (addHandler stdoutHandler)
   updateGlobalLogger rootLoggerName (addHandler log4jHandler)
   updateGlobalLogger rootLoggerName (setLevel DEBUG)