在Haskell Servant应用程序中启动应用程序启动的间隔

Question

我正在尝试使用Servant构建基于浏览器的游戏的后端,我希望有一种游戏循环让我每秒发出请求x.我已经将一些游戏状态包含在一个中IORef,并且作为初始尝试使某些东西工作我试图每2秒更新一次状态值.这是我有的:

{-# 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

应用程序构建,但它没有做我想要的,访问/tick总是返回0.我猜这可能与在单独的线程中发生的状态更改有关,或者IO是在两个单独的时间传递的值？但是我认为forkIO必须在一个IO区块内发生,所以我不确定如何让这两个值相遇.

这种事情正是Haskell试图避免的,这可能是它难以实现的原因.我的问题是,我希望有一些方法可以触发一个函数(能够修改State)每一x秒,如果解决方案涉及到一个完全独立的路线,那么就这样吧.

Answer 1

state每次创造新的IORef.您的Web服务器和线程更新功能适用于两个不同的IORef,因此适用于两种不同的状态.你想分享IORef.像下面这样的东西应该工作.

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