add preconfigured matches and extend online ai

src/Skat/AI/Online.hs

@@ -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"

src/Skat/Matches.hs

@@ -0,0 +1,25 @@
+module Skat.Matches (
+    singleVsBots
+) where
+
+import Control.Monad.State
+
+import Skat
+import Skat.Operations
+import Skat.Player
+import Skat.Pile
+import Skat.Card
+
+import Skat.AI.Rulebased
+import Skat.AI.Online
+import Skat.AI.Stupid
+
+singleVsBots :: (Team -> Hand -> OnlineEnv) -> IO ()
+singleVsBots mkPlayer = do
+    cards <- liftIO $ shuffleCards
+    let ps = Players
+                (PL $ mkPlayer Team Hand1)
+                (PL $ Stupid Team Hand2)
+                (PL $ mkAIEnv Single Hand3 10)
+        env = SkatEnv (distribute cards) Nothing Spades ps
+    liftIO $ evalStateT (turn Hand1 >>= publishGameResults) env

src/Skat/Operations.hs

@@ -1,4 +1,6 @@
-module Skat.Operations where
+module Skat.Operations (
+    turn, turnGeneric, play, playOpen, publishGameResults
+) where
 
 import Control.Monad.State
 import System.Random (newStdGen, randoms)
@@ -86,3 +88,8 @@ playOpen p = do
     card <- chooseCardOpen p
     modifyp $ playCard card
     return card
+
+publishGameResults :: (Int, Int) -> Skat ()
+publishGameResults res = do
+    pls <- gets players
+    mapM_ (\p -> onGameResults p res) (playersToList pls)

src/Skat/Pile.hs

@@ -28,6 +28,11 @@ instance ToJSON p => ToJSON (CardS p) where
 data Hand = Hand1 | Hand2 | Hand3
             deriving (Show, Eq, Ord)
 
+toInt :: Hand -> Int
+toInt Hand1 = 1
+toInt Hand2 = 2
+toInt Hand3 = 3
+
 next :: Hand -> Hand
 next Hand1 = Hand2
 next Hand2 = Hand3

src/Skat/Player.hs

@@ -43,6 +43,11 @@ class Player p where
                   -> (Int, Int)
                   -> m ()
     onGameResults _ _ = return ()
+    onGameStart :: MonadPlayer m
+                => p
+                -> Hand
+                -> m ()
+    onGameStart _ _ = return ()
 
 data PL = forall p. (Show p, Player p) => PL p
 
@@ -60,6 +65,7 @@ instance Player PL where
         return $ PL v
     chooseCardOpen (PL p) = chooseCardOpen p
     onGameResults (PL p) res = onGameResults p res
+    onGameStart (PL p) singlePlayer = onGameStart p singlePlayer
 
 data Players = Players PL PL PL
                deriving Show