add ouvert games

app/Main.hs

@@ -47,11 +47,11 @@ runAI = do
         else runAI
 
 env :: SkatEnv
-env = SkatEnv piles Nothing (Colour Spades Einfach) playersExamp Hand1
+env = SkatEnv piles Nothing (Colour Spades Einfach) playersExamp Hand1 Hand3
     where piles = distribute allCards 
 
 envStupid :: SkatEnv
-envStupid = SkatEnv piles Nothing (Colour Spades Einfach) pls2 Hand1
+envStupid = SkatEnv piles Nothing (Colour Spades Einfach) pls2 Hand1 Hand3
     where piles = distribute allCards 
 
 playersExamp :: Players
@@ -69,22 +69,22 @@ pls2 = Players
 shuffledEnv :: IO SkatEnv
 shuffledEnv = do
     cards <- shuffleCards
-    return $ SkatEnv (distribute cards) Nothing (Colour Spades Einfach) playersExamp Hand1
+    return $ SkatEnv (distribute cards) Nothing (Colour Spades Einfach) playersExamp Hand1 Hand3
 
 shuffledEnv2 :: IO SkatEnv
 shuffledEnv2 = do
     cards <- shuffleCards
-    return $ SkatEnv (distribute cards) Nothing (Colour Spades Einfach) pls2 Hand1
+    return $ SkatEnv (distribute cards) Nothing (Colour Spades Einfach) pls2 Hand1 Hand3
 
 env2 :: SkatEnv
-env2 = SkatEnv piles Nothing (Colour Hearts Einfach) playersExamp Hand2
+env2 = SkatEnv piles Nothing (Colour Hearts Einfach) playersExamp Hand2 Hand3
     where hand1 = [Card Eight Hearts, Card Queen Hearts, Card Ace Clubs, Card Queen Diamonds]
           hand2 = [Card Seven Hearts, Card King Hearts, Card Ten Hearts, Card Queen Spades]
           hand3 = [Card Seven Spades, Card King Spades, Card Ace Spades, Card Queen Clubs]
           piles = emptyPiles hand1 hand2 hand3 []
 
 env3 :: SkatEnv
-env3 = SkatEnv piles Nothing (Colour Diamonds Einfach) pls2 Hand3
+env3 = SkatEnv piles Nothing (Colour Diamonds Einfach) pls2 Hand3 Hand3
     where hand1 = [ Card Jack Diamonds, Card Jack Clubs, Card Nine Spades, Card King Spades
                   , Card Seven Diamonds, Card Nine Diamonds, Card Seven Clubs, Card Eight Clubs
                   , Card Ten Clubs, Card Eight Hearts ]

app/TestEnvs.hs

@@ -14,7 +14,7 @@ pls2 = Players
     (PL $ Stupid Single Hand3)
 
 env3 :: SkatEnv
-env3 = SkatEnv piles Nothing (Colour Diamonds Einfach) pls2 Hand3
+env3 = SkatEnv piles Nothing (Colour Diamonds Einfach) pls2 Hand3 Hand3
     where hand1 = [ Card Jack Diamonds, Card Jack Clubs, Card Nine Spades, Card King Spades
                   , Card Seven Diamonds, Card Nine Diamonds, Card Seven Clubs, Card Eight Clubs
                   , Card Ten Clubs, Card Eight Hearts ]
@@ -29,4 +29,4 @@ env3 = SkatEnv piles Nothing (Colour Diamonds Einfach) pls2 Hand3
 shuffledEnv2 :: IO SkatEnv
 shuffledEnv2 = do
     cards <- shuffleCards
-    return $ SkatEnv (distribute cards) Nothing (Colour Spades Einfach) pls2 Hand1
+    return $ SkatEnv (distribute cards) Nothing (Colour Spades Einfach) pls2 Hand1 Hand3

package.yaml

@@ -35,6 +35,7 @@ dependencies:
 - case-insensitive
 - vector
 - transformers
+- exceptions
 
 library:
   source-dirs: src

skat.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: a181979e99bc6631140cc5973d1714c0b5aa021f74c72938c0ee7ab47b581cf2
+-- hash: f2e3dd604c5fb3558a0a89d7551927574fb21db0892d1c2d70d401dd30807071
 
 name:           skat
 version:        0.1.0.7
@@ -56,6 +56,7 @@ library
     , case-insensitive
     , containers
     , deepseq
+    , exceptions
     , mtl
     , network
     , parallel
@@ -82,6 +83,7 @@ executable skat-exe
     , case-insensitive
     , containers
     , deepseq
+    , exceptions
     , mtl
     , network
     , parallel
@@ -109,6 +111,7 @@ test-suite skat-test
     , case-insensitive
     , containers
     , deepseq
+    , exceptions
     , mtl
     , network
     , parallel

src/Skat.hs

@@ -18,9 +18,10 @@ import qualified Skat.Player as P
 
 data SkatEnv = SkatEnv { piles :: Piles
                        , turnColour :: Maybe TurnColour
-                       , game :: Game
+                       , skatGame :: Game
                        , players :: Players
-                       , currentHand :: Hand }
+                       , currentHand :: Hand
+                       , skatSinglePlayer :: Hand }
                deriving Show
 
 type Skat = StateT SkatEnv (WriterT [Trick] IO)
@@ -37,11 +38,13 @@ execSkat :: Skat a -> SkatEnv -> IO SkatEnv
 execSkat action = (fmap fst) . runWriterT . execStateT action
 
 instance P.MonadPlayer Skat where
-    trump = gets $ getTrump . game
+    trump = getTrump <$> P.game
     turnColour = gets turnColour
     showSkat p = case P.team p of
         Single -> fmap (Just . skatCards) $ gets piles
         Team -> return Nothing
+    singlePlayer = gets skatSinglePlayer
+    game = gets skatGame
 
 instance P.MonadPlayerOpen Skat where
     showPiles = gets piles
@@ -63,7 +66,7 @@ setTurnColour col sk = sk { turnColour = col }
 setCurrentHand :: Hand -> SkatEnv -> SkatEnv
 setCurrentHand hand sk = sk { currentHand = hand }
 
-mkSkatEnv :: Piles -> Maybe TurnColour -> Game -> Players -> Hand -> SkatEnv
+mkSkatEnv :: Piles -> Maybe TurnColour -> Game -> Players -> Hand -> Hand -> SkatEnv
 mkSkatEnv = SkatEnv
 
 allowedCards :: Skat [CardS Owner]

src/Skat/AI/Human.hs

@@ -15,7 +15,7 @@ data Human = Human { getTeam :: Team
 instance Player Human where
     team = getTeam
     hand = getHand
-    chooseCard p table _ hand = do
+    chooseCard p table _ _ hand = do
         trumpCol <- trump
         turnCol <- turnColour
         let possible = filter (isAllowed trumpCol turnCol hand) hand

src/Skat/AI/Online.hs

@@ -47,7 +47,7 @@ instance Show (PrepOnline c) where
 instance Communicator c => Player (OnlineEnv c) where
     team = getTeam
     hand = getHand
-    chooseCard p table _ hand = runReaderT (choose table hand) p >>= \c -> return (c, p)
+    chooseCard p table _ mayOuvert hand = runReaderT (choose table mayOuvert hand) p >>= \c -> return (c, p)
     onCardPlayed p c = runReaderT (cardPlayed c) p >> return p
 
 instance Communicator c => Bidder (PrepOnline c) where
@@ -112,24 +112,26 @@ instance MonadPlayer m => MonadPlayer (Online a m) where
     trump = lift $ trump
     turnColour = lift $ turnColour
     showSkat = lift . showSkat
+    singlePlayer = lift singlePlayer
+    game = lift game
 
-choose :: HasCard a => (Communicator c, MonadPlayer m) => [CardS Played] -> [a] -> Online c m Card
+choose :: (HasCard b, HasCard a) => (Communicator c, MonadPlayer m) => [CardS Played] -> Maybe [b] -> [a] -> Online c m Card
-choose table hand' = do
+choose table mayOuvert hand' = do
     let hand = sortRender Jacks $ map toCard hand'
-    query (BS.unpack $ encode $ ChooseQuery hand table)
+    query (BS.unpack $ encode $ ChooseQuery hand table $ fmap (map toCard) mayOuvert)
     r <- response
     case decode (BS.pack r) of
         Just (ChosenResponse card) -> do
             allowed <- P.isAllowed hand card
-            if card `elem` hand && allowed then return card else choose table hand'
+            if card `elem` hand && allowed then return card else choose table mayOuvert hand'
-        Nothing -> choose table hand'
+        Nothing -> choose table mayOuvert hand'
 
 cardPlayed :: (Communicator c, MonadPlayer m) => CardS Played -> Online c m ()
 cardPlayed card = query (BS.unpack $ encode $ CardPlayedQuery card)
 
 -- | QUERIES AND RESPONSES
     
-data Query = ChooseQuery [Card] [CardS Played]
+data Query = ChooseQuery [Card] [CardS Played] (Maybe [Card])
            | CardPlayedQuery (CardS Played)
            | GameResultsQuery Result
            | GameStartQuery Game Hand
@@ -151,8 +153,9 @@ newtype GameResponse = GameResponse Game
 newtype ChosenCards = ChosenCards [Card]
      
 instance ToJSON Query where
-    toJSON (ChooseQuery hand table) =
+    toJSON (ChooseQuery hand table mayOuvert) =
-        object ["query" .= ("choose_card" :: String), "hand" .= hand, "table" .= table]
+        object [ "query" .= ("choose_card" :: String), "hand" .= hand, "table" .= table
+               , "single_hand" .= mayOuvert]
     toJSON (CardPlayedQuery card) =
         object ["query" .= ("card_played" :: String), "card" .= card]
     toJSON (GameResultsQuery result) =
@@ -160,7 +163,7 @@ instance ToJSON Query where
     toJSON (GameStartQuery game sglPlayer) =
         object [ "query" .= ("start_game" :: String)
                , "game" .= game
-               , "single" .= toInt sglPlayer ]
+               , "single" .= show sglPlayer ]
     toJSON (BidQuery hand bid) =
         object ["query" .= ("bid" :: String), "whom" .= show hand, "current" .= bid]
     toJSON (BidResponseQuery hand bid) =

src/Skat/AI/Rulebased.hs

@@ -80,7 +80,7 @@ runWithPiles ps sim = runReaderT sim ps
 instance Player AIEnv where
     team = getTeam
     hand = getHand
-    chooseCard p table fallen hand = runStateT (do
+    chooseCard p table fallen _ hand = runStateT (do
         modify $ setTable table
         modify $ setHand (map toCard hand)
         modify $ setFallen fallen
@@ -316,7 +316,7 @@ chooseSimulating = do
                      (PL $ Stupid.Stupid Team Hand2)
                      (PL $ Stupid.Stupid Single Hand3)
         -- TODO: fix
-        env = mkSkatEnv piles turnCol undefined ps myHand
+        env = mkSkatEnv piles turnCol undefined ps myHand undefined
     liftIO $ evalSkat (toCard <$> (Minmax.choose depth :: Skat (CardS Owner))) env
 
 simulate :: (MonadState AIEnv m, MonadPlayerOpen m)
@@ -337,7 +337,7 @@ simulate card = do
             (PL $ mkAIEnv Team Hand2 newDepth)
             (PL $ mkAIEnv Single Hand3 newDepth)
         -- TODO: fix
-        env = mkSkatEnv piles turnCol undefined ps (next myHand)
+        env = mkSkatEnv piles turnCol undefined ps (next myHand) undefined
     -- simulate the game after playing the given card
     (sgl, tm) <- liftIO $ evalSkat (do
         modifyp $ playCard myHand card

src/Skat/AI/Stupid.hs

@@ -16,7 +16,7 @@ data Stupid = Stupid { getTeam :: Team
 instance Player Stupid where
     team = getTeam
     hand = getHand
-    chooseCard p _ _ hand = do
+    chooseCard p _ _ _ hand = do
         trumpCol <- trump
         turnCol <- turnColour
         liftIO $ threadDelay 1000000

src/Skat/Bidding.hs

@@ -2,7 +2,7 @@
 
 module Skat.Bidding (
     biddingScore, Game(..), Modifier(..), isHand, getTrump, Result(..),
-    getResults
+    getResults, isOuvert, isSchwarz
 ) where
 
 import Data.Aeson hiding (Null, Result)
@@ -82,6 +82,13 @@ isHand Schneider = False
 isHand Schwarz   = False
 isHand _         = True
 
+isOuvert :: Game -> Bool
+isOuvert NullOuvert        = True
+isOuvert NullOuvertHand    = True
+isOuvert (Grand Ouvert)    = True
+isOuvert (Colour _ Ouvert) = True
+isOuvert _                 = False
+
 -- | 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/Matches.hs

@@ -1,5 +1,5 @@
 module Skat.Matches (
-    singleVsBots, pvp, singleWithBidding, Match(..)
+    singleVsBots, pvp, singleWithBidding, Match(..), Unfinished(..), continue
 ) where
 
 import Control.Monad.State
@@ -8,7 +8,7 @@ import System.Random (mkStdGen)
 
 import Skat
 import Skat.Operations
-import Skat.Player
+import Skat.Player as P
 import Skat.Pile
 import Skat.Card
 import Skat.Preperation
@@ -24,20 +24,59 @@ data Match = Match { matchPiles :: Piles
                    , matchSingle :: Hand }
              deriving Show
 
-match :: PrepEnv -> IO (Maybe Match)
+data Unfinished = UnfinishedGame { unfinishedGame :: SkatEnv
+                                 , unfinishedPrep :: PrepEnv
+                                 , unfinishedTricks :: [Trick] }
+                | UnfinishedPrep { unfinishedPrep :: PrepEnv }
+                  deriving Show
+
+continue :: Communicator c => Unfinished -> c -> c -> c -> IO (Either Unfinished (Maybe Match))
+continue (UnfinishedGame skatEnv prepEnv tricks) comm1 comm2 comm3 = do
+    let ps = players skatEnv
+        ps' = Players
+            (PL $ OnlineEnv (P.team $ player ps Hand1) (P.hand $ player ps Hand1) comm1)
+            (PL $ OnlineEnv (P.team $ player ps Hand2) (P.hand $ player ps Hand2) comm2)
+            (PL $ OnlineEnv (P.team $ player ps Hand3) (P.hand $ player ps Hand3) comm3)
+        bs = bidders prepEnv
+        bs' = Bidders
+            (BD $ PrepOnline (Skat.Preperation.hand $ bidder bs Hand1) comm1 [])
+            (BD $ PrepOnline (Skat.Preperation.hand $ bidder bs Hand2) comm2 [])
+            (BD $ PrepOnline (Skat.Preperation.hand $ bidder bs Hand3) comm3 [])
+        skatEnv' = skatEnv { players = ps' }
+        prepEnv' = prepEnv { bidders = bs' }
+    runGame prepEnv' skatEnv'
+
+match :: PrepEnv -> IO (Either Unfinished (Maybe Match))
 match prepEnv = do
     maySkatEnv <- runReaderT runPreperation prepEnv
     case maySkatEnv of
-        Just (sglPlayer, skatEnv) -> do
+        Just skatEnv -> runGame prepEnv skatEnv
-            (_, finished, tricks) <- runSkat turn skatEnv
+        Nothing -> putStrLn "no one wanted to play" >> return (Right Nothing)
+
+runGame :: PrepEnv -> SkatEnv -> IO (Either Unfinished (Maybe Match))
+runGame prepEnv skatEnv = do
+    (isFinished, finalEnv, tricks) <- (flip runSkat) skatEnv $ do
+        -- send current table cards to clients
+        -- only relevant if this is a continued game
+        -- otherwise table is empty
+        table <- getp tableCards
+        ps <- playersToList <$> gets players
+        mapM_ (\card -> mapM_ (\p -> onCardPlayed p card) ps) (reverse table)
+        -- run game
+        turn
+        -- return if game has finished
+        gameOver
+    if isFinished then do
         let res = getResults
-                    (game skatEnv)
+                (skatGame skatEnv)
-                    sglPlayer
+                (skatSinglePlayer skatEnv)
                 (Skat.Preperation.piles prepEnv)
-                    (Skat.piles finished)
+                (Skat.piles finalEnv)
         publishGameResults res (bidders prepEnv)
-            return $ Just $ Match (Skat.Preperation.piles prepEnv) res tricks sglPlayer
+        return $ Right $ Just $
-        Nothing -> putStrLn "no one wanted to play" >> return Nothing
+            Match (Skat.Preperation.piles prepEnv) res tricks (skatSinglePlayer skatEnv)
+    else do -- if not finished an error has occured, thus returning unfinished game state
+        return $ Left $ UnfinishedGame finalEnv prepEnv tricks
 
 -- | predefined card distribution for testing purposes
 cardDistr :: Piles
@@ -60,7 +99,7 @@ singleVsBots comm = do
                 (PL $ OnlineEnv Team Hand1 comm)
                 (PL $ Stupid Team Hand2)
                 (PL $ mkAIEnv Single Hand3 10)
-        env = SkatEnv (distribute cards) Nothing (Colour Spades Einfach) ps Hand1
+        env = SkatEnv (distribute cards) Nothing (Colour Spades Einfach) ps Hand1 Hand3
     void $ evalSkat turn env
 
 singleWithBidding :: Communicator c => c -> IO ()
@@ -75,7 +114,7 @@ singleWithBidding comm = do
         env = PrepEnv ps bs
     void $ match env
 
-pvp :: Communicator c => c -> c -> c -> IO (Maybe Match)
+pvp :: Communicator c => c -> c -> c -> IO (Either Unfinished (Maybe Match))
 pvp comm1 comm2 comm3 = do
     cards <- shuffleCards
     let ps = distribute cards

src/Skat/Operations.hs

@@ -1,9 +1,11 @@
 module Skat.Operations (
     turn, turnGeneric, play, playOpen,
-    play_, sortRender, undo_
+    play_, sortRender, undo_, gameOver
 ) where
 
 import Control.Monad.State
+import Control.Monad.Catch
+import Control.Exception hiding (catch, bracketOnError)
 import Control.Monad.Writer (tell)
 import System.Random (newStdGen, randoms)
 import Data.List
@@ -14,8 +16,10 @@ import Skat
 import Skat.Card
 import Skat.Pile
 import Skat.Player (chooseCard, Players(..), Player(..), PL(..),
-    updatePlayer, playersToList, player, MonadPlayer, getSinglePlayer, trump)
+    updatePlayer, playersToList, player, MonadPlayer, getSinglePlayer, trump, game,
+    singlePlayer)
 import Skat.Utils (shuffle)
+import Skat.Bidding
 
 play_ :: HasCard c => c -> Skat ()
 play_ card = do
@@ -43,19 +47,34 @@ turnGeneric playFunc depth = do
     table <- getp tableCards
     ps <- gets players
     let p = player ps n
-    over <- getp $ handEmpty n
     trCol <- trump
     case length table of
-        0 -> playFunc p >> modify (setCurrentHand $ next n) >> turnGeneric playFunc depth
+        0 -> do
+            catchAll
+                (do
+                    playFunc p
+                    modify (setCurrentHand $ next n)
+                    turnGeneric playFunc depth)
+                (\_ -> countGame)
         1 -> do
             modify $ setTurnColour
                 (Just $ effectiveColour trCol $ head table)
+            catchAll
+                (do
                     playFunc p
                     modify (setCurrentHand $ next n)
-            turnGeneric playFunc depth
+                    turnGeneric playFunc depth)
-        2 -> playFunc p >> modify (setCurrentHand $ next n) >> turnGeneric playFunc depth
+                (\_ -> countGame)
+        2 -> do
+            catchAll
+                (do
+                    playFunc p
+                    modify (setCurrentHand $ next n)
+                    turnGeneric playFunc depth)
+                (\_ -> countGame)
         3 -> do
             w <- evaluateTable
+            over <- gameOver
             if depth <= 1 || over
                 then countGame
                 else modify (setCurrentHand w) >> turnGeneric playFunc (depth - 1)
@@ -86,7 +105,10 @@ play p = do
     trump <- trump
     cards <- getp $ handCards (hand p)
     fallen <- getp played
-    (card, p') <- chooseCard p table fallen cards
+    ouvert <- isOuvert <$> game
+    mayOuvert <- if ouvert then Just <$> (singlePlayer >>= getp . handCards)
+        else return Nothing
+    (card, p') <- chooseCard p table fallen mayOuvert cards
     modifyPlayers $ updatePlayer p'
     modifyp $ playCard (hand p) card
     ps <- fmap playersToList $ gets players
@@ -101,3 +123,13 @@ playOpen p = do
     card <- chooseCardOpen p
     modifyp $ playCard (hand p) card
     return card
+
+gameOver :: Skat Bool
+gameOver = do
+    tr <- trump
+    case tr of
+        None -> do
+            singleLost <- gets piles >>= return . not . (Single `isSchwarz`)
+            if singleLost then return True
+            else gets currentHand >>= getp . handCards >>= return . null
+        _ -> gets currentHand >>= getp . handCards >>= return . null

src/Skat/Player.hs

@@ -6,11 +6,14 @@ import Control.Monad.IO.Class
 
 import Skat.Card
 import Skat.Pile
+import Skat.Bidding
 
 class (Monad m, MonadIO m) => MonadPlayer m where
     trump :: m Trump
     turnColour :: m (Maybe TurnColour)
     showSkat :: Player p => p -> m (Maybe [Card])
+    singlePlayer :: m Hand
+    game :: m Game
 
 class (Monad m, MonadIO m, MonadPlayer m) => MonadPlayerOpen m where
     showPiles :: m (Piles)
@@ -18,10 +21,11 @@ class (Monad m, MonadIO m, MonadPlayer m) => MonadPlayerOpen m where
 class Player p where
     team :: p -> Team
     hand :: p -> Hand
-    chooseCard :: (HasCard c, MonadPlayer m)
+    chooseCard :: (HasCard d, HasCard c, MonadPlayer m)
                => p
                -> [CardS Played]
                -> [CardS Played]
+               -> Maybe [d]
                -> [c]
                -> m (Card, p)
     onCardPlayed :: MonadPlayer m
@@ -37,7 +41,10 @@ class Player p where
         let table = tableCards piles
             fallen = played piles
             myCards = handCards (hand p) piles
-        fst <$> chooseCard p table fallen myCards
+        ouvert <- isOuvert <$> game
+        mayOuvert <- if ouvert then Just <$> (singlePlayer >>= \hnd -> return $ handCards hnd piles)
+            else return Nothing
+        fst <$> chooseCard p table fallen mayOuvert myCards
 
 data PL = forall p. (Show p, Player p) => PL p
 
@@ -47,8 +54,8 @@ instance Show PL where
 instance Player PL where
     team (PL p) = team p
     hand (PL p) = hand p
-    chooseCard (PL p) table fallen hand = do
+    chooseCard (PL p) table fallen mayOuvert hand = do
-        (v, a) <- chooseCard p table fallen hand
+        (v, a) <- chooseCard p table fallen mayOuvert hand
         return $ (v, PL a)
     onCardPlayed (PL p) card = do
         v <- onCardPlayed p card

src/Skat/Preperation.hs

@@ -3,7 +3,7 @@
 
 module Skat.Preperation (
     Bidder(..), Bid, BD(..), Bidders(..), PrepEnv(..), runPreperation,
-    publishGameResults
+    publishGameResults, bidder
 ) where
 
 import Control.Monad.IO.Class
@@ -78,7 +78,7 @@ toPlayers single (Bidders b1 b2 b3) =
             (toPlayer b2 $ if single == Hand2 then Single else Team)
             (toPlayer b3 $ if single == Hand3 then Single else Team)
 
-runPreperation :: Preperation (Maybe (Hand, SkatEnv))
+runPreperation :: Preperation (Maybe SkatEnv)
 runPreperation = do
     bds <- asks bidders
     onStart (bidder bds Hand1)
@@ -90,9 +90,9 @@ runPreperation = do
         bid <- askBid (bidder bds finalWinner) finalWinner 0
         publishBid bid finalWinner finalWinner
         case bid of
-            Just val -> (Just . (finalWinner,)) <$> initGame finalWinner val
+            Just val -> Just <$> initGame finalWinner val
             Nothing -> publishNoGame >> return Nothing
-        else (Just . (finalWinner,)) <$> initGame finalWinner finalBid
+        else Just <$> initGame finalWinner finalBid
 
 runBidding :: Bid -> BD -> BD -> Preperation (Hand, Bid)
 runBidding startingBid reizer gereizter = do
@@ -125,7 +125,7 @@ initGame single bid = do
     -- publish game start
     publishGameStart game single
     -- construct skat env
-    return $ mkSkatEnv ps' Nothing game (toPlayers single bds) Hand1
+    return $ mkSkatEnv ps' Nothing game (toPlayers single bds) Hand1 single
 
 handleGame :: BD -> Bid -> Bool -> Preperation Game
 handleGame bd bid noSkat = do