CODEWITHSUNDEEP
haskellwebsocketyesod
Tobi Nary
Tobi Nary

Reputation: 4596

Yesod, WebSockets and Persistent

I'm trying to implement a server for a turn based game in Haskell. My choice would be to use Yesod for adminstration and meta-information (like, what games a user participates in and such).

I'd like to use web sockets to keep the in-game data overhead small.

Looking at the ws-chat example, I'm not sure how to get access to the Handler Monad and with it Persistent.

It would be perfect to have some bookkeeping-code for the connections wrapped around a "normal" Handler that itself updates the database and informs relevant users.

Upvotes: 8

Views: 1426

Answers (3)

dimsuz
dimsuz

Reputation: 9207

I am using Yesod.WebSockets library and was able to access DB in a web socket application like this:

voteApp :: WebSocketsT Handler ()
voteApp = do
  uuid <- liftIO nextRandom
  master <- getYesod
  runSqlPool (insert (Session uuid)) $ appConnPool master
  -- rest of the handler

Upvotes: 0

Gert Cuykens
Gert Cuykens

Reputation: 7155

This is how I think it should look like.

{-# LANGUAGE QuasiQuotes, TypeFamilies, GeneralizedNewtypeDeriving, TemplateHaskell, OverloadedStrings, GADTs, FlexibleContexts #-}
module Main where
import Control.Monad.IO.Class (liftIO)
import Data.String (fromString)
import Database.Persist
import Database.Persist.TH
import Database.Persist.Sqlite
import Network.Wai.Application.Static (staticApp, defaultWebAppSettings, defaultFileServerSettings)
import Network.Wai.Handler.Warp (runSettings, defaultSettings, settingsIntercept, settingsPort)
import Network.Wai.Handler.WebSockets (intercept)
import qualified Network.WebSockets as WS

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|
Person
    name String
    age Int
    deriving Show
|]

ws :: WS.Request -> WS.WebSockets WS.Hybi10 ()
ws r = do
    WS.acceptRequest r
    liftIO $ runSqlite ":memory:" $ do
        runMigration migrateAll
        michaelId <- insert $ Person "Michael" 26
        michael <- get michaelId
        liftIO $ print michael

main :: IO ()
main = runSettings defaultSettings
    { settingsPort = 9160
    , settingsIntercept = intercept $ ws
    } $ staticApp (defaultFileServerSettings $ fromString ".")

Upvotes: 8

Michael Snoyman
Michael Snoyman

Reputation: 31315

If you're looking to run a Handler monad yourself, you can use runFakeHandler.

Upvotes: 4

Related Questions