Merge pull request #96 from dagit/master

Add travis-ci configuration and fix Prelude.catch issues on ghc 7.6

.travis.yml

@@ -0,0 +1,3 @@
+language: haskell
+script:
+  - cabal install && ./bin/runtests

admin/bootstrap.hs

@@ -10,6 +10,7 @@
 import qualified Distribution.Dev.RewriteCabalConfig as R
 
 import Control.Applicative ( (<$>) )
+import qualified Control.Exception as Ex ( IOException, catch )
 import Data.List ( isPrefixOf )
 import Data.Version ( Version(..), showVersion, parseVersion )
 import Data.Maybe ( fromMaybe, maybeToList )
@@ -70,9 +71,10 @@ main = do
 -- The absolute path to the sandbox directory
 getSandbox :: IO FilePath
 getSandbox = let path = "cabal-dev"
-                 handler = do cwd <- getCurrentDirectory
-                              return $ cwd </> path
-             in (canonicalizePath path) `catch` \_->handler
+                 handler :: Ex.IOException -> IO FilePath
+                 handler e = do cwd <- getCurrentDirectory
+                                return $ cwd </> path
+             in (canonicalizePath path) `Ex.catch` handler
 
 ---------------------------------------------------------------------
 -- Identifying GHC version so that we know how to initialize and what

src/Distribution/Dev/AddSource.hs

@@ -16,13 +16,9 @@ where
 #define MIN_VERSION_Cabal(a,b,c) 1
 #endif
 
-#ifdef NO_PRELUDE_CATCH
-import Control.Exception ( catch )
-#endif
-
 import Control.Applicative                   ( (<$>), (<*>) )
 import Control.Arrow                         ( right )
-import Control.Exception                     ( bracket )
+import qualified Control.Exception as Ex     ( catch, bracket )
 import Control.Monad                         ( guard, (<=<), forM_ )
 import Control.Monad.Error                   ( runErrorT, throwError )
 import Control.Monad.Trans                   ( liftIO )
@@ -136,7 +132,7 @@ writeIndex sandbox ents =
        renameFile newIndexName $ indexTar sandbox
     where
       pth = localRepoPath sandbox
-      withTmpIndex = bracket (openTempFile pth indexTarBase) (hClose . snd)
+      withTmpIndex = Ex.bracket (openTempFile pth indexTarBase) (hClose . snd)
 
 -- |Merge two lists of tar entries, filtering out the entries from the
 -- original list that will be duplicated by the second list of
@@ -158,7 +154,7 @@ toIndexEntry pkgId c = right toEnt $ T.toTarPath False (indexName pkgId)
 -- entries.
 readExistingIndex :: Sandbox a -> IO (Either String [T.Entry])
 readExistingIndex sandbox =
-    readIndexFile `catch` \e ->
+    readIndexFile `Ex.catch` \e ->
         if isDoesNotExistError e
         then return $ Right []
         else ioError e
@@ -210,7 +206,7 @@ installTarball flgs sandbox src pkgId pkgDesc =
       dest = localRepoPath sandbox </> tarballName pkgId
       makeSDist fn = do
         debug (getVerbosity flgs) $ "Running cabal sdist in " ++ fn
-        bracket getCurrentDirectory setCurrentDirectory $ \_ -> do
+        Ex.bracket getCurrentDirectory setCurrentDirectory $ \_ -> do
                     setCurrentDirectory fn
                     -- If the build-type is custom, run 'configure'
                     -- and invoke the generated setup program.
@@ -240,7 +236,7 @@ installTarball flgs sandbox src pkgId pkgDesc =
 downloadTarball :: URI -> IO (Either String FilePath)
 downloadTarball u = do
   tmpLoc <- getTemporaryDirectory
-  bracket (openTempFile tmpLoc "package-.tar.gz") (hClose . snd) $ \(fn, h) ->
+  Ex.bracket (openTempFile tmpLoc "package-.tar.gz") (hClose . snd) $ \(fn, h) ->
       do httpRes <- simpleHTTP $ mkRequest GET u
          case httpRes of
            Left err -> return $ Left $ show err
@@ -304,7 +300,7 @@ displayPackageName = id
 -- file
 processDirectory :: V.Verbosity -> FilePath
                  -> IO (Either String (PackageIdentifier, L.ByteString, PackageDescription))
-processDirectory v d = go `catch` \e ->
+processDirectory v d = go `Ex.catch` \e ->
                      if expected e
                      then return $ Left $ show e
                      else ioError e

src/Distribution/Dev/RewriteCabalConfig.hs

@@ -20,15 +20,12 @@ module Distribution.Dev.RewriteCabalConfig
     )
 where
 
-#ifdef NO_PRELUDE_CATCH
-import Control.Exception         ( catch, IOException )
-#endif
-
-import Control.Applicative       ( Applicative, pure, (<$>) )
-import Data.Maybe                ( fromMaybe )
-import Data.Traversable          ( traverse, Traversable )
-import Distribution.ParseUtils   ( Field(..), readFields, ParseResult(..) )
-import Distribution.Simple.Utils ( readUTF8File )
+import qualified Control.Exception as Ex ( catch, IOException )
+import Control.Applicative               ( Applicative, pure, (<$>) )
+import Data.Maybe                        ( fromMaybe )
+import Data.Traversable                  ( traverse, Traversable )
+import Distribution.ParseUtils           ( Field(..), readFields, ParseResult(..) )
+import Distribution.Simple.Utils         ( readUTF8File )
 import Text.PrettyPrint.HughesPJ
 
 data Rewrite = Rewrite { homeDir          :: FilePath
@@ -44,14 +41,10 @@ readConfig s = case readFields s of
 
 -- XXX: we should avoid this lazy IO that leaks a file handle.
 readConfigF :: FilePath -> IO (Either String [Field])
-readConfigF fn = (readConfig <$> readUTF8File fn) `catch` handler
+readConfigF fn = (readConfig <$> readUTF8File fn) `Ex.catch` handler
   where
-#ifdef NO_PRELUDE_CATCH
-    handler :: IOException -> IO (Either String [Field])
+    handler :: Ex.IOException -> IO (Either String [Field])
     handler  = return . Left . show
-#else
-    handler  = return . Left . show
-#endif
 
 readConfigF_ :: FilePath -> IO [Field]
 readConfigF_ fn = either error id <$> readConfigF fn

src/Distribution/Dev/Sandbox.hs

@@ -17,6 +17,7 @@ module Distribution.Dev.Sandbox
     )
 where
 
+
 import Control.Monad             ( unless )
 import Data.Version              ( Version, showVersion )
 import Distribution.Simple.Utils ( debug )
@@ -25,13 +26,10 @@ import System.Directory          ( createDirectoryIfMissing
                                  , doesFileExist, copyFile )
 import System.FilePath           ( (</>) )
 
-#ifdef NO_PRELUDE_CATCH
-import Control.Exception ( catch )
-#endif
-
 #ifdef mingw32_HOST_OS
 import System.IO ( hPutStrLn, stderr )
 import System.Win32.Types ( getLastError )
+import qualified Control.Exception as Ex ( catch, IOException )
 #endif
 
 import qualified Distribution.Dev.Flags as F
@@ -102,7 +100,10 @@ newSandbox v relSandboxDir = do
 vista32Workaround_createDirectoryIfMissing :: Bool -> FilePath -> IO ()
 vista32Workaround_createDirectoryIfMissing b fp =
 #ifdef mingw32_HOST_OS
-  createDirectoryIfMissing b fp `catch` \e -> do
+  createDirectoryIfMissing b fp `Ex.catch` handler
+  where
+  handler :: Ex.IOException -> IO ()
+  handler e = do
     erCode <- getLastError
     case erCode of
       1006 -> hPutStrLn stderr "Directory already exists--error swallowed"