validate bidder responses

package.yaml

@@ -1,5 +1,5 @@
 name:                skat
-version:             0.1.0.1
+version:             0.1.0.5
 github:              "githubuser/skat"
 license:             BSD3
 author:              "flavis"

skat.cabal

@@ -4,10 +4,10 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
+-- hash: 625d9f93a3dec23993347bdccc3746fdf28ac4b67c85ec04a99f505ff61a171f
 
 name:           skat
-version:        0.1.0.1
+version:        0.1.0.5
 description:    Please see the README on Gitea at <https://git.flavigny.de/christian/skat>
 homepage:       https://github.com/githubuser/skat#readme
 bug-reports:    https://github.com/githubuser/skat/issues

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