如何为Streaming.Prelude.takeWhile

时间:2018-05-15 11:51:14

标签: haskell streaming monads

我正在编写一个使用JSON API端点的程序。棘手的部分是我想继续迭代页面(通过传递_page参数),一旦API返回一个空列表,迭代应该停止(注意这意味着我们必须查看响应以决定是否我们应该停止迭代)。

我正在使用servant来轻松调用API,并且编写递归函数来收集结果并终止于上述条件并不困难。但如果有很多结果页面,这可能会占用大量内存。

所以我开始研究streaming库。我已经设法创建了一个API调用流,但我正在努力编写终止条件。我真的想编写终止条件而不执行客户端的runClientM方法。因此,我不想编写一个显式调用API并收集结果的递归函数,而是想做类似的事情:

map runClientM $ takeWhile hasData $ map createPageRequest $ [1..]

我已经达到了可以创建和运行请求流的程度,但无法写入终止条件。我不确定我是否无法解决这些问题,因为我错过了将所有类型绑定在一起的函数(liftM或其他...),或者因为类型系统阻止我做我正在尝试做什么,因为它是愚蠢的(整个使非法状态可表示的想法)。

无论如何,这是代码(我需要替换_predicate1predicate2不编译)。任何指针都将受到赞赏。

#!/usr/bin/env stack

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

import Servant.Client
import Network.HTTP.Client (newManager, defaultManagerSettings)

import Data.Proxy
import Servant.API

import Data.Aeson
import GHC.Generics

import Streaming
import qualified Streaming.Prelude as S

-- data type
data BlogPost = BlogPost
  { id :: Integer
  , title :: String
  } deriving (Show, Generic)

instance FromJSON BlogPost


-- api client
type API = "posts" :> QueryParam "_page" Integer :> Get '[JSON] [BlogPost]
api :: Proxy API
api = Proxy
posts :: Maybe Integer -> ClientM [BlogPost]
posts = client api


requestStream :: (Monad m) => Stream (Of (ClientM [BlogPost])) m ()
requestStream = S.takeWhile _ $ S.map posts $ S.each pages
  where
    pages = [Just p | p <- [1..]]
    predicate1 (Right v) = True
    predicate1 (Left e) = False
    predicate2 request = do
      r <- request
      case r of
        Right v -> return $ length v /= 0
        Left e -> return False


main :: IO ()
main = do
  manager' <- newManager defaultManagerSettings
  let url = ClientEnv manager' (BaseUrl Http "jsonplaceholder.typicode.com" 80 "")
  S.print $ S.mapM (\x -> runClientM x url) requestStream
  print "done"

编辑:我现在只是做S.print,但我还想做一些其他的操作,比如将这些数据发送到数据库。

编辑:这是我在使用predicate1时遇到的错误。我不明白为什么实际类型现在有Either a0 b0而不是ClientM [BlogPost],这就是没有调用S.takeWhile的情况。

test.hs:37:17: error:
    • Couldn't match type ‘Either a0 b0’ with ‘ClientM [BlogPost]’
      Expected type: Stream (Of (ClientM [BlogPost])) m ()
        Actual type: Stream (Of (Either a0 b0)) m ()
    • In the expression:
        S.takeWhile predicate1 $ S.map posts $ S.each pages
      In an equation for ‘requestStream’:
          requestStream
            = S.takeWhile predicate1 $ S.map posts $ S.each pages
            where
                pages = [Just p | p <- [1 .. ]]
                predicate1 (Right v) = True
                predicate1 (Left e) = False
                predicate2 request
                  = do r <- request
                       ....
   |
37 | requestStream = S.takeWhile predicate1 $ S.map posts $ S.each pages
   |                 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

test.hs:37:42: error:
    • Couldn't match type ‘ClientM [BlogPost]’ with ‘Either a0 b0’
      Expected type: Stream (Of (Either a0 b0)) m ()
        Actual type: Stream (Of (ClientM [BlogPost])) m ()
    • In the second argument of ‘($)’, namely
        ‘S.map posts $ S.each pages’
      In the expression:
        S.takeWhile predicate1 $ S.map posts $ S.each pages
      In an equation for ‘requestStream’:
          requestStream
            = S.takeWhile predicate1 $ S.map posts $ S.each pages
            where
                pages = [Just p | p <- [1 .. ]]
                predicate1 (Right v) = True
                predicate1 (Left e) = False
                predicate2 request
                  = do r <- request
                       ....
   |
37 | requestStream = S.takeWhile predicate1 $ S.map posts $ S.each pages
   |                                          ^^^^^^^^^^^^^^^^^^^^^^^^^^

1 个答案:

答案 0 :(得分:-1)

带有和不带流的servant-client示例

仆人文档拥有开始使用流媒体所需的大部分信息,但他们确实没有在示例中实际调用streamAPI。 Link to example

非流媒体示例

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}

module Main where

import Data.Aeson
import Data.Proxy
import GHC.Generics
import Network.HTTP.Client (newManager, defaultManagerSettings)
import Servant.API
import Servant.Client

-- data type
data BlogPost = BlogPost
  { id :: Integer
  , title :: String
  } deriving (Show, Generic)

instance FromJSON BlogPost

-- api client
type API = "posts" :> QueryParam "_page" Integer :> Get '[JSON] [BlogPost]

api :: Proxy API
api = Proxy

posts :: Maybe Integer -> ClientM [BlogPost]
posts = client api


main :: IO ()
main = do
  manager' <- newManager defaultManagerSettings
  res <- runClientM 
           (posts (Just 1)) 
           (mkClientEnv manager' 
             (BaseUrl 
               Http 
               "jsonplaceholder.typicode.com" 
               80 
               ""))
  case res of
    Left err -> putStrLn $ "Error: " ++ show err
    Right (post) -> print post

流媒体示例

将以下代码添加到上述文件中。

type StreamAPI = "post" :> QueryParam "_page" Integer :> StreamGet NewlineFraming JSON (ResultStream [BlogPost])

streamAPI :: Proxy StreamAPI
streamAPI = Proxy

posStream :: Maybe Integer -> ClientM (ResultStream [BlogPost])
posStream = client streamAPI

printResultStream :: Show a => ResultStream a -> IO ()
printResultStream (ResultStream k) = k $ \getResult ->
       let loop = do
            r <- getResult
            case r of
                Nothing -> return ()
                Just x -> print x >> loop
       in loop

然后在main中运行以下内容:

streamRes <- 
  runClientM 
    (posStream (Just 1)) 
    (mkClientEnv 
      manager' 
      (BaseUrl 
        Http 
        "jsonplaceholder.typicode.com" 
        80 
        ""))

case streamRes of
  Left err -> putStrLn $ "Error: " ++ show err
  Right (stream) -> printResultStream stream

编辑:最初我在提供的代码中指出了一些错误。 A改为完全可编辑的例子。