Cabal 1.2.3.0 → 1.2.4.0
raw patch · 14 files changed
+117/−58 lines, 14 filessetup-changednew-uploader
Files
- Cabal.cabal +2/−2
- Distribution/GetOpt.hs +3/−2
- Distribution/PackageDescription.hs +8/−4
- Distribution/ParseUtils.hs +9/−5
- Distribution/Simple/Configure.hs +8/−2
- Distribution/Simple/GHC.hs +1/−0
- Distribution/Simple/Haddock.hs +20/−16
- Distribution/Simple/InstallDirs.hs +4/−3
- Distribution/Simple/SetupWrapper.hs +1/−1
- Distribution/Simple/SrcDist.hs +9/−4
- Distribution/Simple/Utils.hs +40/−10
- Distribution/Verbosity.hs +2/−1
- Setup.hs +10/−0
- Setup.lhs +0/−8
Cabal.cabal view
@@ -1,5 +1,5 @@ Name: Cabal-Version: 1.2.3.0+Version: 1.2.4.0 Copyright: 2003-2006, Isaac Jones License: BSD3 License-File: LICENSE@@ -37,7 +37,7 @@ Build-Depends: unix GHC-Options: -Wall- CPP-Options: "-DCABAL_VERSION=1,2,3,0"+ CPP-Options: "-DCABAL_VERSION=1,2,4,0" nhc98-Options: -K4M Exposed-Modules:
Distribution/GetOpt.hs view
@@ -51,7 +51,7 @@ -- $example ) where -import Data.List ( isPrefixOf, intersperse )+import Data.List ( isPrefixOf, intersperse, find ) -- |What to do with options following non-options data ArgOrder a@@ -201,7 +201,8 @@ longOpt :: String -> [String] -> [OptDescr a] -> (OptKind a,[String]) longOpt ls rs optDescr = long ads arg rs where (opt,arg) = break (=='=') ls- getWith p = [ o | o@(Option _ xs _ _) <- optDescr, x <- xs, opt `p` x ]+ getWith p = [ o | o@(Option _ xs _ _) <- optDescr+ , find (p opt) xs /= Nothing] exact = getWith (==) options = if null exact then getWith isPrefixOf else exact ads = [ ad | Option _ _ ad _ <- options ]
Distribution/PackageDescription.hs view
@@ -124,7 +124,7 @@ import Language.Haskell.Extension(Extension(..)) import Distribution.Compat.ReadP as ReadP hiding (get)-import System.FilePath((<.>))+import System.FilePath((<.>), takeExtension) import Data.Monoid @@ -1304,11 +1304,15 @@ sanityCheckExe :: Executable -> Maybe String sanityCheckExe exe- = if null (modulePath exe)- then Just ("No 'Main-Is' field found for executable " ++ exeName exe+ | null (modulePath exe)+ = Just ("No 'Main-Is' field found for executable " ++ exeName exe ++ "Fields of the executable section:\n" ++ (render $ nest 4 $ ppFields exe executableFieldDescrs))- else Nothing+ | ext `notElem` [".hs", ".lhs"]+ = Just ("The 'Main-Is' field must specify a '.hs' or '.lhs' file\n"+ ++" (even if it is generated by a preprocessor).")+ | otherwise = Nothing+ where ext = takeExtension (modulePath exe) checkSanity :: Bool -> String -> Maybe String checkSanity = toMaybe
Distribution/ParseUtils.hs view
@@ -121,8 +121,8 @@ where results = readP_to_S p s locatedErrorMsg :: PError -> (Maybe LineNo, String)-locatedErrorMsg (AmbigousParse f n) = (Just n, "Ambiguous parse in field '"++f++"'")-locatedErrorMsg (NoParse f n) = (Just n, "Parse of field '"++f++"' failed: ")+locatedErrorMsg (AmbigousParse f n) = (Just n, "Ambiguous parse in field '"++f++"'.")+locatedErrorMsg (NoParse f n) = (Just n, "Parse of field '"++f++"' failed.") locatedErrorMsg (TabsError n) = (Just n, "Tab used as indentation.") locatedErrorMsg (FromString s n) = (n, s) @@ -171,14 +171,18 @@ commaListField :: String -> (a -> Doc) -> (ReadP [a] a) -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b commaListField name showF readF get set = - liftField get set $ + liftField get set' $ field name (fsep . punctuate comma . map showF) (parseCommaList readF)+ where+ set' xs b = set (get b ++ xs) b listField :: String -> (a -> Doc) -> (ReadP [a] a) -> (b -> [a]) -> ([a] -> b -> b) -> FieldDescr b listField name showF readF get set = - liftField get set $ + liftField get set' $ field name (fsep . map showF) (parseOptCommaList readF)+ where+ set' xs b = set (get b ++ xs) b optsField :: String -> CompilerFlavor -> (b -> [(CompilerFlavor,[String])]) -> ([(CompilerFlavor,[String])] -> b -> b) -> FieldDescr b optsField name flavor get set = @@ -189,7 +193,7 @@ where update f opts [] = [(f,opts)] update f opts ((f',opts'):rest)- | f == f' = (f, opts ++ opts') : rest+ | f == f' = (f, opts' ++ opts) : rest | otherwise = (f',opts') : update f opts rest ------------------------------------------------------------------------------
Distribution/Simple/Configure.hs view
@@ -130,7 +130,7 @@ import qualified System.Info ( os, arch ) import System.IO- ( hPutStrLn, stderr )+ ( hPutStrLn, stderr, hGetContents, openFile, hClose, IOMode(ReadMode) ) import Text.PrettyPrint.HughesPJ ( comma, punctuate, render, nest, sep ) @@ -146,10 +146,16 @@ let dieMsg = "error reading " ++ filename ++ "; run \"setup configure\" command?\n" if (not e) then return $ Left dieMsg else do - str <- readFile filename+ str <- readFileStrict filename case reads str of [(bi,_)] -> return $ Right bi _ -> return $ Left dieMsg+ where+ readFileStrict name = do+ h <- openFile name ReadMode+ str <- hGetContents h >>= \str -> length str `seq` return str+ hClose h+ return str -- internal function tryGetPersistBuildConfig :: IO (Either String LocalBuildInfo)
Distribution/Simple/GHC.hs view
@@ -497,6 +497,7 @@ ++ ldOptions exeBi ++ ["-l"++lib | lib <- extraLibs exeBi] ++ ["-L"++libDir | libDir <- extraLibDirs exeBi]+ ++ concat [["-framework", f] | f <- frameworks exeBi] ++ if profExe then ["-prof", "-hisuf", "p_hi",
Distribution/Simple/Haddock.hs view
@@ -122,7 +122,7 @@ then "--hoogle" else "--html" let Just version = programVersion confHaddock- let have_src_hyperlink_flags = version >= Version [0,8] [] && version < Version [2,0] []+ let have_src_hyperlink_flags = version >= Version [0,8] [] isVersion2 = version >= Version [2,0] [] let mockFlags@@ -308,7 +308,7 @@ hscolour :: PackageDescription -> LocalBuildInfo -> [PPSuffixHandler] -> HscolourFlags -> IO () hscolour pkg_descr lbi suffixes (HscolourFlags stylesheet doExes verbosity) = do- (confHscolour, _) <- requireProgram verbosity hscolourProgram+ (hscolourProg, _) <- requireProgram verbosity hscolourProgram (orLaterVersion (Version [1,8] [])) (withPrograms lbi) createDirectoryIfMissingVerbose verbosity True $ hscolourPref pkg_descr@@ -319,31 +319,35 @@ withLib pkg_descr () $ \lib -> when (isJust $ library pkg_descr) $ do let bi = libBuildInfo lib- let modules = exposedModules lib ++ otherModules bi+ modules = exposedModules lib ++ otherModules bi+ outputDir = hscolourPref pkg_descr </> "src"+ createDirectoryIfMissingVerbose verbosity True outputDir+ copyCSS hscolourProg outputDir inFiles <- getModulePaths lbi bi modules- flip mapM_ (zip modules inFiles) $ \(mo, inFile) -> do- let outputDir = hscolourPref pkg_descr </> "src"+ flip mapM_ (zip modules inFiles) $ \(mo, inFile) -> let outFile = outputDir </> replaceDot mo <.> "html"- createDirectoryIfMissingVerbose verbosity True outputDir- copyCSS outputDir- rawSystemProgram verbosity confHscolour+ in rawSystemProgram verbosity hscolourProg ["-css", "-anchor", "-o" ++ outFile, inFile] withExe pkg_descr $ \exe -> when doExes $ do let bi = buildInfo exe- let modules = "Main" : otherModules bi- let outputDir = hscolourPref pkg_descr </> exeName exe </> "src"+ modules = "Main" : otherModules bi+ outputDir = hscolourPref pkg_descr </> exeName exe </> "src" createDirectoryIfMissingVerbose verbosity True outputDir- copyCSS outputDir+ copyCSS hscolourProg outputDir srcMainPath <- findFile (hsSourceDirs bi) (modulePath exe) inFiles <- liftM (srcMainPath :) $ getModulePaths lbi bi (otherModules bi)- flip mapM_ (zip modules inFiles) $ \(mo, inFile) -> do+ flip mapM_ (zip modules inFiles) $ \(mo, inFile) -> let outFile = outputDir </> replaceDot mo <.> "html"- rawSystemProgram verbosity confHscolour+ in rawSystemProgram verbosity hscolourProg ["-css", "-anchor", "-o" ++ outFile, inFile]- where copyCSS dir = case stylesheet of- Nothing -> return ()- Just s -> copyFile s (dir </> "hscolour.css")++ where copyCSS hscolourProg dir = case stylesheet of+ Nothing | programVersion hscolourProg >= Just (Version [1,9] []) ->+ rawSystemProgram verbosity hscolourProg+ ["-print-css", "-o" ++ dir </> "hscolour.css"]+ | otherwise -> return ()+ Just s -> copyFile s (dir </> "hscolour.css") --TODO: where to put this? it's duplicated in .Simple too
Distribution/Simple/InstallDirs.hs view
@@ -311,7 +311,7 @@ } where -- substitute the path template into each other, except that we map- -- $prefix back to $prefix. We're trying to end up with templates that+ -- \$prefix back to $prefix. We're trying to end up with templates that -- mention no vars except $prefix. dirs' = substituteTemplates pkgId compilerId dirs { prefixDirTemplate = PathTemplate [Variable PrefixVar]@@ -483,9 +483,10 @@ long_path_size = 1024 # endif -csidl_PROGRAM_FILES, csidl_PROGRAM_FILES_COMMON :: CInt+csidl_PROGRAM_FILES :: CInt csidl_PROGRAM_FILES = 0x0026-csidl_PROGRAM_FILES_COMMON = 0x002b+-- csidl_PROGRAM_FILES_COMMON :: CInt+-- csidl_PROGRAM_FILES_COMMON = 0x002b foreign import stdcall unsafe "shlobj.h SHGetFolderPathA" c_SHGetFolderPath :: Ptr ()
Distribution/Simple/SetupWrapper.hs view
@@ -24,7 +24,7 @@ import Distribution.Simple.Setup ( reqPathArg ) import Distribution.PackageDescription ( readPackageDescription,- packageDescription,+ GenericPackageDescription(packageDescription), PackageDescription(..), BuildType(..), cabalVersion ) import Distribution.Simple.LocalBuildInfo ( distPref )
Distribution/Simple/SrcDist.hs view
@@ -64,7 +64,8 @@ import Distribution.Version (Version(versionBranch), VersionRange(AnyVersion)) import Distribution.Simple.Utils (createDirectoryIfMissingVerbose, smartCopySources, die, warn, notice,- findPackageDesc, findFile, copyFileVerbose)+ findPackageDesc, findFile, findFileWithExtension,+ copyFileVerbose) import Distribution.Simple.Setup (SDistFlags(..)) import Distribution.Simple.PreProcess (PPSuffixHandler, ppSuffixes, preprocessSources) import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )@@ -81,7 +82,7 @@ import Distribution.Compat.Directory (doesFileExist, doesDirectoryExist, getCurrentDirectory, removeDirectoryRecursive) import Distribution.Verbosity-import System.FilePath ((</>), takeDirectory, isAbsolute)+import System.FilePath ((</>), takeDirectory, isAbsolute, dropExtension) #ifdef DEBUG import Test.HUnit (Test)@@ -138,7 +139,11 @@ -- move the executables into place withExe pkg_descr $ \ (Executable _ mainPath exeBi) -> do prepareDir verbosity targetDir pps [] exeBi- srcMainFile <- findFile (hsSourceDirs exeBi) mainPath+ srcMainFile <- do+ ppFile <- findFileWithExtension (ppSuffixes pps) (hsSourceDirs exeBi) (dropExtension mainPath)+ case ppFile of+ Nothing -> findFile (hsSourceDirs exeBi) mainPath+ Just pp -> return pp copyFileTo verbosity targetDir srcMainFile flip mapM_ (dataFiles pkg_descr) $ \ file -> do let dir = takeDirectory file@@ -173,7 +178,7 @@ else if lhsExists then copyFileTo verbosity targetDir "Setup.lhs" else writeFile (targetDir </> "Setup.hs") $ unlines [ "import Distribution.Simple",- "main = defaultMainWithHooks defaultUserHooks"]+ "main = defaultMain"] -- the description file itself descFile <- getCurrentDirectory >>= findPackageDesc verbosity let targetDescFile = targetDir </> descFile
Distribution/Simple/Utils.hs view
@@ -66,6 +66,8 @@ currentDir, dotToSep, findFile,+ findFileWithExtension,+ findFileWithExtension', defaultPackageDesc, findPackageDesc, defaultHookedPackageDesc,@@ -107,7 +109,7 @@ import Distribution.Compat.Directory ( copyFile, findExecutable, createDirectoryIfMissing- , getDirectoryContentsWithoutSpecial)+ , getDirectoryContentsWithoutSpecial, getTemporaryDirectory ) import Distribution.Compat.RawSystem ( rawSystem ) import Distribution.Compat.Exception@@ -235,6 +237,7 @@ rawSystemExit :: Verbosity -> FilePath -> [String] -> IO () rawSystemExit verbosity path args = do printRawCommandAndArgs verbosity path args+ hFlush stdout maybeExit $ rawSystem path args -- Exit with the same exitcode if the subcommand fails@@ -255,6 +258,7 @@ rawSystemStdout' :: Verbosity -> FilePath -> [String] -> IO (String, ExitCode) rawSystemStdout' verbosity path args = do printRawCommandAndArgs verbosity path args+ tmpDir <- getTemporaryDirectory #if __GLASGOW_HASKELL__ >= 604 -- TODO Ideally we'd use runInteractiveProcess and not have to make any@@ -263,7 +267,7 @@ -- connect to all three since then we'd need threads to pull on stdout -- and stderr simultaniously to avoid deadlock, and using threads like -- that would not be portable to Hugs for example.- bracket (liftM2 (,) (openTempFile "." "tmp") (openFile devNull WriteMode))+ bracket (liftM2 (,) (openTempFile tmpDir "cmdstdout") (openFile devNull WriteMode)) -- We need to close tmpHandle or the file removal fails on Windows (\((tmpName, tmpHandle), nullHandle) -> do hClose tmpHandle@@ -277,7 +281,7 @@ evaluate (length output) return (output, exitCode) #else- withTempFile "." "" $ \tmpName -> do+ withTempFile tmpDir "cmdstdout" $ \tmpName -> do let quote name = "'" ++ name ++ "'" exitCode <- system $ unwords (map quote (path:args)) ++ " >" ++ quote tmpName output <- readFile tmpName@@ -357,13 +361,39 @@ findFile :: [FilePath] -- ^search locations -> FilePath -- ^File Name -> IO FilePath-findFile prefPathsIn locPath = do- let prefPaths = nub prefPathsIn -- ignore dups- paths <- filterM doesFileExist [prefPath </> locPath | prefPath <- prefPaths]- case nub paths of -- also ignore dups, though above nub should fix this.- [path] -> return path- [] -> die (locPath ++ " doesn't exist")- paths' -> die (locPath ++ " is found in multiple places:" ++ unlines (map ((++) " ") paths'))+findFile searchPath fileName =+ findFirstFile id+ [ path </> fileName+ | path <- nub searchPath]+ >>= maybe (die $ fileName ++ " doesn't exist") return++findFileWithExtension :: [String]+ -> [FilePath]+ -> FilePath+ -> IO (Maybe FilePath)+findFileWithExtension extensions searchPath baseName =+ findFirstFile id+ [ path </> baseName <.> ext+ | path <- nub searchPath+ , ext <- nub extensions ]++findFileWithExtension' :: [String]+ -> [FilePath]+ -> FilePath+ -> IO (Maybe (FilePath, FilePath))+findFileWithExtension' extensions searchPath baseName =+ findFirstFile (uncurry (</>))+ [ (path, baseName <.> ext)+ | path <- nub searchPath+ , ext <- nub extensions ]++findFirstFile :: (a -> FilePath) -> [a] -> IO (Maybe a)+findFirstFile file = findFirst+ where findFirst [] = return Nothing+ findFirst (x:xs) = do exists <- doesFileExist (file x)+ if exists+ then return (Just x)+ else findFirst xs dotToSep :: String -> String dotToSep = map dts
Distribution/Verbosity.hs view
@@ -98,7 +98,8 @@ [(i, "")] -> case intToVerbosity i of Just v -> v- Nothing -> error ("Bad verbosity " ++ show i)+ Nothing -> error ("Bad verbosity: " ++ show i +++ ". Valid values are 0..3") _ -> error ("Can't parse verbosity " ++ s) showForCabal, showForGHC :: Verbosity -> String
+ Setup.hs view
@@ -0,0 +1,10 @@+import Distribution.Simple+main :: IO ()+main = defaultMain++-- Although this looks like the Simple build type, it is in fact vital that+-- we use this Setup.hs because it'll get compiled against the local copy+-- of the Cabal lib, thus enabling Cabal to bootstrap itself without relying+-- on any previous installation. This also means we can use any new features+-- immediately because we never have to worry about building Cabal with an+-- older version of itself.
− Setup.lhs
@@ -1,8 +0,0 @@-#!/usr/bin/runhaskell--> module Main (main) where->-> import Distribution.Simple->-> main :: IO ()-> main = defaultMain