track every trick, return detailed match information

app/Main.hs

@@ -41,7 +41,7 @@ runAI = do
         trs = filter (isTrump $ TrumpColour Spades) cs
     if length trs >= 5 && any ((==32) . getID) cs
         then do
-            pts <- fst <$> evalStateT turn env
+            pts <- fst <$> evalSkat turn env
             -- if pts > 60 then return 1 else return 0
             return pts
         else runAI
@@ -109,4 +109,4 @@ application pending = do
         putStrLn $ BS.unpack msg
 
 playSkat :: IO ()
-playSkat = void $ (flip runStateT) env3 playCLI
+playSkat = void $ (flip runSkat) env3 playCLI

src/Skat.hs

@@ -5,6 +5,7 @@
 module Skat where
 
 import Control.Monad.State
+import Control.Monad.Writer
 import Control.Monad.Reader
 import Data.List
 import Data.Vector (Vector)
@@ -22,7 +23,19 @@ data SkatEnv = SkatEnv { piles :: Piles
                        , currentHand :: Hand }
                deriving Show
 
-type Skat = StateT SkatEnv IO
+type Trick = (CardS Owner, CardS Owner, CardS Owner)
+type Skat = StateT SkatEnv (WriterT [Trick] IO)
+
+runSkat :: Skat a -> SkatEnv -> IO (a, SkatEnv, [Trick])
+runSkat action env = do
+    ((val, env'), tricks) <- runWriterT $ runStateT action env
+    return (val, env', tricks)
+
+evalSkat :: Skat a -> SkatEnv -> IO a
+evalSkat action = (fmap fst) . runWriterT . evalStateT action
+
+execSkat :: Skat a -> SkatEnv -> IO SkatEnv
+execSkat action = (fmap fst) . runWriterT . execStateT action
 
 instance P.MonadPlayer Skat where
     trump = gets $ getTrump . game

src/Skat/AI/Rulebased.hs

@@ -22,7 +22,7 @@ import qualified Skat.Player.Utils as P
 import Skat.Pile hiding (isSkat)
 import Skat.Card
 import Skat.Utils
-import Skat (Skat, modifyp, mkSkatEnv) 
+import Skat (Skat, modifyp, mkSkatEnv, evalSkat)
 import Skat.Operations
 import qualified Skat.AI.Minmax as Minmax
 import qualified Skat.AI.Stupid as Stupid (Stupid(..))
@@ -317,7 +317,7 @@ chooseSimulating = do
                      (PL $ Stupid.Stupid Single Hand3)
         -- TODO: fix
         env = mkSkatEnv piles turnCol undefined ps myHand
-    liftIO $ evalStateT (toCard <$> (Minmax.choose depth :: Skat (CardS Owner))) env
+    liftIO $ evalSkat (toCard <$> (Minmax.choose depth :: Skat (CardS Owner))) env
 
 simulate :: (MonadState AIEnv m, MonadPlayerOpen m)
          => Card -> m Int
@@ -339,7 +339,7 @@ simulate card = do
         -- TODO: fix
         env = mkSkatEnv piles turnCol undefined ps (next myHand)
     -- simulate the game after playing the given card
-    (sgl, tm) <- liftIO $ evalStateT (do
+    (sgl, tm) <- liftIO $ evalSkat (do
         modifyp $ playCard myHand card
         turnGeneric playOpen depth) env
     let v = if myTeam == Single then (sgl, tm) else (tm, sgl)

src/Skat/Bidding.hs

@@ -140,7 +140,10 @@ getTrump (Colour col _) = TrumpColour col
 getTrump (Grand _)      = Jacks
 getTrump _              = None
 
-data Result = Result Game Int Int Int
+data Result = Result { resultGame :: Game
+                     , resultScore :: Int
+                     , resultSinglePoints :: Int
+                     , resultTeamPoints :: Int }
               deriving (Show, Eq)
 
 instance ToJSON Result where

src/Skat/Matches.hs

@@ -1,5 +1,5 @@
 module Skat.Matches (
-    singleVsBots, pvp, singleWithBidding
+    singleVsBots, pvp, singleWithBidding, Match(..)
 ) where
 
 import Control.Monad.State
@@ -18,19 +18,26 @@ import Skat.AI.Rulebased
 import Skat.AI.Online
 import Skat.AI.Stupid
 
-match :: PrepEnv -> IO ()
+data Match = Match { matchPiles :: Piles
+                   , matchResult :: Result
+                   , matchTricks :: [Trick]
+                   , matchSingle :: Hand }
+             deriving Show
+
+match :: PrepEnv -> IO (Maybe Match)
 match prepEnv = do
     maySkatEnv <- runReaderT runPreperation prepEnv
     case maySkatEnv of
         Just (sglPlayer, skatEnv) -> do
-            finished <- execStateT turn skatEnv
+            (_, finished, tricks) <- runSkat turn skatEnv
             let res = getResults
                     (game skatEnv)
                     sglPlayer
                     (Skat.piles skatEnv)
                     (Skat.piles finished)
             publishGameResults res (bidders prepEnv)
-        Nothing -> putStrLn "no one wanted to play"
+            return $ Just $ Match (Skat.piles skatEnv) res tricks sglPlayer
+        Nothing -> putStrLn "no one wanted to play" >> return Nothing
 
 -- | predefined card distribution for testing purposes
 cardDistr :: Piles
@@ -54,7 +61,7 @@ singleVsBots comm = do
                 (PL $ Stupid Team Hand2)
                 (PL $ mkAIEnv Single Hand3 10)
         env = SkatEnv (distribute cards) Nothing (Colour Spades Einfach) ps Hand1
-    void $ evalStateT turn env
+    void $ evalSkat turn env
 
 singleWithBidding :: Communicator c => c -> IO ()
 singleWithBidding comm = do
@@ -66,9 +73,9 @@ singleWithBidding comm = do
                 (BD $ NoBidder Hand2)
                 (BD $ NoBidder Hand3)
         env = PrepEnv ps bs
-    match env
+    void $ match env
 
-pvp :: Communicator c => c -> c -> c -> IO ()
+pvp :: Communicator c => c -> c -> c -> IO (Maybe Match)
 pvp comm1 comm2 comm3 = do
     cards <- shuffleCards
     let ps = distribute cards

src/Skat/Operations.hs

@@ -4,6 +4,7 @@ module Skat.Operations (
 ) where
 
 import Control.Monad.State
+import Control.Monad.Writer (tell)
 import System.Random (newStdGen, randoms)
 import Data.List
 import Data.Ord
@@ -72,6 +73,7 @@ evaluateTable = do
         winner = player ps winnerHand
     modifyp $ cleanTable (team winner)
     modify $ setTurnColour Nothing
+    tell [(table !! 2, table !! 1, table !! 0)]
     return $ hand winner
 
 countGame :: Skat (Int, Int)