module Main(main) where

import Concurrent
import Monad(unless)
import Network 
import Posix(installHandler,sigPIPE,Handler(Ignore))
import System(getArgs,exitFailure)
import GetOpt
import IO(stderr,hPutStrLn)
import Utils

import qualified Board(load)
import qualified Server
import Opts


--------------------------------------------------------------------------------
-- command line options
--------------------------------------------------------------------------------

default_options = Opt
  { portNum   = PortNumber 20005
  , gameType  = Continuous
  , mapFile   = Nothing
  , packFile  = Nothing
  , fuel      = 5000
  , capacity  = 50
  , verbosity = Normal
  , initPos   = (1,1)
  , initPoses = []
  , timeout   = Nothing
  }

options = 
  [ Option ['p'] ["port"] (ReqArg (rd port) "NUM")   
    "port to listen on"

  , Option ['n'] ["new"] (ReqArg (rd manyGames) "NUM")
    "new game every NUM players"

  , Option ['o'] ["one"] (ReqArg (rd oneGame) "NUM")
    "one game with NUM players"

  , Option ['m'] ["map"] (ReqArg mapF "FILE")   
    "the map to use for the game"

  , Option ['k'] ["packs"] (ReqArg packF "FILE")
    "locations of packages"

  , Option ['f'] ["fuel"] (ReqArg (rd setFuel) "NUM") 
    "fuel for each player"

  , Option ['c'] ["capacity"] (ReqArg (rd setCapa) "NUM") 
    "capacity for each player"
  
  , Option ['v'] ["verbose"] (NoArg verb)
    "display a lot of info"

  , Option ['q'] ["quiet"] (NoArg quiet)
    "don't display any info"

  , Option ['i'] ["init"] (ReqArg (rd setInitP) "(NUM,NUM)")
    "set the default initial position"

  , Option ['j'] ["inits"] (ReqArg (rd setInitPs) "[(NUM,NUM)]")
    "set the first initial positions"

  , Option ['t'] ["timeout"] (ReqArg (rd setTimeout) "NUM")
    "set timeout in millisecs"

  , Option ['r'] ["robo"] (ReqArg rd_player "NUM:(NUM,NUM):CMD")
    "a player with uid:initial_pos:command"
  ]
  where
  rd f x opts = 
    case parse x of
      Nothing -> opts
      Just y -> f y opts 

  rd_player x opts = 
    case linesBy (== ':') x of
      a:b:c:_ -> maybe opts addPl $ 
                    do uid <- parse a
                       pos <- parse b
                       return (uid,pos,c)
      _ -> opts

    where
    addPl y = case opts of 
                Opt { gameType = OneGamePlayers ys } -> 
                  opts { gameType = OneGamePlayers (y:ys) }
                _ -> opts { gameType = OneGamePlayers [y] }
    
    

  port x opts = opts { portNum = PortNumber (fromIntegral x) }

  manyGames x opts = opts { gameType = ManyGames x }
  oneGame x opts = opts { gameType = OneGame x }

  setTimeout x opts = opts { timeout = Just x } 
  setInitP x opts = opts { initPos = x } 
  setInitPs x opts = opts { initPoses = x } 
  setFuel x opts  = opts { fuel = x }
  setCapa x opts  = opts { capacity = x }
  packF x opts    = opts { packFile = Just x }
  mapF x opts     = opts { mapFile = Just x }
  verb opts       = opts { verbosity = Chatty }
  quiet opts      = opts { verbosity = Quiet }



  

--------------------------------------------------------------------------------
-- the driver
--------------------------------------------------------------------------------
main = withSocketsDo $
  do installHandler sigPIPE Ignore Nothing
     args <- getArgs
     let (optFs,_,errs) = getOpt Permute options args
	 opts = foldr ($) default_options optFs

     unless (null errs) showUsage
     let invalidMapFile  = putStrLn "Invalid map file"  >> exitFailure
	 invalidPackFile = putStrLn "Invalid pack file" >> exitFailure
  
     (mapF,packF) <- maybe showUsage return $ 
      do mapF <- mapFile opts
         packF <- packFile opts
         return (mapF,packF)

     board <- maybe invalidMapFile return =<< Board.load mapF
     packs <- maybe invalidPackFile return . parse =<< readFile packF

     let opts1 = opts { mapFile = board, packFile = packs }

     Server.start opts1
     

showUsage = do
  hPutStrLn stderr $ usageInfo "Required: map and packs.\n usage:" options
  exitFailure