module PlayTakBot where
import Data.Maybe
import Safe
import System.Log.Logger
import Tak
import PlayTak
class Bot b where
botName :: b -> String
botPassword :: b -> String
botEvaluate :: b -> Colour -> GameState -> Double
botChoosePlay :: b -> BotGameState -> (Play, BotGameState, Double)
botHandle :: b -> PlayTakClient -> PlayTakMsg -> BotState -> IO BotState
botHandle = botHandleDefault
botHandleDefault :: b -> PlayTakClient -> PlayTakMsg -> BotState -> IO BotState
botHandleDefault = handle
data BotState = BotState {
bstGame :: Maybe (Int, BotGameState)
}
data BotGameState = BotGameState {
bgsTree :: GameNode Double,
bgsColour :: Colour
}
instance Show BotGameState where
show (BotGameState tree _) = show $ treeGameState tree
runBot :: Bot b => b -> IO ()
runBot bot = do
infoM (botName bot) "Starting up."
playTakClient (botHandle bot) (BotState Nothing)
handle :: Bot b => b -> PlayTakClient -> PlayTakMsg -> BotState -> IO BotState
handle bot ptc Welcome state = do
client ptc (botName bot)
return state
handle bot ptc PleaseLogin state = do
login ptc (botName bot) (botPassword bot)
return state
handle bot ptc (LoggedIn _) state = do
infoM (botName bot) "Logged in"
seekIfNeeded bot ptc state
return state
handle _ _ (SeekNew _ _ _ _) state = do
return state
handle _ _ (SeekRemove _ _ _ _) state = do
return state
handle bot ptc (GameStart game size player1 player2 colour) state = do
infoM (botName bot) $ "Starting game: " ++ player1 ++ " vs " ++ player2
infoM (botName bot) $ "Size is " ++ show size ++ ", we are " ++ show colour
let botGameState = newGame bot size colour White
state' = state{bstGame = Just (game, botGameState)}
state'' <- if ourmove botGameState
then makePlay bot ptc state'
else return state'
return state''
handle bot ptc (PlayMsg gameno p) state = do
let (gameno', botGameState) = fromJustNote "Game not started" $ bstGame state
GameNode gameState _ branches = bgsTree botGameState
gameTree' = headNote ("Unexpected play: " ++ listPlays) $ catMaybes $ map tree branches
where
listPlays = show $ map (\ (GameBranch p2 _) -> p2) branches
tree (GameBranch p2 node)
| p == p2 = Just node
| otherwise = Nothing
gameState' = treeGameState gameTree'
botGameState' = botGameState{bgsTree = gameTree'}
state' = state{bstGame = Just (gameno, botGameState')}
if gameno /= gameno'
then error "Wrong game number"
else return ()
infoM (botName bot) $ "Their move: " ++ ptn (stBoard gameState) p
infoM (botName bot) $ show gameState'
if stFinished gameState' == Nothing
then makePlay bot ptc state'
else return state'
handle _ _ OK state = do
return state
handle _ _ (Online _) state = do
return state
handle _ _ (Shout _ _) state = do
return state
handle _ _ (GameListAdd _ _ _ _ _ _ _ _) state = do
return state
handle _ _ (GameListRemove _ _ _ _ _ _ _ _) state = do
return state
handle _ _ (Time _ _ _) state = do
return state
handle bot ptc (Abandon _) state = do
infoM (botName bot) $ "Game abandoned"
seekIfNeeded bot ptc state
return $ state{bstGame = Nothing}
handle bot ptc (Over _ p1 p2) state = do
infoM (botName bot) $ "Game over: " ++ show p1 ++ "-" ++ show p2
seekIfNeeded bot ptc state
return $ state{bstGame = Nothing}
handle bot _ msg state = do
warningM (botName bot) $ "Unhandled message '" ++ show msg ++ "'."
return state
seekIfNeeded :: Bot b => b -> PlayTakClient -> BotState -> IO ()
seekIfNeeded bot ptc _ = do
infoM (botName bot) "Seeking new game"
seek ptc 5 (30 * 60) 0 Nothing
makePlay :: Bot b => b -> PlayTakClient -> BotState -> IO BotState
makePlay bot ptc state = do
let (gameno, botGameState) = fromJustNote "Game not started" $ bstGame state
(next, botGameState', score) = botChoosePlay bot botGameState
tree = bgsTree botGameState
gameState = treeGameState tree
tree' = bgsTree botGameState'
gameState' = treeGameState tree'
infoM (botName bot) $ "My move: " ++ ptn (stBoard gameState) next
infoM (botName bot) $ show gameState'
infoM (botName bot) $ "Score: " ++ show score
sendPlay ptc gameno next
if stFinished gameState' /= Nothing
then infoM (botName bot) "Game over"
else do
let (next', _, _) = botChoosePlay bot botGameState'
infoM (botName bot) $ "Predicted move: " ++ ptn (stBoard gameState') next'
return $ state{bstGame = Just (gameno, botGameState')}
newGame :: Bot b => b -> Int -> Colour -> Colour -> BotGameState
newGame bot size colour playsFirst =
BotGameState (gameTree (initialState size playsFirst) (botEvaluate bot colour)) colour
ourmove :: BotGameState -> Bool
ourmove (BotGameState (GameNode state _ _) colour) = stPlaysNext state == colour