FRPでチャットサーバ
FRPのライブラリの一つであるsodiumを触りつつチャットサーバを書いてみた。また、sodiumを使わないバージョンのコードも書いてみたので比べてみる。なおここではbehaviourは全く使っておらずEventの機能のみを使った。
機能
- 特定のportでクライアントからの接続を待ち受ける
- メッセージは全クライアントへのブロードキャストのみ
- exitと打つと抜ける
まずsodiumを使ったコードはこちら。
sodiumのEventとしてChatEventというデータ型を定義し、新規クライアント接続とメッセージの送信を表現した。
data ChatEvent = Join String | Message String String
chat :: IO ()
chat = do
let port = 8888
(event, push) <- sync newEvent
sock <- listenOn $ PortNumber port
print $ "start listening port " <> show port
forever $ do
(handle, host, port) <- accept sock
let name = host <> show port
unlisten <- sync $ listen event (handler handle)
sync $ push $ Join name
forkFinally (talk name handle push) (\_ -> hClose handle)
where
talk :: String -> Handle -> (ChatEvent -> Reactive ()) -> IO ()
talk name h push = forever $ do
msg <- hGetLine h
print $ "get msg from handle " <> msg
sync $ push $ Message name msg
handler :: Handle -> ChatEvent -> IO ()
handler h (Join name) = hPutStrLn h $ "Join " <> name
handler h (Message name msg)
| msg == "exit\r" = do
print $ "handle is closed: " <> name
hClose h
| otherwise = hPutStrLn h $ "from " <> name <> ": " <> msg
次にsodiumを使わないで書いたコード。
接続したクライアントの情報管理のためServerというデータ型を導入した。各クライアントの名前とハンドルをMapで管理し、スレッドセーフに更新するためTVarに包んだ。
data Server = Server { clients :: TVar (M.Map String Handle) }
normalChat :: IO ()
normalChat = do
let port = 8889
sock <- listenOn $ PortNumber port
print $ "start listening port " <> show port
tvar <- newTVarIO M.empty
let server = Server tvar
forever $ do
(handle, host, port) <- accept sock
let name = host <> show port
print $ "connected from " <> name
atomically $ addClient server handle name
forkFinally (talk server handle name) (\_ -> hClose handle)
where
talk :: Server -> Handle -> String -> IO ()
talk server@Server{..} h name = do
msg <- hGetLine h
case msg of
"exit\r" -> do
print $ "handle is closed: " <> name
hClose h
_ -> do
clientMap <- atomically $ readTVar clients
void $ flip M.traverseWithKey clientMap $ \_ handle ->
hPutStrLn handle $ name <> ": " <> msg
talk server h name
addClient :: Server -> Handle -> String -> STM ()
addClient Server{..} h name = do
clientMap <- readTVar clients
let newClientMap = M.insert name h clientMap
writeTVar clients newClientMap基本的な構造は同じになるように書いた。
メインスレッドではクライアントからの接続をforeverで待ち受ける。接続してきたクライアントに対してはtalkという関数でメッセージの入力を待ち受け、入力があればブロードキャスト。
sodiumを使っていない場合、新しい接続があるたびにTVar内のMapへクライアントの情報を追加する。メッセージのブロードキャストはMapの各要素を取り出してすべてのハンドルに出力を行う必要がある。
sodiumを使う場合、新規クライアントの追加はeventに対してhandlerを登録するだけで実現できる。また、メッセージのブロードキャストはeventをpushするだけでよい。それによって登録してある各ハンドラーが起動し各クライアントにメッセージが投げられる。
sodiumを使うことによってメッセージの入力と出力を簡単に分離することができコード全体が簡潔になった。また、各クライアントの接続はeventに対するhandlerの登録として表現できることで、自前のデータ構造やSTMも使わずに済んだ。
sodiumにはbehaviourという構成要素もあるので、次はそれも使って何ができるか試してみたい。
