Schmarozer.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  - Schmarozer: Follows Hints
  15  -}
  16
  17 type UserData = ([(Player,Place)])
  18
  19 dcb :: DayCallback UserData
  20 dcb (DayStarts _) = do
  21         mbp <- asks psPartyPlace
  22         case mbp of
  23                 Nothing -> do
  24                         say $ "No idea where to go, waiting for hints..."
  25                 Just room -> do
  26                         say $ "Yay, I know where to go! (" ++ show room ++") but will not tell"
  27                         send (Goto room)
  28
  29 dcb (GotHint player (PartyAt room)) = do
  30         say $ "The " ++ show player ++ " told me about a party at " ++ show room ++"."
  31         modify ((player,room):)
  32
  33 dcb (DayEndsIn 1) = do
  34         mbp <- asks psPartyPlace
  35         hints <- get
  36         when (isNothing mbp && not (null hints)) $ do
  37                 friends <- asks psFriends
  38                 selected_hints <- case partition (\(p,_) -> p `elem` friends) hints of
  39                   ([],bad) -> do say $ "Some hints from non-friends " ++ show bad
  40                                  return bad
  41                   (good,_) -> do say $ "Some hints from friends " ++ show good
  42                                  return good
  43                 let choices = map snd selected_hints
  44                 pick <- liftIO $ randomRIO (0,length choices - 1)
  45                 say $ "Choosing " ++ show (choices !! pick)
  46                 send (Goto (choices !! pick))
  47
  48 dcb e = return ()
  49
  50 ncb :: NightCallback UserData
  51 ncb (NightResult {nrScore = score }) = do
  52         say $ "Got score: " ++ show score
  53         say $ "New Day, forget about yesterday"
  54         put []
  55
  56 main = parttyMain dcb ncb []