2

我正在制作一个简单的网络应用程序，它在文本中查找颜色词，并绘制关于它们的统计数据。如果不太忙，您可以在colors.jonreeve.com上对其进行测试。我正在使用Scotty Web 框架来处理 Web 内容。它适用于短文本，但较长的文本，如完整的小说，需要很长时间，浏览器通常会超时。所以我猜我这里需要的是通过 Jquery AJAX 或其他方式发送表单，然后让服务器每隔一段时间发送 JSON 及其状态（“正在加载文件”，“现在计算颜色”等），然后当它收到“成功”信号时，然后重定向到其他 URL？

这是我第一次尝试做这样的事情，如果这一切听起来不知情，请原谅我。我还注意到那里有一些类似的问题，但我感觉 Scotty 处理事情的方式与大多数设置略有不同。我注意到有一些函数用于设置原始输出、设置标题等。我是否尝试在分析的每个阶段发出某些信号？考虑到 Haskell 对副作用的处理，我将如何做到这一点？在这里，我什至都在努力想出最好的方法。

4

2 回答 2

1

我可能会设置一个接受 POST 请求的端点，而不是单个长时间运行的 GET 请求。POST 将立即返回响应正文中的两个链接：

  • 一个指向表示任务结果的新资源的链接，该资源不会立即可用。在此之前，对结果的 GET 请求可能会返回409 (Conflict)。

  • 一个指向相关的、立即可用的资源的链接，表示执行任务时发出的通知。

一旦客户端成功获取任务结果资源，它就可以删除它。这应该删除任务结果资源和关联的通知资源。

对于每个 POST 请求，您都需要生成一个后台工作线程。您还需要一个后台线程来删除过时的任务结果（因为客户端可能是懒惰的并且不调用 DELETE）。这些线程将与MVars、TVars、channels或类似方法进行通信。

现在的问题是：如何最好地处理服务器发出的通知？有几种选择：

  • 只需定期轮询来自客户端的通知资源。缺点：可能很多 HTTP 请求，没有及时收到通知。
  • 长轮询。一系列GET请求保持打开状态，直到服务器想要发出一些通知，或者直到超时。
  • 服务器发送的事件。wai-extra对此有支持，但我不知道如何将原始 wai 钩Application回 Scotty。
  • 网络套接字。虽然不确定如何与 Scotty 集成。

这是长轮询机制的服务器端框架。一些初步进口：

{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (concurrently_) -- from async
import Control.Concurrent.STM -- from stm
import Control.Concurrent.STM.TMChan -- from stm-chans
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (ToJSON) -- from aeson
import Data.Foldable (for_)
import Data.Text (Text) 
import Web.Scotty

这是主要代码。

main :: IO ()
main =
  do
    chan <- atomically $ newTMChan @Text
    concurrently_
      ( do
          for_
            ["starting", "working on it", "finishing"]
            ( \msg -> do
                threadDelay 10e6
                atomically $ writeTMChan chan msg
            )
          atomically $ closeTMChan chan
      )
      ( scotty 3000
          $ get "/notifications"
          $ do
            mmsg <- liftIO $ atomically $ readTMChan chan
            json $
              case mmsg of
                Nothing -> ["closed!"]
                Just msg -> [msg]
      )

有两个并发线程。一个以 10 秒的间隔将消息馈送到可关闭的通道，另一个运行 Scotty 服务器，每个 GET 调用都会挂起，直到有新消息到达通道。

使用curl从 bash 测试它，我们应该看到一连串的消息：

bash$ for run in {1..4}; do curl -s localhost:3000/notifications ; done
["starting"]["working on it"]["finishing"]["closed!"]
于 2020-03-27T15:55:54.510 回答
0

作为比较，这是基于服务器发送事件的解决方案的框架。但是它使用yesod而不是scotty ，因为 Yesod 提供了一种方法来挂钩管理事件的wai-extraApplication作为处理程序。

Haskell 代码

{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (concurrently_) -- from async
import Control.Concurrent.STM -- from stm
import Control.Concurrent.STM.TMChan -- from stm-chans
import Control.Monad.IO.Class (liftIO)
import Data.Binary.Builder -- from binary
import Data.Foldable (for_)
import Network.Wai.EventSource -- from wai-extra
import Network.Wai.Middleware.AddHeaders -- from wai-extra
import Yesod -- from yesod

data HelloWorld = HelloWorld (TMChan ServerEvent)

mkYesod
  "HelloWorld"
  [parseRoutes|
/foo FooR GET
|]

instance Yesod HelloWorld

getFooR :: Handler ()
getFooR = do
  HelloWorld chan <- getYesod
  sendWaiApplication
    . addHeaders [("Access-Control-Allow-Origin", "*")]
    . eventStreamAppRaw
    $ \send flush ->
      let go = do
            mevent <- liftIO $ atomically $ readTMChan chan
            case mevent of
              Nothing -> do
                send CloseEvent
                flush
              Just event -> do
                send event
                flush
                go
       in go

main :: IO ()
main =
  do
    chan <- atomically $ newTMChan
    concurrently_
      ( do
          for_
            [ ServerEvent
                (Just (fromByteString "ev"))
                (Just (fromByteString "id1"))
                [fromByteString "payload1"],
              ServerEvent
                (Just (fromByteString "ev"))
                (Just (fromByteString "id2"))
                [fromByteString "payload2"],
              ServerEvent
                (Just (fromByteString "ev"))
                (Just (fromByteString "eof"))
                [fromByteString "payload3"]
            ]
            ( \msg -> do
                threadDelay 10e6
                atomically $ writeTMChan chan msg
            )
          atomically $ closeTMChan chan
      )
      ( warp 3000 (HelloWorld chan)
      )

还有一个小空白页来测试服务器发送的事件。消息出现在浏览器控制台上：

<!DOCTYPE html>
<html lang="en">
<body>
</body>
<script>
    window.onload = function() {
        var source = new EventSource('http://localhost:3000/foo'); 
        source.onopen = function () { console.log('opened'); }; 
        source.onerror = function (e) { console.error(e); }; 
        source.addEventListener('ev', (e) => {
            console.log(e);
            if (e.lastEventId === 'eof') {
                source.close();
            }
        });
    }
</script>
</html>
于 2020-03-29T21:38:46.870 回答