add pvp mode, add chan communicator instance, fix json instances

src/Skat/AI/Online.hs

@@ -5,6 +5,7 @@
 module Skat.AI.Online where
 
 import Control.Monad.Reader
+import Control.Concurrent.Chan
 import Data.Aeson
 import Data.Maybe
 import qualified Data.ByteString.Lazy.Char8 as BS
@@ -19,6 +20,10 @@ class Communicator a where
     send :: a -> String -> IO ()
     receive :: a -> IO String
 
+instance Communicator (Chan String) where
+    send = writeChan
+    receive = readChan
+
 class Monad m => MonadClient m where
     query :: String -> m ()
     response :: m String

src/Skat/Matches.hs

@@ -1,5 +1,5 @@
 module Skat.Matches (
-    singleVsBots
+    singleVsBots, pvp
 ) where
 
 import Control.Monad.State
@@ -31,11 +31,20 @@ cardDistr = emptyPiles hand1 hand2 hand3 skt
 
 singleVsBots :: Communicator c => c -> IO ()
 singleVsBots comm = do
-    --let gen = mkStdGen 123
+    cards <- shuffleCards
-    --    cards = shuffleCardsWithGen gen
     let ps = Players
                 (PL $ OnlineEnv Team Hand1 comm)
                 (PL $ Stupid Team Hand2)
                 (PL $ mkAIEnv Single Hand3 10)
-        env = SkatEnv cardDistr Nothing Spades ps Hand1
+        env = SkatEnv (distribute cards) Nothing Spades ps Hand1
+    liftIO $ evalStateT (publishGameStart Hand3 >> turn >>= publishGameResults) env
+
+pvp :: Communicator c => c -> c -> c -> IO ()
+pvp comm1 comm2 comm3 = do
+    cards <- shuffleCards
+    let ps = Players
+                (PL $ OnlineEnv Team Hand1 comm1)
+                (PL $ OnlineEnv Team Hand2 comm2)
+                (PL $ OnlineEnv Team Hand3 comm3)
+        env = SkatEnv (distribute cards) Nothing Spades ps Hand1
     liftIO $ evalStateT (publishGameStart Hand3 >> turn >>= publishGameResults) env

src/Skat/Pile.hs

@@ -62,7 +62,8 @@ data Owner = P Hand | S
              deriving (Show, Eq, Ord, Read)
 
 instance ToJSON Owner where
-    toJSON _ = undefined -- TODO: fix
+    toJSON (P hand) = object ["owner" .= show hand]
+    toJSON S        = object ["owner" .= ("skat" :: String) ]
 
 type Played = Owner -- TODO: remove