add preconfigured matches and extend online ai

This commit is contained in:
2019-08-28 16:27:24 +02:00
parent 409ef29da1
commit 7138f74e8e
8 changed files with 66 additions and 101 deletions
+18 -10
View File
@@ -33,6 +33,7 @@ instance Player OnlineEnv where
chooseCard p table _ hand = runReaderT (choose table hand) p >>= \c -> return (c, p)
onCardPlayed p c = runReaderT (cardPlayed c) p >> return p
onGameResults p res = runReaderT (onResults res) p
onGameStart p singlePlayer = runReaderT (onStart singlePlayer) p
type Online m = ReaderT OnlineEnv m
@@ -65,23 +66,30 @@ cardPlayed card = query (BS.unpack $ encode $ CardPlayedQuery card)
onResults :: MonadIO m => (Int, Int) -> Online m ()
onResults (sgl, tm) = query (BS.unpack $ encode $ GameResultsQuery sgl tm)
data ChooseQuery = ChooseQuery [Card] [CardS Played]
data CardPlayedQuery = CardPlayedQuery (CardS Played)
data GameResultsQuery = GameResultsQuery Int Int
data ChosenResponse = ChosenResponse Card
onStart :: MonadPlayer m => Hand -> Online m ()
onStart singlePlayer = do
trCol <- trumpColour
ownHand <- asks getHand
query (BS.unpack $ encode $ GameStartQuery trCol ownHand singlePlayer)
data Query = ChooseQuery [Card] [CardS Played]
| CardPlayedQuery (CardS Played)
| GameResultsQuery Int Int
| GameStartQuery Colour Hand Hand
instance ToJSON ChooseQuery where
data Response = ChosenResponse Card
instance ToJSON Query where
toJSON (ChooseQuery hand table) =
object ["query" .= ("choose_card" :: String), "hand" .= hand, "table" .= table]
instance ToJSON CardPlayedQuery where
toJSON (CardPlayedQuery card) =
object ["query" .= ("card_played" :: String), "card" .= card]
instance ToJSON GameResultsQuery where
toJSON (GameResultsQuery sgl tm) =
object ["query" .= ("results" :: String), "single" .= sgl, "team" .= tm]
toJSON (GameStartQuery trumps handNo sglPlayer) =
object ["query" .= ("start_game" :: String), "trumps" .= show trumps,
"hand" .= toInt handNo, "single" .= toInt sglPlayer]
instance FromJSON ChosenResponse where
instance FromJSON Response where
parseJSON = withObject "ChosenResponse" $ \v -> ChosenResponse
<$> v .: "card"