hs-pgms-0.1.0.1: src/Main.hs
-- |
-- Module : Main
-- Copyright : (c) 2008 Bertram Felgenhauer
-- License : BSD3
--
-- Maintainer : Bertram Felgenhauer <int-e@gmx.de>
-- Stability : experimental
-- Portability : portable
--
-- This module is part of Haskell PGMS.
--
module Main (main) where
import Mine
import Util
import GUI
import Strategies
import System.Random
import Control.Monad.State
import Control.Monad.Prompt
import Control.Concurrent
import Control.Exception
import System.Console.GetOpt
import System.Environment
import System.Exit
import System.IO
import Data.Char
-- state for command line processing
data MainState = MainState {
mVerbose :: Bool, -- verbose flag
mIterations :: Int, -- number of iterations for statistics
mStrategy :: Strategy, -- current strategy
mConfig :: Config, -- current config (difficulty)
mRun :: Bool -- has a -r option been seen?
}
-- initial state
defaultState :: MainState
defaultState = MainState {
mVerbose = False,
mIterations = 1,
mStrategy = head strategies,
mConfig = intermediate,
mRun = True
}
-- and a state monad to wrap it
newtype Main a = Main { runMain :: StateT MainState IO a} deriving
(Monad, MonadIO, MonadState MainState)
-- Our main function. getOpt does most of the real work.
main :: IO ()
main = do
(acts, extra, errors) <- liftM (getOpt RequireOrder options) getArgs
if not (null extra) || not (null errors) then do
-- wrong arguments? -> display help.
usage
else if null acts then do
-- no arguments? -> run GUI
mainGUI'
else do
-- otherwise process the associated actions for the arguments in order.
evalStateT (runMain (sequence_ acts >> defaultRun)) defaultState
options :: [OptDescr (Main ())]
options = [
Option "s" ["strategy"] (ReqArg setStrategy "number")
"Set the current strategy.",
Option "l" ["list"] (NoArg listStrategies)
"List all strategies.",
Option "r" ["run"] (NoArg runGame)
"Run current strategy.",
Option "d" ["difficulty"] (ReqArg setDiff "name")
"Set a standard difficulty level.",
Option "c" ["config"] (ReqArg setConfig "w:h:m")
"Select a custom configuration.",
Option "i" ["iterations"] (ReqArg setIterations "number")
"Set the number of games for --run.",
Option "" ["info"] (NoArg info)
"Display information about current strategy.",
Option "h" ["help"] (NoArg usage')
"Display this help message.",
Option "v" ["verbose"] (NoArg setVerbose)
"Be verbose while running strategies."]
-- wrapper for mainGUI - we need to run the GUI in a bound thread, and we
-- need to wait for it to finish. this function takes care of that.
mainGUI' :: IO ()
mainGUI' = do
finish <- newEmptyMVar
forkOS (finally (mainGUI strategies) (putMVar finish ()))
readMVar finish
-- list all strategies
listStrategies :: Main ()
listStrategies = liftIO $ do
forM_ (zip [1..] strategies) $ \(n, s) -> do
putStrLn (show n ++ ": " ++ sName s)
-- print help message
usage :: IO ()
usage = do
putStr $ usageInfo (formatString "\
\Usage: mine [OPTION]...\n\
\The options are processed in order. If no option is given, a GUI \
\will be displayed. The following options are recognized:")
options
-- version of usage for the `Main' monad
usage' :: Main ()
usage' = do
liftIO usage
modify $ \s -> s { mRun = False }
-- set strategy
-- strategies can be identified by their number (according to the list above)
-- or by their name. matching is case insensitive in the latter case.
setStrategy :: String -> Main ()
setStrategy str = case reads str of
[(i, "")] | i > 0 && i <= length strategies -> do
modify $ \s -> s { mStrategy = strategies !! (i-1) }
_ -> case filter (matchStrategy str) strategies of
[st] -> modify $ \s -> s { mStrategy = st }
_ -> liftIO $ do
hPutStr stderr $ "Unknown strategy '" ++ str ++ "'\n"
exitFailure
where
matchStrategy name strat = map toLower name == map toLower (sName strat)
-- set number of iterations for statistics gathering
setIterations :: String -> Main ()
setIterations str = case reads str of
[(i, "")] | i > 0 -> do
modify $ \s -> s { mIterations = i }
_ -> liftIO $ do
hPutStr stderr $ "Invalid number of iterations '" ++ str ++ "'\n"
exitFailure
-- set verbose flag
setVerbose :: Main ()
setVerbose = do
modify $ \s -> s { mVerbose = True }
-- set difficulty level
setDiff :: String -> Main ()
setDiff str = case lookup (map toLower str) difficulties of
Just cfg -> modify $ \s -> s { mConfig = cfg }
Nothing -> liftIO $ do
hPutStr stderr $ "Unknown difficulty level '" ++ str ++ "'\n"
exitFailure
where
difficulties = [("beginner", beginner),
("intermediate", intermediate),
("expert", expert)]
-- set configuration
setConfig :: String -> Main ()
setConfig str = case [ Config (Pos w h) m
| (w, ':' : str') <- reads str,
(h, ':' : str'') <- reads str',
(m, "") <- reads str''] of
[cfg] | validConfig cfg -> do modify $ \s -> s { mConfig = cfg }
| otherwise -> liftIO $ do
hPutStr stderr $ "Invalid config '" ++ str ++ "'\n"
exitFailure
_ -> liftIO $ do
hPutStr stderr $ "Syntax error in config '" ++ str ++ "'\n"
exitFailure
-- print meta-information of strategy
info :: Main ()
info = do
strat <- gets mStrategy
liftIO $ do
putStrLn $ "Strategy name: " ++ sName strat
putStrLn $ "Author : " ++ sAuthor strat
putStr $ "\n" ++ formatString (sDescription strat)
-- run a game or a series of games
runGame :: Main ()
runGame = do
verbose <- gets mVerbose
iter <- gets mIterations
strat <- gets mStrategy
cfg <- gets mConfig
modify $ \s -> s { mRun = False }
let -- play a single game
runSingleGame :: IO (Result String)
runSingleGame = do
[gen1, gen2] <- replicateM 2 newStdGen
let game = playGameP cfg gen1 (sRun strat gen2)
handle :: Play a -> IO a
handle Start {} = return ()
handle Update {} = return ()
-- if verbose, print trace messages with board
handle (Trace s b)
| verbose = putStrLn (show b ++ s)
| otherwise = return ()
(res, brd) <- runPromptM handle game
-- if verbose, print game result and final board
when verbose $ putStr (show res ++ show brd)
return res
-- gather statistics for a series of games
stats :: Int -> Int -> Int -> Int -> IO (Int, Int, Int)
stats 0 !w !u !l = return (w, u, l)
stats i !w !u !l = do
res <- runSingleGame
when (verbose && i > 1) $ putStrLn "-----"
case res of
Won -> stats (i-1) (w+1) u l
Unfinished _ -> stats (i-1) w (u+1) l
Lost -> stats (i-1) w u (l+1)
liftIO $ do
(w, u, l) <- stats iter 0 0 0
let summary n = show n ++ "/" ++ show (w+u+l) ++ " (" ++
show (fromIntegral n / fromIntegral (w+u+l) * 100) ++ "%)"
-- print statistics if more than one game was run.
when (iter > 1) $ do
putStrLn $ "Summary for " ++ sName strat
putStrLn $ " won: " ++ summary w
putStrLn $ " lost: " ++ summary l
when (u > 0) $ putStrLn $ " unfinished: " ++ summary u
return ()
-- to make the -r argument optional, we call runGame by default if
-- it has not appeared.
defaultRun :: Main ()
defaultRun = do
run <- gets mRun
when run runGame