Zweifler.hs

   1 import Control.Monad.Trans
   2 import Control.Monad.State
   3 import Control.Monad.Reader
   4 import System.Random
   5 import Partty
   6
   7 import qualified Data.Map as M
   8 import Data.Map ((!))
   9 import Data.List
  10 import Data.Ord
  11 import Data.Maybe
  12
  13 {-
  14  - Nice Guy: Spreads Hints, follows Hints
  15  -}
  16
  17 type UserData = ([(Player,Place)])
  18
  19 isLiar :: Player -> DayMonad UserData Bool
  20 isLiar player = do
  21         hist <- asks psHistory
  22         hhist <- asks psHintHistory
  23         return $ any (\nr ->
  24                 any (\(d, player', h) ->
  25                         d == nrDay nr &&
  26                         player == player' &&
  27                         case h of PartyAt p' -> nrPartyAt nr /= p'
  28                                   _          -> False
  29                      ) hhist
  30                 ) hist
  31
  32 tellThem :: Place -> [Player] -> DayMonad UserData ()
  33 tellThem room = mapM_ $ \friend -> do
  34                 actionsLeft <- asks psActionsLeft
  35                 if actionsLeft > 0
  36                  then do send (Tell friend (PartyAt room))
  37                          say $ "Told " ++ show friend ++ " about the party."
  38                  else do say $ "Can not tell " ++ show friend ++ " any more."
  39
  40 dcb :: DayCallback UserData
  41 dcb (DayStarts _) = do
  42         mbp <- asks psPartyPlace
  43         case mbp of
  44                 Nothing -> do
  45                         say $ "No idea where to go, waiting for hints..."
  46                 Just room -> do
  47                         say $ "Yay, I know where to go! (" ++ show room ++")"
  48                         send (Goto room)
  49                         friends <- asks psFriends
  50                         players <- asks psPlayersHere
  51                         tellThem room (nub (sort (friends ++ players)))
  52
  53 dcb (GotHint player (PartyAt room)) = do
  54         liar <- isLiar player
  55         if liar then do
  56                 say $ "The Liar " ++ show player ++ " told me about a party at " ++ show room ++"."
  57               else do
  58                 say $ "The " ++ show player ++ " told me about a party at " ++ show room ++"."
  59                 modify ((player,room):)
  60
  61 dcb (DayEndsIn 1) = do
  62         mbp <- asks psPartyPlace
  63         hints <- get
  64         when (isNothing mbp && not (null hints)) $ do
  65                 friends <- asks psFriends
  66                 selected_hints <- case partition (\(p,_) -> p `elem` friends) hints of
  67                   ([],bad) -> do say $ "Some hints from non-friends " ++ show bad
  68                                  return bad
  69                   (good,_) -> do say $ "Some hints from friends " ++ show good
  70                                  return good
  71                 let choices = map snd selected_hints
  72                 pick <- liftIO $ randomRIO (0,length choices - 1)
  73                 say $ "Choosing " ++ show (choices !! pick)
  74                 send (Goto (choices !! pick))
  75
  76 dcb e = return ()
  77
  78 ncb :: NightCallback UserData
  79 ncb (NightResult {nrScore = score }) = do
  80         say $ "Got score: " ++ show score
  81         say $ "New Day, forget about yesterday"
  82         put []
  83
  84 main = parttyMain dcb ncb []