Partty.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2
   3 module Partty where
   4
   5 import Data.Map
   6 import Control.Monad.State
   7 import Control.Monad.Reader
   8 import Control.Monad.Writer
   9 import Network
  10 import System.IO
  11
  12 type Player = Int
  13 type Day = Int
  14 type Place = Int
  15
  16 data Hint = PartyAt Place
  17           | NoPartyAt Place
  18           | Liar Player
  19           | NoLiar Player
  20
  21 data PlayerInformation = PlayerInformation
  22         { piSeen        :: [Day]
  23         , piHints       :: [(Day,Hint)]
  24         }
  25
  26 data Score = NoScore | ToFew | Scored
  27
  28 data IncomingMessage = InternalMessage InternalMessage
  29                      | DayMessage      DayMessage
  30                      | NightMessage    NightMessage
  31
  32 -- Events that we want to send to the user code and that
  33 -- can be reacted upon
  34 data DayMessage      = DayStarts
  35 -- Events that we want to send to the user code and that
  36 -- can NOT be reacted upon
  37 data NightMessage    = NightStarts
  38 -- Pure bookkeeping events
  39 data InternalMessage = MyPlayerId Player
  40
  41
  42 {- Einzusortieren:
  43                      | PlayerJoined Player  -- the game
  44                      | PlayerLeft Player
  45                      | PlayerEnters Player Place
  46                      | PlayerLeaves Player Place
  47                      | GotHint Hint
  48                      | PlayerList [Player]
  49                      | PlayerScore [(Player, Int)]
  50                      | PlayerNames [(Player, String)]
  51                      | GameStarted
  52                      | DayStarts
  53                      | DayEndsIn Int
  54                      | DayEnds
  55                      | NightStarts
  56                      | NightEndsIn Int
  57                      | NightEnds
  58                      | GameEnded
  59                      | PartyHint Place
  60                      | PlayerPosition Player Place -- wann bekommt man das?
  61                      | GotScore Score
  62                      | ActionsLeft Int
  63                      | NewContact Player
  64 -}
  65
  66 data ClientMessage = Tell Player Hint
  67                    | Goto Place
  68
  69 type DayCallback d   = DayMessage -> DayMonad d ()
  70 type NightCallback d = NightMessage -> NightMonad d ()
  71
  72 data ParttyState = ParttyState
  73         { psHandle      :: Handle
  74         , psDay         :: Day
  75         , psPlayerInfo  :: Map Player PlayerInformation
  76         , psPartyHistory:: [(Day,Place)]
  77         , psPlace       :: Place
  78         , psPlayers     :: [Player]
  79         }
  80
  81 type DayMonad d   = WriterT [ClientMessage] (ReaderT ParttyState (StateT d IO))
  82 type NightMonad d =                          ReaderT ParttyState (StateT d IO)
  83
  84
  85 -- Start
  86
  87 -- Hostname, Port, Playername, Callback
  88 runPartty :: String -> Int -> String -> DayCallback d -> NightCallback d -> IO ()
  89 runPartty = undefined
  90
  91
  92 runner :: Handle -> DayCallback d -> NightCallback d -> ParttyState -> d -> IO ()
  93 runner h dcb ncb = fix $ \loop ps d -> do
  94         (e,ps') <- getNextUserMessage h ps
  95         (client_messages, d') <- case e of
  96                 Left dm  -> undefined {- run -} dcb dm
  97                 Right nm -> undefined {- run -} dcb nm
  98         undefined -- send_client_messages client_messages
  99         loop ps' d'
 100
 101 getNextUserMessage :: Handle -> ParttyState -> IO (Either DayMessage NightMessage, ParttyState)
 102 getNextUserMessage h ps = do
 103         line <- hGetLine h
 104         e <- undefined {- parseIncomingMessage -} line
 105         let ps' = undefined {- updateState -} e ps
 106         case e of
 107                 InternalMessage ue -> getNextUserMessage h ps'
 108                 DayMessage dm -> return (Left dm, ps')
 109                 NightMessage nm -> return (Right nm, ps')
 110
 111 -- Convenience functions for accessing the state
 112
 113 whoIsHere :: (MonadReader ParttyState m) => m [Player]
 114 whoIsHere = asks psPlayers
 115
 116 gameDay :: (MonadReader ParttyState m) => m Day
 117 gameDay = asks psDay
 118
 119 -- Interaction: use “tell”
 120