Как перехватить исключение внутри runResourceT

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

Спасибо за помощь.

{-# LANGUAGE FlexibleContexts #-}

module Main where

import Control.Exception as EX
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource

type Resource = String

allocResource :: IO Resource
allocResource = let r = "Resource"
                    in putStrLn (r ++ " opened.") >> return r

closeResource :: Resource -> IO ()
closeResource r = putStrLn $ r ++ " closed."

withResource :: ( MonadIO m
                , MonadBaseControl IO m
                , MonadThrow m
                , MonadUnsafeIO m
                ) => (Resource -> ResourceT m a) -> m a 
withResource f = runResourceT $ do
    (_, r) <- allocate allocResource closeResource
    f r

useResource :: ( MonadIO m
               , MonadBaseControl IO m
               , MonadThrow m
               , MonadUnsafeIO m
               ) => Resource -> ResourceT m Int
useResource r = liftIO $ putStrLn ("Using " ++ r) >> return 1

main :: IO ()
main = do
  putStrLn "Start..."

  withResource $ \r -> do

    x <- useResource r

    {-- This does not compile as the catch computation runs inside IO
    y <- liftIO $ EX.catch (useResource r)
                           (\e -> do putStrLn $ show (e::SomeException)
                                     return 0)
    --} 

    return ()

  putStrLn "Done."
8
задан jedf 8 June 2012 в 17:10
поделиться