Использование IORef по сравнению с использованием Control.Monad.Trans.Control

Question

Я хотел иметь возможность проверить цепочку перенаправлений, которые видело мое приложение при отправке запроса через Network.HTTP.Client,

Эта функциональность не встроена в Network.HTTP.Clientхотя есть некоторые ссылки на идею в документации, включая (нерабочий) пример кода. Казалось, что это можно сделать, в основном, повторно используя почти полностью существующие части, поэтому я решил попробовать.

При поиске, это звучало как Control.Monad.Trans.Control может быть в состоянии удовлетворить мою потребность в накоплении запросов в течение StateT [Request] IO Однако, после нескольких дней неудачных попыток возиться с ним, я понял, что смог бы сделать то, что хотел, гораздо проще, если бы просто использовал IORef--- но мне все еще любопытно, если я пропустил какой-то умный способ сделать это, не прибегая к изменчивости.

Моя работа, IORefрутина выглядит так:

responseOpenWithRedirects :: Request -> Manager -> IO (Response BodyReader, [Request])
responseOpenWithRedirects req man = do
  mWrapIOException man $ do
    requestHistory <- newIORef []
    let
      handleRedirects localReq = do
        res <- httpRaw localReq {redirectCount = 0} man
        modifyIORef' requestHistory (localReq :)
        return (res, getRedirectedRequest localReq (responseHeaders res) (responseCookieJar res) (statusCode (responseStatus res)))
    res <- httpRedirect (redirectCount req) handleRedirects req
    redirectRequests <- readIORef requestHistory
    maybe (return (res, redirectRequests)) throwIO =<< applyCheckStatus (checkStatus req) res

Мой нерабочий (в том, что он не накапливает запросы), Control.Monad.Trans.Controlрутина выглядела так:

responseOpenWithRedirects :: Request -> Manager -> IO (Response BodyReader, [Request])
responseOpenWithRedirects req man =
  mWrapIOException man $ do
    let
       handleRedirects run localReq = do
         res <- httpRaw localReq {redirectCount = 0} man
         run (modify (\rs -> localReq : rs))
         return (res, getRedirectedRequest localReq (responseHeaders res) (responseCookieJar res) (statusCode (responseStatus res)))
    (res, redirectRequests) <- flip runStateT [] $ liftBaseWith $ \run -> httpRedirect (redirectCount req) (handleRedirects run) req
    maybe (return (res, redirectRequests)) throwIO =<< applyCheckStatus (checkStatus req) res

Проблема, на мой взгляд, заключается в том, что я не могу вернуть обновленное состояние из handleRedirects функция, потому что это вызывается изнутри httpRedirect--- и, как следствие, я никогда не получаю возможность использовать restoreM для обновленного значения. Я не понимаю, как мне удачно сочетать эти вещи, но я подозреваю, что это просто недостаток воображения или понимания с моей стороны.

Чтобы упростить задачу, вот тестовый комплект, который вы можете использовать с каждой версией:

#!/usr/bin/runghc

import Control.Exception
import Control.Monad.Trans.Control
import Control.Monad.Trans.State
import Data.IORef
import Data.ByteString.Lazy
import Network.HTTP.Client.Internal
import Network.HTTP.Types

main :: IO (Response ByteString, [Request])
main = do
  manager <- newManager defaultManagerSettings
  request <- parseUrl "http://feeds.feedburner.com/oreilly/newbooks"
  withResponseAndRedirects request manager $ \(res, reqs) -> do
    bss <- brConsume $ responseBody res
    return (res { responseBody = fromChunks bss }, reqs)

withResponseAndRedirects :: Request -> Manager -> ((Response BodyReader, [Request]) -> IO a) -> IO a
withResponseAndRedirects req man =
  bracket (responseOpenWithRedirects req man) (responseClose . fst)