Exceptions 0.10.0 (#61)

* implement generalBracket

* implement uninterruptibleMask

the previous implementation was just delegating to 'mask', and was thus
interruptible

* exceptions >= 0.10.0

hint.cabal

@@ -41,7 +41,7 @@ test-suite unit-tests
  directory,
  filepath,
  extensible-exceptions,
- exceptions == 0.8.*
+ exceptions >= 0.10.0
 
  if !os(windows) {
  build-depends: unix >= 2.2.0.0
@@ -56,7 +56,7 @@ library
  ghc-boot,
  mtl,
  filepath,
- exceptions == 0.8.*,
+ exceptions == 0.10.*,
  random,
  directory
 

src/Control/Monad/Ghc.hs

@@ -60,7 +60,20 @@ instance (MonadIO m, MonadMask m) => MonadMask (GhcT m) where
  wrap g = GhcT $ GHC.GhcT $ \s -> MTLAdapter (g s)
  unwrap m = unMTLA . GHC.unGhcT (unGhcT m)
 
- uninterruptibleMask = mask
+ uninterruptibleMask f = wrap $ \s ->
+ uninterruptibleMask $ \io_restore ->
+ unwrap (f $ \m -> (wrap $ \s' -> io_restore (unwrap m s'))) s
+ where
+ wrap g = GhcT $ GHC.GhcT $ \s -> MTLAdapter (g s)
+ unwrap m = unMTLA . GHC.unGhcT (unGhcT m)
+
+ generalBracket acquire release body
+ = wrap $ \s -> generalBracket (unwrap acquire s)
+ (\a exitCase -> unwrap (release a exitCase) s)
+ (\a -> unwrap (body a) s)
+ where
+ wrap g = GhcT $ GHC.GhcT $ \s -> MTLAdapter (g s)
+ unwrap m = unMTLA . GHC.unGhcT (unGhcT m)
 
 instance (MonadIO m, MonadCatch m, MonadMask m) => GHC.ExceptionMonad (GhcT m) where
  gcatch = catch