hstzaar-0.9.3: src/Main.hs

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

import Paths_hstzaar
import Board
import AI
import GUI
import Serialize
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 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
          rnd <- getStdGen
          (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] -> case lookupAI arg1 aiPlayers of
              Nothing -> ioError $ 
                         userError $ "invalid AI: " ++ arg1
              Just ai -> 
                do { txt <- getContents  -- read start position
                   ; case readXML txt of 
                     Nothing -> putStrLn "ERROR: couldn't parse game file"
                     Just g -> playAI rnd ai (board g) 
                   }
            [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 let (boards, rnd') = randomBoards numMatches rnd
                      setStdGen rnd'
                      playAIs p1 p2 boards rnd
            _ -> ioError $ userError $ usageInfo header options ++ footer




playAI :: StdGen -> AI -> Board -> IO ()
playAI rnd ai b 
  | endGame b = putStrLn ("Game end (" ++ show (invert $ active b) ++ " won)")
  | otherwise = putStrLn (show (active b) ++ ": " ++ showMove m)
  where (score, m, _) = playing ai b rnd