Permalink
Browse files

Merge pull request #96 from dagit/master

Add travis-ci configuration and fix Prelude.catch issues on ghc 7.6
  • Loading branch information...
2 parents 15a1371 + f881f89 commit b1995ef7791cc34665d6e1a797f0cab1e1fb101d @creswick committed Feb 21, 2013
View
@@ -0,0 +1,3 @@
+language: haskell
+script:
+ - cabal install && ./bin/runtests
View
@@ -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
@@ -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
@@ -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
@@ -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"

0 comments on commit b1995ef

Please sign in to comment.