Как использовать Network.WebSockets.Snap в оснастке?

Question

Было бы неплохо иметь возможность использовать Network.WebSockets модуль изнутри, но я не могу понять, как на самом деле это сделать.

С использованием runWebSocketsSnap :: MonadSnap m => ServerApp -> m () функция от Network.WebSockets.Snap в мое приложение легко включить простой сервер веб-сокетов без сохранения состояния:

routes :: [(ByteString, Handler App App ())]
routes = [ ("/ws", runWebSocketsSnap wsApp) ]

wsApp :: PendingConnection -> IO () -- this is the ServerApp type
wsApp pending = do
    conn <- acceptRequest pending
    forever $ do
        msg <- receiveData conn
        sendTextData conn ("Echo " `mappend` msg :: Text)

Но моя цель - сохранить состояние для веб-сервера (например, список подключенных клиентов, как в http://jaspervdj.be/websockets/example.html). В качестве альтернативы, доступ к хранилищу щелевых кислотных состояний будет отличным.

Моей первой идеей было liftIO действия websocket в Handler App App Монада, и напишите приложение, как это:

wsApp :: PendingConnection -> Handler App App ()
wsApp pending = do
    conn <- liftIO $ acceptRequest pending
    forever $ do
        msg <- liftIO $ receiveData conn
        update (SetLastMsg msg)
        liftIO $ sendTextData conn ("Stored msg in datastore.")

Но нет версии runWebSocketsSnap это берет приложение вышеупомянутой формы, и я не могу понять, как изменить существующий ( источник на взломе). Мне кажется, нужна альтернатива forkIO который принимает меры в Handler App App вместо монады, но мое понимание Haskell и особенно параллелизма в Snap заканчивается здесь...

Answer 1

Функция runWebSocketsSnap требует, чтобы ее аргумент был типа PendingConnection -> IO (), Это означает, что вы не можете напрямую получить доступ к структуре данных вашего приложения внутри этой функции. Что вам нужно сделать, это передать информацию в функцию в качестве аргумента примерно так.

routes = [ ("/ws", webSocketsDriver) ]

webSocketsDriver :: Handler App App ()
webSocketsDriver = do
    appState <- get
    runWebSocketsSnap (wsApp appState)

wsApp :: App -> PendingConnection -> IO ()
wsApp app pending = do
    ...