add ouvert games

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
-            (_, finished, tricks) <- runSkat turn skatEnv
-            let res = getResults
-                    (game skatEnv)
-                    sglPlayer
-                    (Skat.Preperation.piles prepEnv)
-                    (Skat.piles finished)
-            publishGameResults res (bidders prepEnv)
-            return $ Just $ Match (Skat.Preperation.piles prepEnv) res tricks sglPlayer
-        Nothing -> putStrLn "no one wanted to play" >> return Nothing
+        Just skatEnv -> runGame prepEnv 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
+                (skatGame skatEnv)
+                (skatSinglePlayer skatEnv)
+                (Skat.Preperation.piles prepEnv)
+                (Skat.piles finalEnv)
+        publishGameResults res (bidders prepEnv)
+        return $ Right $ Just $
+            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