SimpleStrategy.hs

{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
module Game.Hanabi.Strategies.SimpleStrategy where
import Game.Hanabi hiding (main)
import System.Random
import Data.Maybe(isNothing)

-- An example of a simple and stupid strategy.
data Simple = S

instance Monad m => Strategy Simple m where
  strategyName ms = return "Stupid example strategy"
  move (pv:_) mvs s = let  pub = publicView pv
                           nextPlayersHand = head $ handsPV pv ::[Card]
                           nextPlayersHints = givenHints pub !! 1
                           nextPlayer = zip3 [0..] nextPlayersHand nextPlayersHints
                           myHints = head $ givenHints pub
                           myPos   = head $ possibilities pub
                           numHand = length myHints
                           mov = case filter (\(ix, te, hint) -> not (isHinted hint) && isCritical pub te) nextPlayer of
                                                             [] -> foo
                                                             us -> tryMove pv (Hint 1 $ Right (number $ sndOf3 $ last us)) foo
                                   where foo = case break (\(_,card,_) -> isPlayable pub card) nextPlayer of
                                                 (ts,(_,d,(Nothing, _))     :_) | hintTokens pub >= 3 && all (\(_,c,_) -> color c /= color d) ts -> Hint 1 $ Left $ color d
                                                 (ts,(_,d,(Just _, Nothing)):_) | hintTokens pub >= 4 -> Hint 1 $ Right $ number d  -- This should actually be ANY card.
                                                 _              ->
                                                   case filter (\(i,marks,pos) -> isDefinitelyPlayable pv marks pos) $ zip3 [0..] myHints myPos of
                                                     (i,_,_):_ -> Play i
                                                     []        ->
                                                       case mvs of
                                                         Hint 1 (Left c) : _ | isDefinitelyUseless pv (myHints!!i) (myPos!!i) -> tryMove pv (Drop i) rest
                                                                             | otherwise -> Play i
                                                           where i = length $ takeWhile ((/=Just c) . fst) $ head $ givenHints $ publicView pv
                                                         _                   -> rest
                                                       where rest = case definiteChopss pv myHints myPos of
                                                                        ((i:_):_) -> tryMove pv (Drop i)
                                                                                                (Hint 1 $ Right $ number $ last $ nextPlayersHand)
                                                                        _         -> tryMove pv (Hint 1 $ Right $ number $ last $ nextPlayersHand)
                                                                                                (Drop $ pred numHand)
                       in return (mov, s)

sndOf3 (_,b,_) = b

main = do g <- newStdGen
--          ((eg,_),_) <- start defaultGS [] ([S],[stdio]) g -- Play it with standard I/O (human player).
          ((eg,_),_) <- start defaultGS [peek] [S,S] g -- Play it with itself.
          putStrLn $ prettyEndGame eg