[commit: Cabal] master: Allow building with base 4 (17a0af7)
Ian Lynagh
igloo at earth.li
Fri Jun 24 02:04:25 CEST 2011
Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/17a0af74b66a63c0cc6226850ca9f1a16b056894
>---------------------------------------------------------------
commit 17a0af74b66a63c0cc6226850ca9f1a16b056894
Author: Duncan Coutts <duncan at haskell.org>
Date: Wed Oct 28 16:31:48 2009 +0000
Allow building with base 4
>---------------------------------------------------------------
cabal-install/Distribution/Client/Install.hs | 42 ++++++++++++++++---
cabal-install/Distribution/Client/Types.hs | 14 +++---
cabal-install/Distribution/Client/Utils.hs | 10 ++--
.../Distribution}/Compat/Exception.hs | 41 +++++++------------
cabal-install/cabal-install.cabal | 2 +-
5 files changed, 64 insertions(+), 45 deletions(-)
diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs
index 4603db4..044607a 100644
--- a/cabal-install/Distribution/Client/Install.hs
+++ b/cabal-install/Distribution/Client/Install.hs
@@ -21,7 +21,18 @@ import Data.Maybe
( isJust, fromMaybe )
import qualified Data.Map as Map
import Control.Exception as Exception
- ( handle, handleJust, Exception(IOException) )
+ ( handleJust )
+#if MIN_VERSION_base(4,0,0)
+import Control.Exception as Exception
+ ( Exception(toException), catches, Handler(Handler), IOException )
+import System.Exit
+ ( ExitCode )
+#else
+import Control.Exception as Exception
+ ( Exception(IOException, ExitException) )
+#endif
+import Distribution.Compat.Exception
+ ( SomeException, catchIO, catchExit )
import Control.Monad
( when, unless )
import System.Directory
@@ -294,7 +305,11 @@ storeDetailedBuildReports verbosity logsDir reports = sequence_
warn verbosity $ "Missing log file for build report: "
++ fromMaybe "" (ioeGetFileName ioe)
+#if MIN_VERSION_base(4,0,0)
+ missingFile ioe
+#else
missingFile (IOException ioe)
+#endif
| isDoesNotExistError ioe = Just ioe
missingFile _ = Nothing
@@ -645,9 +660,10 @@ installUnpackedPackage verbosity scriptOptions miscOptions
-- Doc generation phase
docsResult <- if shouldHaddock
- then Exception.handle (\_ -> return DocsFailed) $ do
- setup haddockCommand haddockFlags
- return DocsOk
+ then (do setup haddockCommand haddockFlags
+ return DocsOk)
+ `catchIO` (\_ -> return DocsFailed)
+ `catchExit` (\_ -> return DocsFailed)
else return DocsNotTried
-- Tests phase
@@ -710,9 +726,21 @@ installUnpackedPackage verbosity scriptOptions miscOptions
else die $ "Unable to find cabal executable at: " ++ self
-- helper
-onFailure :: (Exception -> BuildFailure) -> IO BuildResult -> IO BuildResult
-onFailure result = Exception.handle (return . Left . result)
-
+onFailure :: (SomeException -> BuildFailure) -> IO BuildResult -> IO BuildResult
+onFailure result action =
+#if MIN_VERSION_base(4,0,0)
+ action `catches`
+ [ Handler $ \ioe -> handler (ioe :: IOException)
+ , Handler $ \exit -> handler (exit :: ExitCode)
+ ]
+ where
+ handler :: Exception e => e -> IO BuildResult
+ handler = return . Left . result . toException
+#else
+ action
+ `catchIO` (return . Left . result . IOException)
+ `catchExit` (return . Left . result . ExitException)
+#endif
withWin32SelfUpgrade :: Verbosity
-> ConfigFlags
diff --git a/cabal-install/Distribution/Client/Types.hs b/cabal-install/Distribution/Client/Types.hs
index ca1b47b..3012056 100644
--- a/cabal-install/Distribution/Client/Types.hs
+++ b/cabal-install/Distribution/Client/Types.hs
@@ -26,8 +26,8 @@ import Distribution.Version
import Data.Map (Map)
import Network.URI (URI)
-import Control.Exception
- ( Exception )
+import Distribution.Compat.Exception
+ ( SomeException )
newtype Username = Username { unUsername :: String }
newtype Password = Password { unPassword :: String }
@@ -137,11 +137,11 @@ data UnresolvedDependency
type BuildResult = Either BuildFailure BuildSuccess
data BuildFailure = DependentFailed PackageId
- | DownloadFailed Exception
- | UnpackFailed Exception
- | ConfigureFailed Exception
- | BuildFailed Exception
- | InstallFailed Exception
+ | DownloadFailed SomeException
+ | UnpackFailed SomeException
+ | ConfigureFailed SomeException
+ | BuildFailed SomeException
+ | InstallFailed SomeException
data BuildSuccess = BuildOk DocsResult TestsResult
data DocsResult = DocsNotTried | DocsFailed | DocsOk
diff --git a/cabal-install/Distribution/Client/Utils.hs b/cabal-install/Distribution/Client/Utils.hs
index 6e3d73c..e3f0904 100644
--- a/cabal-install/Distribution/Client/Utils.hs
+++ b/cabal-install/Distribution/Client/Utils.hs
@@ -17,8 +17,9 @@ import System.Directory
import Distribution.Compat.TempFile
( createTempDirectory )
import qualified Control.Exception as Exception
- ( handle, throwIO, evaluate, finally, bracket )
-
+ ( evaluate, finally, bracket )
+import qualified Distribution.Compat.Exception as Exception
+ ( onException )
-- | Generic merging utility. For sorted input lists this is a full outer join.
--
-- * The result list never contains @(Nothing, Nothing)@.
@@ -51,9 +52,8 @@ duplicatesBy cmp = filter moreThanOne . groupBy eq . sortBy cmp
writeFileAtomic :: FilePath -> BS.ByteString -> IO ()
writeFileAtomic targetFile content = do
(tmpFile, tmpHandle) <- openBinaryTempFile targetDir template
- Exception.handle (\err -> do hClose tmpHandle
- removeFile tmpFile
- Exception.throwIO err) $ do
+ Exception.onException (do hClose tmpHandle
+ removeFile tmpFile) $ do
BS.hPut tmpHandle content
hClose tmpHandle
renameFile tmpFile targetFile
diff --git a/Distribution/Compat/Exception.hs b/cabal-install/Distribution/Compat/Exception.hs
similarity index 65%
copy from Distribution/Compat/Exception.hs
copy to cabal-install/Distribution/Compat/Exception.hs
index ae8d9d5..dab4efd 100644
--- a/Distribution/Compat/Exception.hs
+++ b/cabal-install/Distribution/Compat/Exception.hs
@@ -1,28 +1,27 @@
-{-# OPTIONS -cpp #-}
--- OPTIONS required for ghc-6.4.x compat, and must appear first
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -cpp #-}
{-# OPTIONS_NHC98 -cpp #-}
{-# OPTIONS_JHC -fcpp #-}
-
-#if !(defined(__HUGS__) || (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 610))
-#define NEW_EXCEPTION
-#endif
-
+-- #hide
module Distribution.Compat.Exception (
- Exception.IOException,
- onException,
- catchIO,
- catchExit,
- throwIOIO,
- tryIO,
+ SomeException,
+ onException,
+ catchIO,
+ catchExit,
+ throwIOIO
) where
import System.Exit
import qualified Control.Exception as Exception
+#if MIN_VERSION_base(4,0,0)
+import Control.Exception (SomeException)
+#else
+import Control.Exception (Exception)
+type SomeException = Exception
+#endif
onException :: IO a -> IO b -> IO a
-#ifdef NEW_EXCEPTION
+#if MIN_VERSION_base(4,0,0)
onException = Exception.onException
#else
onException io what = io `Exception.catch` \e -> do what
@@ -30,32 +29,24 @@ onException io what = io `Exception.catch` \e -> do what
#endif
throwIOIO :: Exception.IOException -> IO a
-#ifdef NEW_EXCEPTION
+#if MIN_VERSION_base(4,0,0)
throwIOIO = Exception.throwIO
#else
throwIOIO = Exception.throwIO . Exception.IOException
#endif
-tryIO :: IO a -> IO (Either Exception.IOException a)
-#ifdef NEW_EXCEPTION
-tryIO = Exception.try
-#else
-tryIO = Exception.tryJust Exception.ioErrors
-#endif
-
catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
-#ifdef NEW_EXCEPTION
+#if MIN_VERSION_base(4,0,0)
catchIO = Exception.catch
#else
catchIO = Exception.catchJust Exception.ioErrors
#endif
catchExit :: IO a -> (ExitCode -> IO a) -> IO a
-#ifdef NEW_EXCEPTION
+#if MIN_VERSION_base(4,0,0)
catchExit = Exception.catch
#else
catchExit = Exception.catchJust exitExceptions
where exitExceptions (Exception.ExitException ee) = Just ee
exitExceptions _ = Nothing
#endif
-
diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal
index 8363f53..d0b65a8 100644
--- a/cabal-install/cabal-install.cabal
+++ b/cabal-install/cabal-install.cabal
@@ -79,7 +79,7 @@ Executable cabal
Distribution.Compat.TempFile
Paths_cabal_install
- build-depends: base >= 2 && < 4,
+ build-depends: base >= 2 && < 5,
Cabal >= 1.7.5 && < 1.9,
filepath >= 1.0,
network >= 1 && < 3,
More information about the Cvs-libraries
mailing list