send bidding log to every bidder

src/Skat/AI/Online.hs

@@ -84,6 +84,10 @@ instance Communicator c => Bidder (PrepOnline c) where
             Just (ChosenCards cards) -> return cards
             Nothing -> askSkat p bid cards
     toPlayer p tm = PL $ OnlineEnv tm (prepHand p) (prepConnection p)
+    onBid p mayBid reizer gereizter =
+        liftIO $ send (prepConnection p) (BS.unpack $ encode $ BidEvent mayBid reizer gereizter)
+    onResponse p response reizer gereizter =
+        liftIO $ send (prepConnection p) (BS.unpack $ encode $ ResponseEvent response reizer gereizter)
     onStart p = do
         let cards = sortRender Jacks $ prepCards p
         liftIO $ send (prepConnection p) (BS.unpack $ encode $ CardsQuery cards)
@@ -133,6 +137,8 @@ data Query = ChooseQuery [Card] [CardS Played]
            | AskHandQuery
            | AskSkatQuery [Card] Bid
            | CardsQuery [Card]
+           | BidEvent (Maybe Bid) Hand Hand
+           | ResponseEvent Bool Hand Hand
 
 newtype ChosenResponse = ChosenResponse Card
 newtype BidResponse = BidResponse Int
@@ -164,6 +170,19 @@ instance ToJSON Query where
         object ["query" .= ("cards" :: String), "cards" .= cards ]
     toJSON (AskGameQuery bid) =
         object ["query" .= ("ask_game" :: String), "bid" .= bid]
+    toJSON (BidEvent (Just bid) reizer gereizter) =
+        object ["query" .= ("bid_event" :: String), "bid" .= bid, "reizer" .= show reizer,
+                "gereizter" .= show gereizter ]
+    toJSON (BidEvent Nothing reizer gereizter) =
+        object [ "query" .= ("bid_event" :: String)
+               , "bid" .= ("weg" :: String)
+               , "reizer" .= show reizer
+               , "gereizter" .= show gereizter ]
+    toJSON (ResponseEvent response reizer gereizter) =
+        object [ "query" .= ("response_event" :: String)
+               , "response" .= response
+               , "reizer" .= show reizer
+               , "gereizter" .= show gereizter ]
 
 instance FromJSON ChosenResponse where
     parseJSON = withObject "ChosenResponse" $ \v -> ChosenResponse

src/Skat/AI/Stupid.hs

@@ -1,5 +1,8 @@
 module Skat.AI.Stupid where
 
+import Control.Concurrent
+import Control.Monad.State
+
 import Skat.Player
 import Skat.Pile
 import Skat.Card
@@ -16,6 +19,7 @@ instance Player Stupid where
     chooseCard p _ _ hand = do
         trumpCol <- trump
         turnCol <- turnColour
+        liftIO $ threadDelay 1000000
         let possible = filter (isAllowed trumpCol turnCol hand) hand
         return (toCard $ head possible, p)
 

src/Skat/Preperation.hs

@@ -32,6 +32,10 @@ class Bidder a where
     askHand :: MonadIO m => a -> Bid -> m Bool
     askSkat :: MonadIO m => a -> Bid -> [Card] -> m [Card]
     toPlayer :: a -> Team -> PL
+    onBid :: MonadIO m => a -> Maybe Bid -> Hand -> Hand -> m ()
+    onBid _ _ _ _ = return ()
+    onResponse :: MonadIO m => a -> Bool -> Hand -> Hand -> m ()
+    onResponse _ _ _ _ = return ()
     onGame :: MonadIO m => a -> Game -> Hand -> m ()
     onGame _ _ _ = return ()
     onResult :: MonadIO m => a -> Result -> m ()
@@ -54,6 +58,8 @@ instance Bidder BD where
     onStart (BD b) = onStart b
     onGame (BD b) = onGame b
     onResult (BD b) = onResult b
+    onBid (BD b) = onBid b
+    onResponse (BD b) = onResponse b
 
 data Bidders = Bidders BD BD BD
                deriving Show
@@ -79,6 +85,7 @@ runPreperation = do
     (finalWinner, finalBid) <- runBidding bid (bidder bds Hand3) (bidder bds winner)
     if finalBid == 0 then do
         bid <- askBid (bidder bds finalWinner) finalWinner 0
+        publishBid bid finalWinner finalWinner
         case bid of
             Just val -> (Just . (finalWinner,)) <$> initGame finalWinner val
             Nothing -> return Nothing
@@ -90,11 +97,17 @@ runBidding startingBid reizer gereizter = do
     case first of
         Just val
             | val > startingBid -> do
+                publishBid first (hand reizer) (hand gereizter)
                 response <- askResponse gereizter (hand reizer) val
+                publishResponse response (hand reizer) (hand gereizter)
                 if response then runBidding val reizer gereizter
                 else return (hand reizer, val)
-            | otherwise -> return (hand gereizter, startingBid)
-        Nothing -> return (hand gereizter, startingBid)
+            | otherwise -> do
+                publishBid Nothing (hand reizer) (hand gereizter)
+                return (hand gereizter, startingBid)
+        Nothing -> do
+            publishBid Nothing (hand reizer) (hand gereizter)
+            return (hand gereizter, startingBid)
 
 initGame :: Hand -> Bid -> Preperation SkatEnv
 initGame single bid = do
@@ -139,8 +152,17 @@ publishGameResults res bidders = do
     onResult (bidder bidders Hand3) res
 
 publishGameStart :: Game -> Hand -> Preperation ()
-publishGameStart game sglPlayer = do
+publishGameStart game sglPlayer = mapBidders (\b -> onGame b game sglPlayer)
+
+publishBid :: Maybe Bid -> Hand -> Hand -> Preperation ()
+publishBid bid reizer gereizter = mapBidders (\b -> onBid b bid reizer gereizter)
+
+publishResponse :: Bool -> Hand -> Hand -> Preperation ()
+publishResponse response reizer gereizter = mapBidders (\b -> onResponse b response reizer gereizter)
+
+mapBidders :: (BD -> Preperation ()) -> Preperation ()
+mapBidders f = do
     bds <- asks bidders
-    onGame (bidder bds Hand1) game sglPlayer
-    onGame (bidder bds Hand2) game sglPlayer
-    onGame (bidder bds Hand3) game sglPlayer
+    f (bidder bds Hand1)
+    f (bidder bds Hand2)
+    f (bidder bds Hand3)