NiceGuy.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 tellThem :: Place -> [Player] -> DayMonad UserData ()
  20 tellThem room = mapM_ $ \friend -> do
  21                 actionsLeft <- asks psActionsLeft
  22                 if actionsLeft > 0
  23                  then do send (Tell friend (PartyAt room))
  24                          say $ "Told " ++ show friend ++ " about the party."
  25                  else do say $ "Can not tell " ++ show friend ++ " any more."
  26
  27 dcb :: DayCallback UserData
  28 dcb (DayStarts _) = do
  29         mbp <- asks psPartyPlace
  30         case mbp of
  31                 Nothing -> do
  32                         say $ "No idea where to go, waiting for hints..."
  33                 Just room -> do
  34                         say $ "Yay, I know where to go! (" ++ show room ++")"
  35                         send (Goto room)
  36                         friends <- asks psFriends
  37                         players <- asks psPlayersHere
  38                         tellThem room (nub (sort (friends ++ players)))
  39
  40 dcb (GotHint player (PartyAt room)) = do
  41         say $ "The " ++ show player ++ " told me about a party at " ++ show room ++"."
  42         modify ((player,room):)
  43
  44 dcb (DayEndsIn 1) = do
  45         mbp <- asks psPartyPlace
  46         hints <- get
  47         when (isNothing mbp && not (null hints)) $ do
  48                 friends <- asks psFriends
  49                 selected_hints <- case partition (\(p,_) -> p `elem` friends) hints of
  50                   ([],bad) -> do say $ "Some hints from non-friends " ++ show bad
  51                                  return bad
  52                   (good,_) -> do say $ "Some hints from friends " ++ show good
  53                                  return good
  54                 let choices = map snd selected_hints
  55                 pick <- liftIO $ randomRIO (0,length choices - 1)
  56                 say $ "Choosing " ++ show (choices !! pick)
  57                 send (Goto (choices !! pick))
  58
  59 dcb e = return ()
  60
  61 ncb :: NightCallback UserData
  62 ncb (NightResult {nrScore = score }) = do
  63         say $ "Got score: " ++ show score
  64         say $ "New Day, forget about yesterday"
  65         put []
  66
  67 main = parttyMain dcb ncb []