分叉在斯科蒂服務器

新主題，我在原型斯科蒂Web服務器與兩個API：分叉在斯科蒂服務器

/add/:id開始給定ID的ASYC任務。
/cancel/:id殺死給定ID的任務。

基本上客戶端通過提供一些Ids啓動異步任務，並且也可以通過他們的Id來終止當前任務。

我用Control.Concurrent.forkIO啓動一個線程，forkIO返回我存儲在這是一個地圖斯科蒂全球狀態的ThreadId：type AppState = Map TaskId ThreadId。

/add/:id不會立即返回，而是等待任務完成並將結果返回給客戶端。

我的問題是混合forkIO與MonadIO m => ActionT Text m()。我需要在完成IO()行動之後撥打text :: Text -> ActionT Text m()，我通過了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

來源

2017-06-14 homam

我認爲你需要將呼叫轉移到text result出分叉線程的，並使用一個MVar當結果準備好溝通。因此，像

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-14 21:29:42

分叉在斯科蒂服務器

回答

相關問題