validate bidder responses

src/Skat/Bidding.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Skat.Bidding (
-    biddingScore, Game(..), Modifier(..)
+    biddingScore, Game(..), Modifier(..), isHand
 ) where
 
 import Data.Aeson hiding (Null)
@@ -64,6 +64,12 @@ instance FromJSON Modifier where
                 _ -> return Hand
         else return Einfach
 
+isHand :: Modifier -> Bool
+isHand Einfach   = False
+isHand Schneider = False
+isHand Schwarz   = False
+isHand _         = True
+
 -- | calculate the value of a game with given cards
 biddingScore :: HasCard c => Game -> [c] -> Int
 biddingScore game@(Grand           mod) cards = (spitzen game cards + modifierFactor mod) * 24

src/Skat/Preperation.hs

@@ -95,14 +95,27 @@ initGame single bid = do
     -- either return piles or ask for skat cards and modify piles
     ps' <- if noSkat then return ps else handleSkat (bidder bds single) bid ps
     -- ask for game kind
-    (Colour col _) <- askGame (bidder bds single) bid
+    game <- handleGame (bidder bds single) bid noSkat
     -- construct skat env
-    return $ mkSkatEnv ps Nothing col (toPlayers single bds) Hand1
+    return $ mkSkatEnv ps' Nothing Spades (toPlayers single bds) Hand1
+
+handleGame :: BD -> Bid -> Bool -> Preperation Game
+handleGame bd bid noSkat = do
+    -- ask bidder for game
+    proposal <- askGame bd bid
+    -- check if proposal is allowed
+    case proposal of
+        g@(Colour col mod) -> if isHand mod == noSkat
+            then return g else handleGame bd bid noSkat
+        g@(Grand mod) -> if isHand mod == noSkat
+            then return g else handleGame bd bid noSkat
+        g -> return g
 
 handleSkat :: BD -> Bid -> Piles -> Preperation Piles
 handleSkat bd bid ps = do
     let skat = skatCards ps
     skat' <- askSkat bd bid skat
+    liftIO $ putStrLn $ "received skat " ++ show skat'
     case moveToSkat (hand bd) skat' ps of
         Just correct -> return correct
         Nothing -> handleSkat bd bid ps