Groupie.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
  12 {-
  13  - Groupie: Goes to the most successful player
  14  -}
  15 type UserData = M.Map Player Place
  16
  17 bestPlayer :: DayMonad UserData Player
  18 bestPlayer = do
  19         hist <- asks psHistory
  20         me   <- asks psMyName
  21         let hits = filter (/= me) $ concatMap (\nr ->
  22                 map fst $ filter (\(_,p) -> p == nrPartyAt nr) $ nrPlayersAt nr)
  23                 hist
  24         if null hits
  25          then return me
  26          else do let (who, count) = maximumBy (comparing snd)
  27                                     $ map (\l -> (head l, length l))
  28                                     $ group $ sort hits
  29                  say $ "Choosing " ++ show who ++ " with " ++ show count ++ "pts."
  30                  return who
  31
  32 seeUsers :: DayMonad UserData ()
  33 seeUsers = do
  34         map <- get
  35         room <- asks psPlace
  36         present <- asks psPlayersHere
  37         say $ "Room " ++ show room ++ " has " ++ show (length present) ++ " people."
  38         mapM_ (\player -> modify (M.insert player room)) present
  39
  40 nextRoom :: DayMonad UserData ()
  41 nextRoom = do
  42         lookingFor <- bestPlayer
  43         map <- get
  44         room <- asks psPlace
  45         me   <- asks psMyName
  46         case (lookingFor == me, lookingFor `M.member` map, room /= map ! lookingFor) of
  47           (True, _, _)        -> say $ "I am leading, going nowhere"
  48           (False,True,True)   -> do say $ "Meeting " ++ show lookingFor ++ " in "
  49                                           ++ show room
  50                                     goto (map ! lookingFor)
  51           (False,True,False)  -> do say $ "Already met " ++ show lookingFor ++ " in "
  52                                           ++ show room
  53           (False,False,_)     -> do let room' = (room + 1) `mod` 10
  54                                     say $ "Searching " ++ show room' ++ " for " ++
  55                                            show lookingFor
  56                                     goto room'
  57
  58 goto :: Place -> DayMonad UserData ()
  59 goto room = do
  60         actionsLeft <- asks psActionsLeft
  61         if actionsLeft > 0
  62           then send (Goto room)
  63           else say $ "No actions left, got to stay where we are"
  64
  65 dcb :: DayCallback UserData
  66 dcb (PlayerEnter player room) = do
  67         myId <- asks psMyName
  68         when (myId == player) $ do
  69                 seeUsers
  70                 nextRoom
  71
  72 dcb (DayEndsIn 4) = do
  73         seeUsers
  74         nextRoom
  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 M.empty
  83
  84 main = parttyMain dcb ncb M.empty