hstzaar-0.8: 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
import System.Random
import System.Console.GetOpt
import System.Exit
import Control.Monad (when)
import System.Directory
import System.FilePath


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 fst 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
            [a1,a2] | a1`elem`ais && a2`elem`ais-> 
                      do let numboards = max 1 (numMatches`div`2)
                         rndgen <- getStdGen
                         let (boards, rnd) = randomBoards numboards rndgen
                         playAIs (toAI a1) (toAI a2) boards rnd
            _ -> ioError $ userError $ usageInfo header options ++ footer
    where ais = map fst aiPlayers



toAI :: String -> AI
toAI ai = maybe (error ("invalid ai: "++ai)) id (lookup ai aiPlayers)