Advertisement
Guest User

Untitled

a guest
Aug 31st, 2015
63
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 0.66 KB | None | 0 0
  1. withResource :: forall m a b. (MonadBaseControl IO m) => Pool a -> (a -> m (Bool, b)) -> m b
  2. {-# SPECIALIZE withResource :: Pool a -> (a -> IO (Bool,b)) -> IO b #-}
  3. withResource pool act = fmap snd result
  4. where
  5. result :: m (Bool, b)
  6. result = control $ runInIO -> mask $ restore -> do
  7. resource <- takeResource pool
  8. ret <- restore (runInIO (act resource)) `onException`
  9. destroyResource pool resource
  10.  
  11. void . runInIO $ do
  12. (keep, _) <- restoreM ret :: m (Bool, b)
  13.  
  14. if keep
  15. then liftBaseWith $ _ -> putResource pool resource
  16. else liftBaseWith $ _ -> destroyResource pool resource
  17.  
  18. return ret
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement