Как добавить экземпляр MonadThrow в ResourceT Monad Transformer на сервере Warp

Я пытаюсь построить простой обратный прокси-сервер с использованием Warp (в основном для собственного назидания, поскольку есть много других готовых вариантов).

Пока мой код в основном взят из документации Warp (запись вывода в файл - это просто промежуточный тест, опять же снятый с документации):

import Network.Wai as W
import Network.Wai.Handler.Warp
import Network.HTTP.Types
import Network.HTTP.Conduit as H
import qualified Data.Conduit as C
import Data.Conduit.Binary (sinkFile)
import Blaze.ByteString.Builder.ByteString
import Control.Monad.Trans.Resource
import Control.Monad.IO.Class

proxApp req = do
    let hd = headerAccept "Some header"
    {-liftIO $ logReq req-}
    pRequest <- parseUrl "http://some_website.com"
    H.withManager $ \manager -> do
        Response _ _ _ src <- http pRequest manager
        src C.$$ sinkFile "test.html"
    return $ ResponseBuilder status200 [hd] $ fromByteString "OK\n"

main = do
    putStrLn "Setting up reverse proxy on 8080"
    run 8080 proxApp

Когда я пытаюсь запустить операции Network.HTTP внутри монады ResourceT, компилятор справедливо требует, чтобы он был экземпляром MonadThrow. Моя сложность заключается в том, как добавить это в стек монад или добавить его экземпляр в ResourceT. Ошибка компилятора с кодом ниже:

No instance for (MonadThrow
                   (conduit-0.1.1.1:Control.Monad.Trans.Resource.ResourceT IO))
  arising from a use of `proxApp'
Possible fix:
  add an instance declaration for
  (MonadThrow
     (conduit-0.1.1.1:Control.Monad.Trans.Resource.ResourceT IO))
In the second argument of `run', namely `proxApp'
In a stmt of a 'do' block: run 8080 proxApp
In the expression:
  do { putStrLn "Setting up reverse proxy on 8080";
       run 8080 proxApp }

Если я удаляю строки HTTP, экземпляр MonadThrow больше не требуется, и все работает нормально.

Если я определю новую пользовательскую монаду как экземпляр MonadThrow, как мне заставить сервер работать с ней? Ищите правильный способ представить обработку этого исключения в моем стеке (или даже просто удовлетворить компилятор).

Благодаря /O

2 ответа

Решение

This should do it (if you import Control.Monad.Trans.Resource так что вы получите ResourceT):

instance (MonadThrow m) => MonadThrow (ResourceT m) where
    monadThrow = lift . monadThrow

Спасибо за все ответы. Закончился приведенным ниже кодом, который, кажется, прекрасно работает с warp-1.2.0.1.

proxApp req = do
    liftIO $ logReq req
    pRequest <- parseUrl "http://some_website.com"
    H.withManager $ \manager -> do
        Response status version headers src <- http pRequest manager
        body <- src C.$$ responseSink
        liftIO $ putStrLn $ show status
        return $ ResponseBuilder status headers body

responseSink = C.sinkState
    (fromByteString "")
    (\acc a -> return $ C.StateProcessing $ mappend acc $ fromByteString a )
    (\acc -> return acc)
Другие вопросы по тегам