hstzaar-0.9.4: src/Main.hs

-- Main module for Haskell TZAAR game implementation
-- Pedro Vasconcelos, 2010
module Main (main) where

import Paths_hstzaar
import Board
import AI
import GUI
import Tournament
import Tests
import Data.List (intersperse)
import System.Environment
import System.Random
import System.Console.GetOpt
import System.Exit
import Control.Monad (when)
import System.Directory
import System.FilePath
import qualified Data.Map as Map

data Flag = Seed Int
          | NumMatches Int
          | DataDir FilePath
          | RunTests
            deriving Show


options :: [OptDescr Flag]
options = [Option ['s'] ["seed"] (ReqArg (Seed . read) "SEED")
                      "random number seed",
           Option ['n'] ["matches"] (ReqArg (NumMatches . read) "N")
                      "number of matches (for AI tournaments)",
           Option ['d'] ["dir"] (ReqArg DataDir "DATADIR")
                  "data directory",
           Option ['t'] ["tests"] (NoArg RunTests)
                      "run QuickCheck tests"
          ]

parseArgs :: [String] -> IO ([Flag],[String])
parseArgs argv
    =  case getOpt Permute options argv of
         (flags, argv', []) -> return (flags, argv')
         (_, _, errs) -> ioError $
                         userError $
                         concat errs ++ usageInfo header options ++ footer

header, footer :: String
header = "usage: hstzaar [OPTION..] [AI AI]"
footer = "\twhere AI is one of: " ++ unwords (map (show.name) aiPlayers)


-- default number of matches for AI tournaments
matches :: Int
matches = 10

processFlags :: [Flag] -> IO ()
processFlags = mapM_ process
    where
      process RunTests = run_tests >> exitSuccess
      process (Seed s) = setStdGen (mkStdGen s)
      process _        = return ()


main :: IO ()
main = do argv<-getArgs
          (flags, argv')<- parseArgs argv
          processFlags flags
          dir <- getDataDir
          let numMatches = last (matches : [n | NumMatches n <- flags])
          let gladepath = last (dir : [d | DataDir d <- flags]) </> "hstzaar.glade"
          --
          case argv' of
            [] -> gui gladepath
            [arg1,arg2] ->
              case do p1 <- lookupAI arg1 aiPlayers
                      p2 <- lookupAI arg2 aiPlayers
                      return (p1,p2)
              of Nothing -> ioError $
                            userError $ "invalid AI: " ++ unwords [arg1, arg2]
                 Just (p1,p2) ->
                   do rnd <- getStdGen
                      let (boards, rnd') = randomBoards numMatches rnd
                      setStdGen rnd'
                      playAIs p1 p2 boards rnd
            _ -> ioError $ userError $ usageInfo header options ++ footer