2

我在 Scotty 使用两个 API 对 Web 服务器进行原型设计：

  • /add/:id使用给定的 ID 启动一个 asyc 任务。
  • /cancel/:id杀死给定 ID 的任务。

基本上，客户端通过提供一些 ID 来启动异步任务，也可以通过 ID 终止当前任务。

我Control.Concurrent.forkIO用来启动一个线程，forkIO返回一个ThreadId我存储在 Scotty 全局状态中的 Map: type AppState = Map TaskId ThreadId。

/add/:id不会立即返回，而是等待任务完成并将结果返回给客户端。

我的问题是forkIO与MonadIO m => ActionT Text m (). 我需要能够在我通过text :: Text -> ActionT Text m ()的操作完成后调用。IO ()forkIO

这需要从那显然MonadIO m是IO一个错误，但我无法解决它并找到任何解决方案。

这是完整的例子：

import qualified Control.Concurrent as C
import qualified Control.Concurrent.STM as STM
import Control.Monad.Trans.Reader (ReaderT(..), runReaderT)
import Control.Monad.Trans (MonadIO)
import Control.Monad.Reader (MonadReader, lift, liftIO, ask)
import qualified Data.Map as M
import Data.Text.Lazy (Text, pack, unpack)
import Web.Scotty.Trans


type TaskId = String

type AppState = M.Map TaskId C.ThreadId

newtype WebM a = WebM { runWebM :: ReaderT (STM.TVar AppState) IO a }
  deriving (Applicative, Functor, Monad, MonadIO, MonadReader (STM.TVar AppState))

app :: ScottyT Text WebM ()
app = do
  get "/add/:id" $ do
    taskId <- fmap unpack (param "id")
    let task = return "Hello World" -- just a dummy IO
    tid <- liftIO $ C.forkIO $ do
      result <- task
      -- Couldn't match type ‘ActionT Text m’ with ‘IO’
      lift $ modify' $ M.delete taskId -- remove the completed task from the state
      text result -- return the result to the client
      return () -- forkIO :: IO () -> IO ThreadId
    lift $ modify' $ M.insert taskId tid -- immedialtey add the new task to the state

  get "/cancel/:id" $ do
    taskId <- fmap unpack (param "id")
    dic <- lift $ gets id
    maybe
      (text $ pack (taskId ++ " Not Found"))
      (
        \ tid -> do
          liftIO $ C.killThread tid
          lift $ modify' $ M.delete taskId -- remove the cancelled task from the state
          text $ pack (taskId ++ " Cancelled")
      )
      (M.lookup taskId dic)

gets :: (AppState -> b) -> WebM b
gets f = fmap f (ask >>= liftIO . STM.readTVarIO)

modify' :: (AppState -> AppState) -> WebM ()
modify' f = ask >>= liftIO . STM.atomically . flip STM.modifyTVar' f

main :: IO ()
main = do
  dic <- STM.newTVarIO M.empty
  let runActionToIO m = runReaderT (runWebM m) dic
  scottyT 3000 runActionToIO app
4

1 回答 1

3

我认为您需要将调用text result移出分叉线程，并MVar在结果准备好时使用 an 进行通信。所以像

get "/add/:id" $ do
    taskId <- fmap unpack (param "id")
    let task = return "Hello World"
    m <- newEmptyMVar
    tid <- liftIO $ C.forkIO $ do
        result <- task
        putMVar result
        ...
    r <- takeMVar m
    text r

takeMVar将阻塞直到MVar包含一个值。

于 2017-06-14T21:29:42.897 回答