Можно ли упорядочить действия ввода-вывода, сохраняя логику в чистой функции? - PullRequest
Новая
       18

Можно ли упорядочить действия ввода-вывода, сохраняя логику в чистой функции?

0 голосов
/ 04 мая 2018

У меня есть следующий код, который захватывает две страницы данных из конечной точки API с разбивкой по страницам. Я хотел бы изменить функцию query, чтобы она продолжала получать страницы, пока она не находит больше данных (поэтому замените take 2 в приведенном ниже коде на что-то, что смотрит на ответ API).

У меня вопрос, можно ли этого достичь, не меняя функцию query на функцию IO. И если так, как бы я поступил об этом. Если нет, есть ли способ сделать это без написания рекурсивной функции?

Вот код: 

#!/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


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


-- query by page
query :: ClientM [[BlogPost]]
query = sequence $ take 2 $ map posts pages
  where
    pages = [Just p | p <- [1..]]

-- main
main :: IO ()
main = do
  manager' <- newManager defaultManagerSettings
  let url = ClientEnv manager' (BaseUrl Http "jsonplaceholder.typicode.com" 80 "")
  posts' <- runClientM query url
  print posts'

Я пытался использовать takeWhileM для этого и в итоге сделал запрос IO функцией и передал в нее url. Это начинало выглядеть довольно ужасно, и я не мог заставить типы совпадать (я чувствовал, что мне нужно что-то более похожее на (a -> m Bool) -> m [a] -> m [a], а не (a -> m Bool) -> [a] -> m [a], что и есть takeWhileM - все еще нахожу это странным, потому что я вижу эта функция является фильтром, но входной и выходной список различны (одна имеет монаду, а другая нет)).

Ответы [ 3 ]

0 голосов
/ 05 мая 2018

Если вам нужно хранить отдельные объекты ClientM (для запуска каждого из них в чистом состоянии или чего-либо подобного), лучший способ - объединить все операции вместе.

В этом конкретном случае действие runClientM query ... IO возвращает Either String [BlogPost]. Это означает, что условие остановки получает Left String от одного из вычислений.

Используя созданный вручную помощник eitherM, который выполняет одно из двух действий в зависимости от конструктора Either, вот относительно простой пример этого:
Использование старого доброго делает это относительно простым: 

queryAll :: ClientEnv -> [Int] -> IO [[BlogPost]]
queryAll _ [] = return []
queryAll url (x:xs) = runClientM (posts x) url >>= either ((const.pure) []) (\b -> (b:) <$> queryAll url xs)

main :: IO ()
main = do
  manager' <- newManager defaultManagerSettings
  let url = ClientEnv manager' (BaseUrl Http "jsonplaceholder.typicode.com" 80 "")
  posts' <- queryAll url [1..]
  print posts'

Надеюсь, это поможет! :)

0 голосов
/ 05 мая 2018

Вы пробовали unfoldM? 

unfoldM :: Monad m => m (Maybe a) -> m [a]

Давайте обновим posts таким образом 

posts :: Maybe Integer -> ClientM (Maybe [BlogPost])
posts = fmap notNil . client api where
  notNil [] = Nothing
  notNil bs = Just bs

Идея состоит в том, чтобы обновить query, чтобы вы могли просто использовать unfoldM query и получить обратно ClientM [[BlogPost]]. Для этого тип query должен быть 

query :: ClientM (Maybe [BlogPost])

означает, что номер страницы должен исходить из среды: 

query = forever $ page >>= posts

Очевидно, что здесь происходит некоторая форма состояния, поскольку нам нужен способ отслеживать номер текущей страницы. Мы можем заключить действие клиента в StateT: 

type ClientSM = StateT Integer ClientM

page :: ClientSM Integer
page = get <* modify (+1)

Это действие требует нескольких дополнительных изменений как query, так и posts. Редактировать: см. Ниже, чтобы узнать, как я проник в автобус. Сначала нам нужно отменить действие клиента в монаде состояния: 

posts :: Integer -> ClientSM (Maybe [BlogPost])
posts = fmap notNil . lift . client api . Just  where
  notNil [] = Nothing
  notNil xs = Just xs

Необходимо изменить только тип query 

query :: ClientSM (Maybe [BlogPost])

Наконец, главное действие просто необходимо очистить стек монады и развернуть запрос: 

main = do
  manager' <- newManager defaultManagerSettings
  let url = mkClientEnv manager' (BaseUrl Http "jsonplaceholder.typicode.com" 80 "")
  result <- flip runClientM url $ flip runStateT 1 $ unfoldM query
  case result of
    Left error -> print error
    Right (posts, _) -> print posts

Я не проверял это, но он компилируется 10

posts не обращает внимания на состояние и должен оставаться таковым. Итак, не меняя мою оригинальную версию выше, вам просто нужно поднять в query: 

query :: ClientSM (Maybe [BlogPost])
query = forever $ page >>= lift . posts . Just
0 голосов
/ 04 мая 2018

Для этих случаев монадической итерации я обычно обращаюсь к потоковой библиотеке. Его интерфейс напоминает интерфейс чистых списков, но по-прежнему допускает эффекты: 

import           Streaming
import qualified Streaming.Prelude               as S

repeatAndCollect :: Monad m => m (Either a r) -> m [a]
repeatAndCollect = S.toList_ . Control.Monad.void . S.untilRight

repeatAndCollectLimited :: Monad m => Int -> m (Either a r) -> m [a]
repeatAndCollectLimited len = S.toList_ . S.take len . S.untilRight

Использование функций untilRight, take и toList_.

Когда требуется только первый успешный результат, мы можем использовать экземпляр Alternative преобразователя ExceptT в сочетании с asum из Data.Foldable для выполнения список ошибочных действий, пока одно из них не будет успешным.

IO сам по себе имеет экземпляр Alternative, который возвращает первый «успех», где «отказ» означает бросание IOException.

...