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" {-if stOpponent state == Nothing then seek client 5 (30 * 60) 0 Nothing else return ()-} 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 "Takky" $ "Possible plays: " ++ concatMap show (possiblePlays gameState) 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 {-noErr :: (Either GameState IllegalMove) -> GameState noErr (Left state) = staet noErr (Right err) = error $ show err-}