Investigating the use of channels, threads, serialization and sockets

snorkels.cabal

@@ -60,6 +60,7 @@ executable snorkels
 
   -- Other library packages from which modules are imported.
   build-depends:       base >=4.8 && <4.9,
+                       bytestring >=0.10.6.0 && <0.10.6.1,
                        monad-loops >=0.4 && <0.5,
                        random >=1.1 && <1.2,
                        containers >=0.5 && <0.6,
@@ -67,7 +68,8 @@ executable snorkels
                        bimap >=0.3.2 && <0.3.3,
                        parsec >=3.1.11 && <3.1.12,
                        optparse-applicative >=0.13.0 && <0.13.1,
-                       network >=2.6.2.1 && <2.6.2.2
+                       network >=2.6.2.1 && <2.6.2.2,
+                       aeson >=0.8.0.2 && <0.8.0.3
 
   -- Directories containing source files.
   hs-source-dirs:      src
@@ -81,8 +83,8 @@ library
   exposed-modules:     Snorkels.Board,
                        Snorkels.Game,
                        Snorkels.Actions,
+                       Snorkels.Broadcaster,
                        Snorkels.PlayerTypes.Local,
-                       Snorkels.PlayerTypes.Network,
                        Snorkels.PlayerTypes.RandomAgent
 
   -- Modules included in this library but not exported.
@@ -93,6 +95,7 @@ library
 
   -- Other library packages from which modules are imported.
   build-depends:       base >=4.8 && <4.9,
+                       bytestring >=0.10.6.0 && <0.10.6.1,
                        monad-loops >=0.4 && <0.5,
                        random >=1.1 && <1.2,
                        containers >=0.5 && <0.6,
@@ -100,7 +103,8 @@ library
                        bimap >=0.3.2 && <0.3.3,
                        parsec >=3.1.11 && <3.1.12,
                        optparse-applicative >=0.13.0 && <0.13.1,
-                       network >=2.6.2.1 && <2.6.2.2
+                       network >=2.6.2.1 && <2.6.2.2,
+                       aeson >=0.8.0.2 && <0.8.0.3
 
   -- Directories containing source files.
   hs-source-dirs:      src

src/Snorkels/Broadcaster.hs

+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Snorkels.Broadcaster ( Snapshot
+                            , createChannel
+                            , broadcast
+                            , test
+                            ) where
+
+
+import Network
+import Control.Concurrent
+import Control.Concurrent.Chan
+import Data.ByteString.Lazy
+import System.IO
+
+import Data.Aeson
+import Data.Aeson.TH
+import qualified Data.Bimap as Bimap
+import qualified Data.Map.Strict as Map
+
+import Snorkels.Board
+import Snorkels.Game
+
+
+type Snapshot = (Player, Either (Maybe Position) Player, Board, Bimap.Bimap Player Player)
+$(deriveJSON defaultOptions ''Snorkel)
+$(deriveJSON defaultOptions ''Board)
+$(deriveJSON defaultOptions ''Piece)
+$(deriveJSON defaultOptions ''Map.Map)
+$(deriveJSON defaultOptions ''Bimap.Bimap)
+
+
+createChannel :: IO (Chan Snapshot)
+createChannel = newChan
+
+
+broadcast :: Chan Snapshot -> IO ThreadId
+broadcast channel = forkIO $ do sock <- listenOn $ PortNumber 7777
+                                -- Make a duplicate of the channel for this
+                                -- client
+                                channel <- dupChan channel
+                                serve sock channel
+                                return ()
+
+
+serve :: Socket -> Chan Snapshot -> IO ThreadId
+serve sock channel = do (h,_,_) <- accept sock
+                        forkIO $ body h channel
+                     where
+                         body h channel = do
+                             snaps <- getChanContents channel
+                             hPut h $ encode snaps
+                             hFlush h
+                             hClose h
+
+
+test = do chan <- createChannel
+          let s = (Green, Left Nothing, Board (Map.fromList []) (10, 10), Bimap.fromList [])
+          writeChan chan s
+          broadcast chan
+

src/Snorkels/PlayerTypes/Network.hs

-module Snorkels.PlayerTypes.Network ( server ) where
-
-import Network
-import Control.Concurrent
-import System.IO
-
-import Snorkels.Game
-
-
--- BUFFER: [(Player, Either (Maybe Position) Switch, Board)]
--- TODO: Switches should be checked too
-
--- Each program instance maintains a history buffer
--- When it's a network player's turn, connect to its server and asks for change
--- length localBuffer + 1
-
--- We could generalize this buffer thing so that all player types receive it
-
-server :: MVar Game -> IO a
-server mVarGame = do sock <- listenOn $ PortNumber 7777
-                     loop sock mVarGame
-
-
-loop :: Socket -> MVar Game -> IO a
-loop sock mVarGame = do (h,_,_) <- accept sock
-                        forkIO $ body h mVarGame
-                        loop sock mVarGame
-                     where
-                         body h mVarGame = do
-                             game <- takeMVar mVarGame
-                             hPutStr h $ show $ currentPlayer game
-                             hFlush h
-                             hClose h