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