Always use extensible exceptions in ghc-pkg, rather than using ifdefs

diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 344a21e..8b33d7b 100644 (file)
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -32,7 +32,11 @@ import Prelude
 
 import System.Console.GetOpt
 import Text.PrettyPrint
 
 import System.Console.GetOpt
 import Text.PrettyPrint

+#if __GLASGOW_HASKELL__ >= 609

 import qualified Control.Exception as Exception
 import qualified Control.Exception as Exception

+#else
+import qualified Control.Exception.Extensible as Exception
+#endif

 import Data.Maybe
 
 import Data.Char ( isSpace, toLower )
 import Data.Maybe
 
 import Data.Char ( isSpace, toLower )

@@ -1108,10 +1112,11 @@ installSignalHandlers :: IO ()
 installSignalHandlers = do
   threadid <- myThreadId
   let
 installSignalHandlers = do
   threadid <- myThreadId
   let

-      interrupt = throwTo threadid (Exception.ErrorCall "interrupted")
+      interrupt = Exception.throwTo threadid
+                                    (Exception.ErrorCall "interrupted")

   --
 #if !defined(mingw32_HOST_OS)
   --
 #if !defined(mingw32_HOST_OS)

-  installHandler sigQUIT (Catch interrupt) Nothing 
+  installHandler sigQUIT (Catch interrupt) Nothing

   installHandler sigINT  (Catch interrupt) Nothing
   return ()
 #elif __GLASGOW_HASKELL__ >= 603
   installHandler sigINT  (Catch interrupt) Nothing
   return ()
 #elif __GLASGOW_HASKELL__ >= 603

@@ -1136,40 +1141,16 @@ isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack)
 #endif
 
 catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
 #endif
 
 catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a

-#if __GLASGOW_HASKELL__ >= 609

 catchIO = Exception.catch
 catchIO = Exception.catch

-#else
-catchIO io handler = io `Exception.catch` handler'
-    where handler' (Exception.IOException ioe) = handler ioe
-          handler' e                           = Exception.throw e
-#endif

 
 #if mingw32_HOST_OS || mingw32_TARGET_OS
 throwIOIO :: Exception.IOException -> IO a
 
 #if mingw32_HOST_OS || mingw32_TARGET_OS
 throwIOIO :: Exception.IOException -> IO a

-#if __GLASGOW_HASKELL__ >= 609

 throwIOIO = Exception.throwIO
 throwIOIO = Exception.throwIO

-#else
-throwIOIO ioe = Exception.throwIO (Exception.IOException ioe)
-#endif

 #endif
 
 catchError :: IO a -> (String -> IO a) -> IO a
 #endif
 
 catchError :: IO a -> (String -> IO a) -> IO a

-#if __GLASGOW_HASKELL__ >= 609

 catchError io handler = io `Exception.catch` handler'
     where handler' (Exception.ErrorCall err) = handler err
 catchError io handler = io `Exception.catch` handler'
     where handler' (Exception.ErrorCall err) = handler err

-#else
-catchError io handler = io `Exception.catch` handler'
-    where handler' (Exception.ErrorCall err) = handler err
-          handler' e                         = Exception.throw e
-#endif
-
-onException :: IO a -> IO b -> IO a
-#if __GLASGOW_HASKELL__ >= 609
-onException = Exception.onException
-#else
-onException io what = io `Exception.catch` \e -> do what
-                                                    Exception.throw e
-#endif

 
 
 -- copied from Cabal's Distribution.Simple.Utils, except that we want
 
 
 -- copied from Cabal's Distribution.Simple.Utils, except that we want

@@ -1194,8 +1175,8 @@ writeFileAtomic targetFile content = do
 #else
       renameFile newFile targetFile
 #endif
 #else
       renameFile newFile targetFile
 #endif

-   `onException` do hClose newHandle
-                    removeFile newFile
+   `Exception.onException` do hClose newHandle
+                              removeFile newFile

   where
     template = targetName <.> "tmp"
     targetDir | null targetDir_ = "."
   where
     template = targetName <.> "tmp"
     targetDir | null targetDir_ = "."

@@ -1249,7 +1230,7 @@ openNewFile dir template = do
 #else
               fdToHandle (fromIntegral fd)
 #endif
 #else
               fdToHandle (fromIntegral fd)
 #endif

-              `onException` c_close fd
+              `Exception.onException` c_close fd

          return (filepath, h)
       where
         filename        = prefix ++ show x ++ suffix
          return (filepath, h)
       where
         filename        = prefix ++ show x ++ suffix

diff --git a/utils/ghc-pkg/ghc-pkg.cabal b/utils/ghc-pkg/ghc-pkg.cabal
index a201cb8..393e44d 100644 (file)
--- a/utils/ghc-pkg/ghc-pkg.cabal
+++ b/utils/ghc-pkg/ghc-pkg.cabal
@@ -35,6 +35,9 @@ Executable ghc-pkg
                        process    >= 1   && < 1.1,
                        pretty     >= 1   && < 1.1
 
                        process    >= 1   && < 1.1,
                        pretty     >= 1   && < 1.1
 

+    if impl(ghc < 6.9)
+        Build-Depends: extensible-exceptions
+

     Build-Depends: haskell98, filepath, Cabal
     if !os(windows)
         Build-Depends: unix
     Build-Depends: haskell98, filepath, Cabal
     if !os(windows)
         Build-Depends: unix