Document everything exported
[darcs-mirror-haskell-partty.git] / 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