HaskellでFunctional Reactive Programming(FRP)を試してみる

HaskellFRPをするためのライブラリ"Sodium"を少し触ってみました。

Sodiumは、C#, C++, Java, Scala, Haskellに対応していて、各言語間で類似したインターフェースを持つように設計されたFRPライブラリです。 FRPの実装方式は数種類あって、主にpull based、push basedが主流の2タイプのようなのですが、Sodiumはpush basedで実装されています。(push basedのほうが後発?)

EventとBehavior

FRPの基本であるEventとBehaviorについて軽く学んでおきましょう。

Eventとは時間と値が対になったデータのストリームです。例えば、マウスのクリックや、キーボードの入力、チャットの投稿の連続がこれにあたります。

Behaviorは時間によって変化するデータです。現在のマウスの位置や、チャットにいる現在の人数などがこれにあたります。時間に対しての連続性は保証されません。

基本的にこの2つの概念を用いてイベントドリブンで宣言的に手続きを記述できるのがFRPです。

Sodiumの基本

今回はEventのみ簡単に説明します。

Event

イベントの作成はnewEvent :: Reactive (Event a, a -> Reactive ())を使って行います。

listen :: Event a -> (a -> IO ()) -> Reactive (IO ())を用いることでイベントストリームに流れてきたイベントに対してActionを実行することができます。listenの返り値のIO ()を実行することによってストリームが破棄できます。

Reactive async :: Reactive a -> IO aで実行します。

以下の例では10秒間、1秒おきにtickと出力します。

import           Control.Concurrent (forkIO, threadDelay)
import           Control.Monad      (forever)
--
import           FRP.Sodium

main :: IO ()
main = do
  (event, push) <- sync newEvent
  unlisten <- sync $ listen event $ \_ -> putStrLn "tick"
  forkIO $ interval 1 push
  threadDelay 10000000
  unlisten

interval :: Int -> (() -> Reactive ()) -> IO ()
interval sec push = forever $ do
  sync $ push ()
  threadDelay $ 1000000 * sec

チャットサーバーを作る

では、シンプルなチャットサーバーを実装してみましょう。

module Main where

import           Control.Applicative ((<$>))
import           Control.Concurrent  (forkIO)
import           Control.Exception   (bracket)
import           Control.Monad       (forever, void)
import           Data.Monoid         (mconcat)
import           Network             (PortID (..), Socket, accept, listenOn,
                                      sClose)
import           System.IO           (Handle, hGetLine, hPutStrLn)
--
import           FRP.Sodium

data ChatData = Join String
              | Message String String
              deriving Show

main :: IO ()
main = bracket (listenOn $ PortNumber 9000) sClose chatServer

chatServer :: Socket -> IO ()
chatServer sock = do
  (chatEvent, chatPut) <- sync newEvent
  syncEvent $ serverLog chatEvent
  forever $ do
    (h, _, _) <- accept sock
    name <- init <$> hGetLine h
    sync $ chatPut $ Join name
    syncEvent $ listenChat h chatEvent
    forkIO $ forever $ hGetLine h >>= sync . chatPut . Message name

syncEvent :: Event (IO a) -> IO (IO ())
syncEvent = sync . flip listen void

serverLog :: Event ChatData -> Event (IO ())
serverLog = fmap print

listenChat :: Handle -> Event ChatData -> Event (IO ())
listenChat h ev = flip fmap ev  $ \chat ->
  hPutStrLn h $ case chat of
                 Join name -> mconcat ["User joined: ", name]
                 Message name mes -> mconcat [name, ": ", mes]

TCP Socketで複数人のチャットができるシンプルなサーバーです。

Event ChatDataが入室情報、メッセージが流れるストリームで、serverLogとlistenChatがそれぞれサーバー向け、クライアント向けにChatDataストリームをIO ()アクションストリームへと変換しています。

EventはFunctorなのでfmapを使ってIO ()へと移すことができます。

今回はシンプルなプログラムだったのでEventの変換は多用しませんでしたが、動作が複雑になってくるとEventの変換、2つのEventを1つにmergeしたりするなどしてリアクティブに記述していくのがいいのではと思います。

mergeやBehaviorなどについてはAPIドキュメントを参照。