diff --git a/admin/cabal-config.in b/admin/cabal-config.in --- a/admin/cabal-config.in +++ b/admin/cabal-config.in @@ -61,22 +61,22 @@ prefix: ./ -- bindir: $prefix/bin -- libdir: $prefix/lib - -- libsubdir: $pkgid/$compiler - -- libexecdir: $prefix/libexec + libsubdir: $pkgid/$compiler + libexecdir: $prefix/libexec -- datadir: $prefix/share -- datasubdir: $pkgid - -- docdir: $datadir/doc/$pkgid + docdir: $datadir/doc/$pkgid -- htmldir: $docdir/html -- haddockdir: $htmldir install-dirs global prefix: ./ -- bindir: $prefix/bin - -- libdir: $prefix/lib - -- libsubdir: $pkgid/$compiler + libdir: $prefix/lib + libsubdir: $pkgid/$compiler -- libexecdir: $prefix/libexec -- datadir: $prefix/share -- datasubdir: $pkgid - -- docdir: $datadir/doc/$pkgid + docdir: $datadir/doc/$pkgid -- htmldir: $docdir/html -- haddockdir: $htmldir diff --git a/cabal-dev.cabal b/cabal-dev.cabal --- a/cabal-dev.cabal +++ b/cabal-dev.cabal @@ -1,5 +1,5 @@ Name: cabal-dev -Version: 0.9.1 +Version: 0.9.2 Synopsis: Manage sandboxed Haskell build environments Description: cabal-dev is a tool for managing development builds of @@ -17,19 +17,11 @@ databases. . If your build depends on patched or unreleased libraries, - you can add them to your sandboxed build environment so - they can be installed by @cabal-dev@ or @cabal@. Just run: - . - > cabal-dev add-source /path/to/source/code - . - @cabal-dev add-source@ also supports importing tarballs - into a local cabal repository. - . - Alternatively, install unreleased dependencies into the - target cabal-dev sandbox instead of using @add-source@: + you can add them to your sandboxed build environment by + installing them to the sandbox directly:so . > cd /path/to/dependency - > cabal-dev install --sandobox=/path/to/sandbox + > cabal-dev install --sandbox=/path/to/sandbox . Then build your library/application with the specified sandbox. @@ -38,22 +30,22 @@ Additional documentation can be found in the README.md on github: . - http://github.com/creswick/cabal-dev/blob/master/README.md + License: BSD3 License-file: LICENSE Author: Josh Hoyt, Jonathan Daugherty, Rogan Creswick -Maintainer: j3h@galois.com, jtd@galois.com, creswick@galois.com +Maintainer: joshhoyt@gmail.com, jtd@galois.com, creswick@galois.com Homepage: http://github.com/creswick/cabal-dev Bug-Reports: http://github.com/creswick/cabal-dev/issues -Copyright: 2010-2012 Galois, Inc. +Copyright: 2010-2013 Galois, Inc. Category: Development Build-type: Custom Cabal-version: >=1.6 Data-Files: admin/cabal-config.in, admin/00-index.tar -Tested-with: GHC == 6.12.3, GHC == 6.10.4, GHC == 7.0.3, GHC == 7.4.1 +Tested-with: GHC == 7.4.1, GHC == 7.6.1 source-repository head type: git @@ -93,7 +85,7 @@ -- avoid using it: if impl(ghc >= 6.12) Build-depends: - containers >= 0.3 && < 0.5 + containers >= 0.3 && < 0.6 -- Require this specific version that came with GHC 6.10 because -- of packaging problems with containers-0.2 @@ -105,19 +97,23 @@ Build-depends: containers == 0.1.0.2 + if impl(ghc >= 7.6.1) + CPP-Options: -DNO_PRELUDE_CATCH + Build-depends: - bytestring >= 0.9 && < 0.10, + bytestring >= 0.9 && < 0.11, directory >= 1.0 && < 1.3, filepath >= 1.1 && < 1.4, - Cabal >= 1.10.0.0 && < 1.15, + Cabal >= 1.10.0.0 && < 1.17, HTTP >= 4000.0.9 && < 4000.3, - mtl >= 1.1 && < 2.1, - network >= 2.2 && < 2.4, + mtl >= 1.1 && < 2.2, + network >= 2.2 && < 2.5, pretty >= 1.0 && < 1.2, process >= 1.0 && < 1.2, - tar >= 0.3 && < 0.4, + tar >= 0.4 && < 0.5, zlib >= 0.5 && < 0.6, - transformers >= 0.2 && < 0.3, + transformers >= 0.2 && < 0.4, + setenv == 0.1.*, -- Template haskell is special: the compiler will die if a -- version other than the one that is shipped with the compiler @@ -126,7 +122,7 @@ template-haskell if os(windows) - build-depends: Win32 >= 2.1 && < 2.3 + build-depends: Win32 >= 2.1 && < 2.4 Build-tools: cabal >= 0.8.2 @@ -154,7 +150,8 @@ Main-is: GhcPkgCompat.hs Build-Depends: base < 5, - Cabal >=1.2 && < 1.15 + Cabal >=1.2 && < 1.17, + process >= 1.0 && < 1.2 GHC-Options: -Wall HS-Source-Dirs: src @@ -176,12 +173,12 @@ Build-depends: MonadRandom >= 0.1 && < 0.2, random >= 1 && < 1.1, - test-framework >= 0.3 && < 0.6, + test-framework >= 0.3 && < 0.9, test-framework-hunit >= 0.2, HUnit >= 1.2 && <2 if os(windows) - build-depends: Win32 >= 2.1 && < 2.3 + build-depends: Win32 >= 2.1 && < 2.4 Executable fake-ghc-cabal-dev diff --git a/src/Distribution/Dev/AddSource.hs b/src/Distribution/Dev/AddSource.hs --- a/src/Distribution/Dev/AddSource.hs +++ b/src/Distribution/Dev/AddSource.hs @@ -18,7 +18,7 @@ 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 ) @@ -50,6 +50,7 @@ , setCurrentDirectory , createDirectoryIfMissing , getTemporaryDirectory + , removeFile ) import System.Exit ( ExitCode(..) ) import System.FilePath ( takeExtension, takeBaseName @@ -71,7 +72,7 @@ import Distribution.Dev.Command ( CommandActions(..), CommandResult(..) ) import Distribution.Dev.Flags ( Config, getVerbosity ) import Distribution.Dev.Sandbox ( resolveSandbox, localRepoPath - , Sandbox, indexTar, indexTarBase + , Sandbox, indexTar, indexTarBase, indexCache ) import Distribution.Simple.Utils ( debug, notice ) @@ -120,6 +121,7 @@ return CommandOk -- |Atomically write an index tarball in the supplied directory +-- and invalidates the cache writeIndex :: Sandbox a -- ^The local repository path -> [T.Entry] -- ^The index entries -> IO () @@ -130,9 +132,13 @@ hFlush h return fn renameFile newIndexName $ indexTar sandbox + removeFile (indexCache sandbox) `Ex.catch` \e -> + if isDoesNotExistError e + then return () + else ioError e 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 @@ -154,7 +160,7 @@ -- 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 @@ -164,7 +170,7 @@ forceEntries es = let step _ l@(Left _) = l step x (Right xs) = Right (x:xs) - es' = T.foldEntries step (Right []) Left es + es' = T.foldEntries step (Right []) (Left . show) es in either (const 0) length es' `seq` return es' @@ -206,7 +212,7 @@ 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. @@ -236,7 +242,7 @@ 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 @@ -300,7 +306,7 @@ -- 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 @@ -344,7 +350,7 @@ forcedBS bs = forceBS bs >> return bs -- |Extract a cabal file from a package tarball -extractCabalFile :: T.Entries -> Maybe (PackageIdentifier, L.ByteString, PackageDescription) +extractCabalFile :: T.Entries T.FormatError -> Maybe (PackageIdentifier, L.ByteString, PackageDescription) extractCabalFile = T.foldEntries step Nothing (const Nothing) where step ent Nothing = (,,) <$> entPackageId ent <*> entBytes ent <*> (parseDesc $ entBytes ent) diff --git a/src/Distribution/Dev/GhcPkg.hs b/src/Distribution/Dev/GhcPkg.hs --- a/src/Distribution/Dev/GhcPkg.hs +++ b/src/Distribution/Dev/GhcPkg.hs @@ -35,8 +35,12 @@ s <- initPkgDb v =<< resolveSandbox cfg (ghcPkg, _) <- requireProgram v ghcPkgProgram emptyProgramConfiguration let extraArgs = case getVersion s of - GHC_6_8_Db _ -> id - _ -> ("--no-user-package-conf":) + GHC_6_8_Db _ -> id + GHC_7_5_Plus_Db -> ("--no-user-package-db":) + _ -> ("--no-user-package-conf":) + pkgConfArgName = case getVersion s of + GHC_7_5_Plus_Db -> "--package-db" + _ -> "--package-conf" - runProgram v ghcPkg $ extraArgs $ "--global" : "--package-conf" : pkgConf s : args + runProgram v ghcPkg $ extraArgs $ "--global" : pkgConfArgName : pkgConf s : args return CommandOk diff --git a/src/Distribution/Dev/Ghci.hs b/src/Distribution/Dev/Ghci.hs --- a/src/Distribution/Dev/Ghci.hs +++ b/src/Distribution/Dev/Ghci.hs @@ -30,7 +30,8 @@ Right (buildArgs:_) -> do -- Use the arguments that cabal-install passed to GHC to -- invoke ghci instead - let ghciArgs = "--interactive" : filter (/= "--make") buildArgs + let ghciArgs = "--interactive" + : filter (not . (`elem` ["--make", "-O"])) buildArgs (ghc, _) <- requireProgram v ghcProgram emptyProgramConfiguration runProgram v ghc ghciArgs return CommandOk diff --git a/src/Distribution/Dev/InitPkgDb.hs b/src/Distribution/Dev/InitPkgDb.hs --- a/src/Distribution/Dev/InitPkgDb.hs +++ b/src/Distribution/Dev/InitPkgDb.hs @@ -42,11 +42,11 @@ s' = setVersion s typ ver pth = pkgConf s' - case typ of - GHC_6_12_Db -> do + if typ >= GHC_6_12_Db + then do e <- doesDirectoryExist pth unless e $ run v ghcPkg ["init", pth] - _ -> do + else do e <- doesFileExist pth unless e $ writeFile pth "[]" @@ -69,5 +69,6 @@ let typ | v < Version [6, 10] [] = GHC_6_8_Db $ locationPath $ programLocation p | v < Version [6, 12] [] = GHC_6_10_Db + | v >= Version [7, 5] [] = GHC_7_5_Plus_Db | otherwise = GHC_6_12_Db return (v, typ) diff --git a/src/Distribution/Dev/InvokeCabal.hs b/src/Distribution/Dev/InvokeCabal.hs --- a/src/Distribution/Dev/InvokeCabal.hs +++ b/src/Distribution/Dev/InvokeCabal.hs @@ -18,9 +18,8 @@ , runProgram , simpleProgram ) -import Distribution.Simple.Utils ( writeUTF8File, debug, cabalVersion - , readUTF8File ) -import Distribution.ParseUtils ( ParseResult(..), Field, readFields ) +import Distribution.Simple.Utils ( writeUTF8File, debug, cabalVersion) +import Distribution.ParseUtils ( Field ) import Distribution.Version ( Version(..) ) import System.Console.GetOpt ( OptDescr ) diff --git a/src/Distribution/Dev/RewriteCabalConfig.hs b/src/Distribution/Dev/RewriteCabalConfig.hs --- a/src/Distribution/Dev/RewriteCabalConfig.hs +++ b/src/Distribution/Dev/RewriteCabalConfig.hs @@ -9,6 +9,8 @@ 6.8 && < 6.13 with no other packages installed. -} +{-# LANGUAGE CPP #-} + module Distribution.Dev.RewriteCabalConfig ( rewriteCabalConfig , Rewrite(..) @@ -18,11 +20,12 @@ ) where -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 @@ -38,8 +41,10 @@ -- XXX: we should avoid this lazy IO that leaks a file handle. readConfigF :: FilePath -> IO (Either String [Field]) -readConfigF fn = - (readConfig <$> readUTF8File fn) `catch` \e -> return $ Left $ show e +readConfigF fn = (readConfig <$> readUTF8File fn) `Ex.catch` handler + where + handler :: Ex.IOException -> IO (Either String [Field]) + handler = return . Left . show readConfigF_ :: FilePath -> IO [Field] readConfigF_ fn = either error id <$> readConfigF fn @@ -72,8 +77,8 @@ F l name val -> F l name <$> rewriteLeaf name val Section l name key fs -> Section l name key <$> rewriteSection name fs - _ -> error $ "Only top-level fields and sections \ - \supported. Not: " ++ show field + _ -> error $ "Only top-level fields and sections " + ++ "supported. Not: " ++ show field where rewriteLeaf name val | name `elem` eLeaves expand = eExpand expand val diff --git a/src/Distribution/Dev/Sandbox.hs b/src/Distribution/Dev/Sandbox.hs --- a/src/Distribution/Dev/Sandbox.hs +++ b/src/Distribution/Dev/Sandbox.hs @@ -6,6 +6,8 @@ , UnknownVersion , cabalConf , getVersion + , indexCache + , indexCacheBase , indexTar , indexTarBase , localRepoPath @@ -17,6 +19,7 @@ ) where + import Control.Monad ( unless ) import Data.Version ( Version, showVersion ) import Distribution.Simple.Utils ( debug ) @@ -28,6 +31,7 @@ #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 @@ -45,7 +49,11 @@ UnknownVersion :: FilePath -> Sandbox UnknownVersion KnownVersion :: FilePath -> PackageDbType -> Version -> Sandbox KnownVersion -data PackageDbType = GHC_6_8_Db FilePath | GHC_6_10_Db | GHC_6_12_Db +data PackageDbType = GHC_6_8_Db FilePath + | GHC_6_10_Db + | GHC_6_12_Db + | GHC_7_5_Plus_Db + deriving (Eq, Ord, Show) -- NOTE: GHC < 6.12: compilation warnings about non-exhaustive pattern -- matches are spurious (we'd get a type error if we tried to make @@ -94,7 +102,10 @@ 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" @@ -112,6 +123,12 @@ newSandbox v relSandbox -- |The name of the cabal-install package index +indexCacheBase :: FilePath +indexCacheBase = "00-index.cache" + +indexCache :: Sandbox a -> FilePath +indexCache sb = localRepoPath sb indexCacheBase + indexTarBase :: FilePath indexTarBase = "00-index.tar" diff --git a/src/FakeGhc.hs b/src/FakeGhc.hs --- a/src/FakeGhc.hs +++ b/src/FakeGhc.hs @@ -9,8 +9,16 @@ import System.Environment ( getArgs ) import Distribution.Dev.GhcArgs ( formatGHCArgs ) +import System.Process ( readProcess ) -- |Take the command line arguments and format them in an -- easily-parsed way. main :: IO () -main = putStr . formatGHCArgs =<< getArgs +main = do + args <- getArgs + case args of + "--numeric-version":_ -> putStr =<< ghc + _ -> putStr (formatGHCArgs args) + where + ghc = readProcess "ghc" ["--numeric-version"] [] + diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -9,7 +9,10 @@ import Data.Version ( showVersion ) import Control.Monad ( unless ) import System.Exit ( exitWith, ExitCode(..) ) -import System.Environment ( getArgs, getProgName ) +import System.Environment ( getArgs, getProgName, getEnv ) +import System.IO.Error ( catchIOError ) +import System.SetEnv (setEnv) +import System.FilePath ((), searchPathSeparator) import System.Console.GetOpt ( usageInfo, getOpt, ArgOrder(Permute) ) import Distribution.Simple.Utils ( cabalVersion, debug ) import Distribution.Text ( display ) @@ -18,7 +21,7 @@ import Distribution.Dev.Command ( CommandActions(..), CommandResult(..) ) import Distribution.Dev.Flags ( parseGlobalFlags, helpRequested, globalOpts , GlobalFlag(Version), getOpt'', fromFlags - , getVerbosity, Config + , getVerbosity, Config, getSandbox ) import qualified Distribution.Dev.AddSource as AddSource import qualified Distribution.Dev.Ghci as Ghci @@ -100,12 +103,20 @@ putStr =<< globalUsage exitWith (ExitFailure 1) + let cfg = fromFlags globalFlags + + -- add sandbox bin dir to PATH, so that custom preprocessors that are + -- installed into the sandbox are found + let binDir = getSandbox cfg "bin" + mPath <- maybeGetEnv "PATH" + let path = maybe binDir ((binDir ++ [searchPathSeparator]) ++) mPath + setEnv "PATH" path + case [f|(Version f) <- globalFlags] of (True:_) -> printNumericVersion (False:_) -> printVersion [] -> return () - let cfg = fromFlags globalFlags debug (getVerbosity cfg) versionString case args of @@ -258,3 +269,10 @@ -- Other kinds of splits are not as bad as splitting -- between words, but are still pretty harmful. | otherwise = w + +-- Return the value of the environment variable with the given name +-- or Nothing if the variable is not defined. +-- Probably should be replaced with System.Environment.lookupEnv +-- when the base library is upgraded >= 4.6 +maybeGetEnv :: String -> IO (Maybe String) +maybeGetEnv name = (Just `fmap` getEnv name) `catchIOError` const (return Nothing) diff --git a/test/RunTests.hs b/test/RunTests.hs --- a/test/RunTests.hs +++ b/test/RunTests.hs @@ -33,10 +33,10 @@ import System.IO ( withBinaryFile, IOMode(ReadMode) ) import System.Cmd ( rawSystem ) import System.Process ( readProcessWithExitCode ) -import System.Directory ( getTemporaryDirectory, createDirectory ) +import System.Directory ( getTemporaryDirectory, createDirectory, doesFileExist, removeFile ) import System.Environment ( getArgs ) import System.Exit ( ExitCode(ExitSuccess) ) -import System.FilePath ( (), (<.>), takeExtension ) +import System.FilePath ( (), (<.>), takeExtension, replaceExtension ) import System.Random ( RandomGen ) import Test.Framework ( defaultMainWithArgs, Test, testGroup ) import Test.Framework.Providers.HUnit ( testCase )