Setting off a interval on application launch in a Haskell Servant app

问题

I'm trying to build the backend for a browser based game using Servant, I want to have some kind of game loop that lets me fire out requests every x seconds. I already have some game state contained in an IORef, and as an initial attempt to get something working I am trying to update my state value every 2 seconds. Here is what I have:

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}

module Main where

import Prelude ()
import Prelude.Compat

import Control.Concurrent(forkIO, threadDelay)
import Control.Monad(forever)
import Control.Monad.Reader
import Data.Aeson.Compat
import Data.Aeson.Types
import Data.Maybe
import Data.IORef
import GHC.Generics
import Network.Wai.Handler.Warp
import Servant
import Servant.Utils.StaticFiles (serveDirectory)

type Api = "players" :> Get '[JSON] [Player]
      :<|> "tick" :> Get '[JSON] Integer

type Game = Api :<|> Raw

data Player = Player
  { name :: String
  } deriving (Eq, Show, Generic)

instance ToJSON Player

data Action = AddPlayer Player
  | Tick

data State = State {
    players :: [Player]
  , tick :: Integer }

initialState :: State
initialState = State { players = []
                     , tick = 0
                     }

update :: Action -> State -> State
update action state =
  case action of
    AddPlayer p ->
        state { players = [p] ++ (players state) }

    Tick ->
        state { tick = 1 + (tick state) }

updateState :: Action -> IORef State -> IO State
updateState action state =
  atomicModifyIORef state (\s -> (next s, s))
  where next = update action

seconds :: Int -> Int
seconds = (* 1000000)

getPlayers :: IORef State -> Handler [Player]
getPlayers state = liftIO $ do
  _ <- updateState (AddPlayer $ Player "Me") state
  s <- readIORef state
  return $ players s

getTick :: IORef State -> Handler Integer
getTick state = liftIO $ do
  s <- readIORef state
  return $ tick s

everything :: Proxy Game
everything = Proxy

server :: IORef State -> Server Game
server state = (getPlayers state
  :<|> getTick state)
  :<|> serveDirectoryFileServer "./build"

app :: IORef State -> Application
app state = serve everything (server state)

main :: IO ()
main = do
  let port = 8000
      state = newIORef initialState

  threadId <- forkIO $ forever $ do
    threadDelay $ seconds 2
    return $ updateState Tick =<< state

  putStrLn $ "Running server on " ++ show port
  run port . app =<< state

The app builds, but it doesn't do what I want it to, visiting /tick always returns 0. I'm guessing this is either something to do with the change to state happening in a separate thread, or the IO value being passed in two separate times? However I believe that forkIO has to happen inside an IO block, so I'm unsure how to get the two values to meet.

This kind of thing is exactly what Haskell seeks to avoid, which is probably why it's so difficult to achieve. My problem is that I want to have some way to trigger a function (that is able to modify State) every x seconds, if the solution involves going down an entirely separate route then so be it.

回答1:

state creates new IORef every time. Your web server and your thread update function work on two different IORefs and therefore on two different states. You want to share the IORef. Something like the following should work.

main :: IO ()
main = do
  let port = 8000
  ref <- newIORef initialState
  threadId <- forkIO $ forever $ do
    threadDelay $ seconds 2
    updateState state ref
  run port $ app ref

来源：https://stackoverflow.com/questions/46959753/setting-off-a-interval-on-application-launch-in-a-haskell-servant-app

标签

haskell

game-loop