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 <[email protected]> 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, _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
