Cabal 1.8.0.2 → 1.8.0.4
raw patch · 23 files changed
+544/−165 lines, 23 filesdep ~unixPVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
Dependency ranges changed: unix
API changes (from Hackage documentation)
+ Distribution.Simple.Hugs: getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration -> IO PackageIndex
+ Distribution.Simple.NHC: getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration -> IO PackageIndex
Files
- Cabal.cabal +4/−4
- Distribution/Compat/Exception.hs +1/−1
- Distribution/Compat/ReadP.hs +2/−1
- Distribution/Compat/TempFile.hs +1/−0
- Distribution/ModuleName.hs +1/−1
- Distribution/PackageDescription/Check.hs +11/−9
- Distribution/PackageDescription/Configuration.hs +6/−25
- Distribution/ParseUtils.hs +1/−1
- Distribution/Simple/Build.hs +16/−5
- Distribution/Simple/Build/Macros.hs +2/−2
- Distribution/Simple/Build/PathsModule.hs +1/−0
- Distribution/Simple/Command.hs +4/−4
- Distribution/Simple/Configure.hs +13/−14
- Distribution/Simple/GHC.hs +37/−16
- Distribution/Simple/Hugs.hs +178/−14
- Distribution/Simple/InstallDirs.hs +4/−7
- Distribution/Simple/LHC.hs +1/−1
- Distribution/Simple/NHC.hs +140/−9
- Distribution/Simple/PackageIndex.hs +1/−1
- Distribution/Simple/PreProcess.hs +19/−23
- Distribution/Simple/Register.hs +89/−24
- Distribution/Simple/Utils.hs +3/−3
- changelog +9/−0
Cabal.cabal view
@@ -1,5 +1,5 @@ Name: Cabal-Version: 1.8.0.2+Version: 1.8.0.4 Copyright: 2003-2006, Isaac Jones 2005-2009, Duncan Coutts License: BSD3@@ -32,7 +32,7 @@ source-repository this type: darcs location: http://darcs.haskell.org/cabal-branches/cabal-1.8/- tag: 1.8.0.2+ tag: 1.8.0.4 Flag base4 Description: Choose the even newer, even smaller, split-up base package.@@ -54,12 +54,12 @@ pretty >= 1 && < 1.1 if !os(windows)- Build-Depends: unix >= 2.1 && < 2.5+ Build-Depends: unix >= 2.0 && < 2.5 ghc-options: -Wall -fno-ignore-asserts if impl(ghc >= 6.8) ghc-options: -fwarn-tabs- cpp-options: "-DCABAL_VERSION=1,8,0,2"+ cpp-options: "-DCABAL_VERSION=1,8,0,4" nhc98-Options: -K4M Exposed-Modules:
Distribution/Compat/Exception.hs view
@@ -5,7 +5,7 @@ {-# OPTIONS_NHC98 -cpp #-} {-# OPTIONS_JHC -fcpp #-} -#if !defined(__GLASGOW_HASKELL__) || (__GLASGOW_HASKELL__ >= 609)+#if !(defined(__HUGS__) || (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 610)) #define NEW_EXCEPTION #endif
Distribution/Compat/ReadP.hs view
@@ -248,7 +248,8 @@ -- ^ Parses the first one or more characters satisfying the predicate. munch1 p = do c <- get- if p c then do s <- munch p; return (c:s) else pfail+ if p c then do s <- munch p; return (c:s)+ else pfail choice :: [ReadP r a] -> ReadP r a -- ^ Combines all parsers in the specified list.
Distribution/Compat/TempFile.hs view
@@ -21,6 +21,7 @@ Handle, IOMode(ReadWriteMode)) import System.Directory (doesFileExist) import System.FilePath ((<.>), splitExtension)+import System.IO.Error (try, isAlreadyExistsError) #else import System.IO (Handle, openTempFile, openBinaryTempFile) import Data.Bits ((.|.))
Distribution/ModuleName.hs view
@@ -88,7 +88,7 @@ -- XXX This is used in Distribution/Simple/PreProcess.hs, so we can't -- deprecate it yet without getting warnings, and thus build failures--- {-# DEPRECATED simple "use ModuleName.fromString instead" #-}+{-# DEPRECATED simple "use ModuleName.fromString instead" #-} simple :: String -> ModuleName simple str = ModuleName [str]
Distribution/PackageDescription/Check.hs view
@@ -443,19 +443,21 @@ "'ghc-options: -d*' debug flags are not appropriate for a distributed package." , checkFlags ["-prof"] $- PackageDistInexcusable $- "'ghc-options: -prof' is not needed. Use the --enable-library-profiling configure flag."+ PackageBuildWarning $+ "'ghc-options: -prof' is not necessary and will lead to problems "+ ++ "when used on a library. Use the configure flag "+ ++ "--enable-library-profiling and/or --enable-executable-profiling." , checkFlags ["-o"] $- PackageDistInexcusable $- "'ghc-options: -o' is not allowed. The output files are named automatically."+ PackageBuildWarning $+ "'ghc-options: -o' is not needed. The output files are named automatically." , checkFlags ["-hide-package"] $- PackageDistInexcusable $+ PackageBuildWarning $ "'ghc-options: -hide-package' is never needed. Cabal hides all packages." , checkFlags ["--make"] $- PackageDistInexcusable $+ PackageBuildWarning $ "'ghc-options: --make' is never needed. Cabal uses this automatically." , checkFlags ["-main-is"] $@@ -477,7 +479,7 @@ ++ "and not just imposing longer compile times on your users." , checkFlags ["-split-objs"] $- PackageDistInexcusable $+ PackageBuildWarning $ "'ghc-options: -split-objs' is not needed. Use the --enable-split-objs configure flag." , checkFlags ["-optl-Wl,-s", "-optl-s"] $@@ -756,7 +758,7 @@ requiresAtLeast = case cabalVersionIntervals of (LowerBound ver' _,_):_ -> (ver' >=) _ -> const False- where cabalVersionIntervals = asVersionIntervals (descCabalVersion pkg)+ where cabalVersionIntervals = asVersionIntervals (descCabalVersion pkg) dataFilesUsingGlobSyntax = filter usesGlobSyntax (dataFiles pkg) extraSrcFilesUsingGlobSyntax = filter usesGlobSyntax (extraSrcFiles pkg)@@ -1067,7 +1069,7 @@ Left err -> Just err Right [] -> Nothing Right (_:_) -> Just noSplit- where+ where -- drop the '/' between the name and prefix: remainder = init first : rest
Distribution/PackageDescription/Configuration.hs view
@@ -65,9 +65,7 @@ , Flag(..), FlagName(..), FlagAssignment , CondTree(..), ConfVar(..), Condition(..) ) import Distribution.Version- ( VersionRange, anyVersion, intersectVersionRanges, withinRange- , toVersionIntervals, intersectVersionIntervals- , fromVersionIntervals )+ ( VersionRange, anyVersion, intersectVersionRanges, withinRange ) import Distribution.Compiler ( CompilerId(CompilerId) ) import Distribution.System@@ -81,7 +79,6 @@ import Control.Arrow (first) import qualified Distribution.Compat.ReadP as ReadP ( char ) -import Control.Exception (assert) import Data.Char ( isAlphaNum ) import Data.Maybe ( catMaybes, maybeToList ) import Data.Map ( Map, fromListWith, toList )@@ -489,29 +486,13 @@ Right ((mlib, exes'), targetSet, flagVals) -> Right ( pkg { library = mlib , executables = exes'- , buildDepends = assert sanity overallDeps+ , buildDepends = fromDepMap (overallDependencies targetSet)+ --TODO: we need to find a way to avoid pulling in deps+ -- for non-buildable components. However cannot simply+ -- filter at this stage, since if the package were not+ -- available we would have failed already. } , flagVals )- where- -- Note that we exclude non-buildable components. This means your tools and- -- test progs to not contribute to the overall package dependencies.- --- overallDeps = canonicalise- . concatMap targetBuildDepends- . filter buildable- $ buildInfos- buildInfos = map libBuildInfo (maybeToList mlib) ++ map buildInfo exes'-- -- as a sanity check, check that the overall deps from the target set- -- matches those from the (unfiltered for being buildable) components- sanity = canonicalise overallDeps' == canonicalise overallDeps''- overallDeps' = concatMap targetBuildDepends buildInfos- overallDeps'' = fromDepMap (overallDependencies targetSet)- canonicalise =- map (\(name, vi) -> Dependency name (fromVersionIntervals vi))- . Map.toList- . Map.fromListWith intersectVersionIntervals- . map (\(Dependency name vr) -> (name, toVersionIntervals vr)) Left missing -> Left missing where
Distribution/ParseUtils.hs view
@@ -515,7 +515,7 @@ (fieldValue rest' followingLines) rest' -> do ts' <- mapM (mkField (d+1)) ts return (Section n (map toLower name) rest' ts')- where fieldValue firstLine followingLines =+ where fieldValue firstLine followingLines = let firstLine' = trimLeading firstLine followingLines' = map (\(_,_,s) -> stripDot s) followingLines allLines | null firstLine' = followingLines'
Distribution/Simple/Build.hs view
@@ -62,12 +62,13 @@ import qualified Distribution.Simple.Build.PathsModule as Build.PathsModule import Distribution.Package- ( Package(..) )+ ( Package(..), PackageId, InstalledPackageId(..) ) import Distribution.Simple.Compiler ( CompilerFlavor(..), compilerFlavor, PackageDB(..) ) import Distribution.PackageDescription ( PackageDescription(..), BuildInfo(..) , Library(..), Executable(..) )+import qualified Distribution.InstalledPackageInfo as IPI import qualified Distribution.ModuleName as ModuleName import Distribution.Simple.Setup@@ -80,7 +81,7 @@ import Distribution.Simple.BuildPaths ( autogenModulesDir, autogenModuleName, cppHeaderName ) import Distribution.Simple.Register- ( registerPackage, generateRegistrationInfo )+ ( registerPackage, inplaceInstalledPackageInfo ) import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose, rewriteFile , die, info, setupMessage )@@ -96,6 +97,8 @@ ( unless ) import System.FilePath ( (</>), (<.>) )+import System.Directory+ ( getCurrentDirectory ) -- ----------------------------------------------------------------------------- -- |Build the libraries and executables in this package.@@ -117,11 +120,15 @@ info verbosity "Building library..." buildLib verbosity pkg_descr lbi lib clbi - installedPkgInfo <- generateRegistrationInfo verbosity pkg_descr lib- lbi clbi True{-inplace-} distPref- -- Register the library in-place, so exes can depend -- on internally defined libraries.+ pwd <- getCurrentDirectory+ let installedPkgInfo =+ (inplaceInstalledPackageInfo pwd distPref pkg_descr lib lbi clbi) {+ -- The inplace registration uses the "-inplace" suffix,+ -- not an ABI hash.+ IPI.installedPackageId = inplacePackageId (packageId installedPkgInfo)+ } registerPackage verbosity installedPkgInfo pkg_descr lbi True{-inplace-} internalPackageDB @@ -131,6 +138,10 @@ withExeLBI pkg_descr lbi' $ \exe clbi -> do info verbosity $ "Building executable " ++ exeName exe ++ "..." buildExe verbosity pkg_descr lbi' exe clbi++-- Quick hack in 1.8 branch, it's done properly in HEAD+inplacePackageId :: PackageId -> InstalledPackageId+inplacePackageId pkgid = InstalledPackageId (display pkgid ++ "-inplace") -- | Initialize a new package db file for libraries defined -- internally to the package.
Distribution/Simple/Build/Macros.hs view
@@ -40,10 +40,10 @@ "/* DO NOT EDIT: This file is automatically generated by Cabal */\n\n" : [ concat ["/* package ",display pkgid," */\n"- ,"#define MIN_VERSION_",pkgname,"(major1,major2,minor) \\\n"+ ,"#define MIN_VERSION_",pkgname,"(major1,major2,minor) (\\\n" ," (major1) < ",major1," || \\\n" ," (major1) == ",major1," && (major2) < ",major2," || \\\n"- ," (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor+ ," (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor,")" ,"\n\n" ] | (_, pkgid@(PackageIdentifier name version)) <- externalPackageDeps lbi
Distribution/Simple/Build/PathsModule.hs view
@@ -151,6 +151,7 @@ absolute = hasLibs pkg_descr -- we can only make progs relocatable || isNothing flat_bindirrel -- if the bin dir is an absolute path+ || (isHugs && isNothing flat_progdirrel) || not (supportsRelocatableProgs (compilerFlavor (compiler lbi))) supportsRelocatableProgs Hugs = True
Distribution/Simple/Command.hs view
@@ -382,7 +382,7 @@ commonFlags showOrParseArgs = case showOrParseArgs of ShowArgs -> [help] ParseArgs -> [help, list]- where+ where help = GetOpt.Option helpShortFlags ["help"] (GetOpt.NoArg HelpFlag) "Show this help text" helpShortFlags = case showOrParseArgs of@@ -475,9 +475,9 @@ [Command _ _ action] -> CommandReadyToGo (flags, action cmdArgs) _ -> CommandReadyToGo (flags, badCommand name) [] -> CommandReadyToGo (flags, noCommand)- where flags = mkflags (commandDefaultFlags globalCommand)+ where flags = mkflags (commandDefaultFlags globalCommand) - where+ where lookupCommand cname = [ cmd | cmd@(Command cname' _ _) <- commands' , cname'==cname ] noCommand = CommandErrors ["no command given (try --help)\n"]@@ -521,7 +521,7 @@ _ -> CommandHelp globalHelp _ -> badCommand name - where globalHelp = commandHelp globalCommand'+ where globalHelp = commandHelp globalCommand' helpCommandUI = (makeCommand "help" "Help about commands" Nothing () (const [])) { commandUsage = \pname ->
Distribution/Simple/Configure.hs view
@@ -364,16 +364,7 @@ (\xs -> ([ x | Left x <- xs ], [ x | Right x <- xs ])) . map (selectDependency internalPackageSet installedPackageSet) - (failedDeps, allPkgDeps) = case flavor of- GHC -> selectDependencies (buildDepends pkg_descr)- JHC -> selectDependencies (buildDepends pkg_descr)- LHC -> selectDependencies (buildDepends pkg_descr)- _ -> ([], bogusSelection)- where- bogusSelection :: [ResolvedDependency]- bogusSelection = zipWith ExternalDependency- (buildDepends pkg_descr)- bogusDependencies+ (failedDeps, allPkgDeps) = selectDependencies (buildDepends pkg_descr) internalPkgDeps = [ pkgid | InternalDependency _ pkgid <- allPkgDeps ] externalPkgDeps = [ pkg | ExternalDependency _ pkg <- allPkgDeps ]@@ -428,9 +419,11 @@ -- check extensions let extlist = nub $ concatMap extensions (allBuildInfo pkg_descr) let exts = unsupportedExtensions comp extlist- unless (null exts) $ warn verbosity $ -- Just warn, FIXME: Should this be an error?- display flavor ++ " does not support the following extensions: " ++- intercalate ", " (map display exts)+ when (not (null exts)) $+ die $ "The package " ++ display (packageId pkg_descr0)+ ++ " requires the following language extensions which are not "+ ++ "supported by " ++ display (compilerId comp) ++ ": "+ ++ intercalate ", " (map display exts) let requiredBuildTools = concatMap buildTools (allBuildInfo pkg_descr) programsConfig'' <-@@ -462,7 +455,7 @@ if newPackageDepsBehaviour pkg_descr' then [ (installedPackageId pkg, packageId pkg) | pkg <- selectSubset bi externalPkgDeps ]- ++ [ (InstalledPackageId (display pkgid), pkgid)+ ++ [ (inplacePackageId pkgid, pkgid) | pkgid <- selectSubset bi internalPkgDeps ] else [ (installedPackageId pkg, packageId pkg) | pkg <- externalPkgDeps ]@@ -538,6 +531,10 @@ in pkg_descr{ library = modifyLib `fmap` library pkg_descr , executables = modifyExecutable `map` executables pkg_descr} +-- Quick hack in 1.8 branch, it's done properly in HEAD+inplacePackageId :: PackageId -> InstalledPackageId+inplacePackageId pkgid = InstalledPackageId (display pkgid ++ "-inplace")+ -- ----------------------------------------------------------------------------- -- Configuring package dependencies @@ -638,8 +635,10 @@ info verbosity "Reading installed packages..." case compilerFlavor comp of GHC -> Just `fmap` GHC.getInstalledPackages verbosity packageDBs progconf+ Hugs-> Just `fmap`Hugs.getInstalledPackages verbosity packageDBs progconf JHC -> Just `fmap` JHC.getInstalledPackages verbosity packageDBs progconf LHC -> Just `fmap` LHC.getInstalledPackages verbosity packageDBs progconf+ NHC -> Just `fmap` NHC.getInstalledPackages verbosity packageDBs progconf _ -> return Nothing -- | Currently the user interface specifies the package dbs to use with just a
Distribution/Simple/GHC.hs view
@@ -83,8 +83,9 @@ import Distribution.Simple.PackageIndex (PackageIndex) import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Simple.LocalBuildInfo- ( LocalBuildInfo(..), ComponentLocalBuildInfo(..) )-import Distribution.Simple.InstallDirs+ ( LocalBuildInfo(..), ComponentLocalBuildInfo(..),+ absoluteInstallDirs )+import Distribution.Simple.InstallDirs hiding ( absoluteInstallDirs ) import Distribution.Simple.BuildPaths import Distribution.Simple.Utils import Distribution.Package@@ -115,6 +116,7 @@ import Language.Haskell.Extension (Extension(..)) import Control.Monad ( unless, when )+import Data.Char ( isSpace ) import Data.List import Data.Maybe ( catMaybes ) import Data.Monoid ( Monoid(..) )@@ -200,21 +202,29 @@ configureToolchain ghcProg = addKnownProgram gccProgram { programFindLocation = findProg gccProgram- [ baseDir </> "gcc.exe",- mingwDir </> "bin" </> "gcc.exe" ],+ [ if ghcVersion >= Version [6,12] []+ then mingwBinDir </> "gcc.exe"+ else baseDir </> "gcc.exe" ], programPostConf = configureGcc } . addKnownProgram ldProgram { programFindLocation = findProg ldProgram- [ libDir </> "ld.exe",- mingwDir </> "mingw32" </> "bin" </> "ld.exe" ],+ [ if ghcVersion >= Version [6,12] []+ then mingwBinDir </> "ld.exe"+ else libDir </> "ld.exe" ], programPostConf = configureLd }+ . addKnownProgram arProgram {+ programFindLocation = findProg arProgram+ [ if ghcVersion >= Version [6,12] []+ then mingwBinDir </> "ar.exe"+ else libDir </> "ar.exe" ]+ } where Just ghcVersion = programVersion ghcProg compilerDir = takeDirectory (programPath ghcProg) baseDir = takeDirectory compilerDir- mingwDir = baseDir </> "mingw"+ mingwBinDir = baseDir </> "mingw" </> "bin" libDir = baseDir </> "gcc-lib" includeDir = baseDir </> "include" </> "mingw" isWindows = case buildOS of Windows -> True; _ -> False@@ -352,6 +362,7 @@ getInstalledPackages verbosity packagedbs conf = do checkPackageDbStack packagedbs pkgss <- getInstalledPackages' verbosity packagedbs conf+ topDir <- ghcLibDir' verbosity ghcProg let indexes = [ PackageIndex.fromList (map (substTopDir topDir) pkgs) | (_, pkgs) <- pkgss ] return $! hackRtsPackage (mconcat indexes)@@ -361,8 +372,6 @@ -- paths. We need to substitute the right value in so that when -- we, for example, call gcc, we have proper paths to give it Just ghcProg = lookupProgram ghcProgram conf- compilerDir = takeDirectory (programPath ghcProg)- topDir = takeDirectory compilerDir hackRtsPackage index = case PackageIndex.lookupPackageName index (PackageName "rts") of@@ -371,6 +380,11 @@ _ -> index -- No (or multiple) ghc rts package is registered!! -- Feh, whatever, the ghc testsuite does some crazy stuff. +ghcLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath+ghcLibDir' verbosity ghcProg =+ (reverse . dropWhile isSpace . reverse) `fmap`+ rawSystemProgramStdout verbosity ghcProg ["--print-libdir"]+ checkPackageDbStack :: PackageDBStack -> IO () checkPackageDbStack (GlobalPackageDB:rest) | GlobalPackageDB `notElem` rest = return ()@@ -521,6 +535,9 @@ sharedLibFilePath = libTargetDir </> mkSharedLibName pkgid (compilerId (compiler lbi)) ghciLibFilePath = libTargetDir </> mkGHCiLibName pkgid+ libInstallPath = libdir $ absoluteInstallDirs pkg_descr lbi NoCopyDest+ sharedLibInstallPath = libInstallPath </> mkSharedLibName pkgid+ (compilerId (compiler lbi)) stubObjs <- fmap catMaybes $ sequence [ findFileWithExtension [objExtension] [libTargetDir]@@ -579,6 +596,11 @@ "-shared", "-dynamic", "-o", sharedLibFilePath ]+ -- For dynamic libs, Mac OS/X needs to know the install location+ -- at build time.+ ++ (if buildOS == OSX+ then ["-dylib-install-name", sharedLibInstallPath]+ else []) ++ dynamicObjectFiles ++ ["-package-name", display pkgid ] ++ ghcPackageFlags lbi clbi@@ -786,15 +808,14 @@ ghcPackageDbOptions :: PackageDBStack -> [String] ghcPackageDbOptions dbstack = case dbstack of- (GlobalPackageDB:dbs)- | UserPackageDB `elem` dbs -> concatMap specific dbs- | otherwise -> "-no-user-package-conf"- : concatMap specific dbs- _ -> ierror+ (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs+ (GlobalPackageDB:dbs) -> "-no-user-package-conf"+ : concatMap specific dbs+ _ -> ierror where specific (SpecificPackageDB db) = [ "-package-conf", db ]- specific _ = []- ierror = error "internal error: unexpected package db stack"+ specific _ = ierror+ ierror = error "internal error: unexpected package db stack" constructCcCmdLine :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo -> FilePath -> FilePath -> Verbosity -> Bool
Distribution/Simple/Hugs.hs view
@@ -2,6 +2,7 @@ -- | -- Module : Distribution.Simple.Hugs -- Copyright : Isaac Jones 2003-2006+-- Duncan Coutts 2009 -- -- Maintainer : cabal-devel@haskell.org -- Portability : portable@@ -41,24 +42,39 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} module Distribution.Simple.Hugs (- configure,- buildLib,- buildExe,- install- ) where+ configure,+ getInstalledPackages,+ buildLib,+ buildExe,+ install+ ) where +import Distribution.Package+ ( PackageName, PackageIdentifier(..), InstalledPackageId(..)+ , packageName )+import Distribution.InstalledPackageInfo+ ( InstalledPackageInfo+ , InstalledPackageInfo_( InstalledPackageInfo, installedPackageId+ , sourcePackageId )+ , emptyInstalledPackageInfo, parseInstalledPackageInfo ) import Distribution.PackageDescription ( PackageDescription(..), BuildInfo(..), hcOptions, Executable(..), withExe, Library(..), withLib, libModules ) import Distribution.ModuleName (ModuleName) import qualified Distribution.ModuleName as ModuleName import Distribution.Simple.Compiler- ( CompilerFlavor(..), CompilerId(..), Compiler(..), Flag )-import Distribution.Simple.Program ( ProgramConfiguration, userMaybeSpecifyPath,- requireProgram, rawSystemProgramConf,- ffihugsProgram, hugsProgram )+ ( CompilerFlavor(..), CompilerId(..), Compiler(..), Flag+ , PackageDB(..), PackageDBStack )+import qualified Distribution.Simple.PackageIndex as PackageIndex+import Distribution.Simple.PackageIndex (PackageIndex)+import Distribution.Simple.Program+ ( Program(programFindVersion)+ , ProgramConfiguration, userMaybeSpecifyPath+ , requireProgram, requireProgramVersion+ , rawSystemProgramConf, programPath+ , ffihugsProgram, hugsProgram ) import Distribution.Version- ( Version(..) )+ ( Version(..), orLaterVersion ) import Distribution.Simple.PreProcess ( ppCpp, runSimplePreProcessor ) import Distribution.Simple.PreProcess.Unlit ( unlit )@@ -71,6 +87,7 @@ ( createDirectoryIfMissingVerbose, installOrdinaryFiles , withUTF8FileContents, writeFileAtomic, copyFileVerbose , findFile, findFileWithExtension, findModuleFiles+ , rawSystemStdInOut , die, info, notice ) import Language.Haskell.Extension ( Extension(..) )@@ -79,14 +96,21 @@ import Distribution.System ( OS(..), buildOS ) import Distribution.Text- ( display )+ ( display, simpleParse )+import Distribution.ParseUtils+ ( ParseResult(..) ) import Distribution.Verbosity import Data.Char ( isSpace ) import Data.Maybe ( mapMaybe, catMaybes )+import Data.Monoid ( Monoid(..) ) import Control.Monad ( unless, when, filterM ) import Data.List ( nub, sort, isSuffixOf )-import System.Directory ( removeDirectoryRecursive )+import System.Directory+ ( doesFileExist, doesDirectoryExist, getDirectoryContents+ , removeDirectoryRecursive, getHomeDirectory )+import System.Exit+ ( ExitCode(ExitSuccess) ) import Distribution.Compat.CopyFile ( setFileExecutable ) import Distribution.Compat.Exception@@ -100,14 +124,46 @@ (_ffihugsProg, conf') <- requireProgram verbosity ffihugsProgram (userMaybeSpecifyPath "ffihugs" hcPath conf)- (_hugsProg, conf'') <- requireProgram verbosity hugsProgram conf'+ (_hugsProg, version, conf'')+ <- requireProgramVersion verbosity hugsProgram'+ (orLaterVersion (Version [2006] [])) conf' let comp = Compiler {- compilerId = CompilerId Hugs (Version [] []),+ compilerId = CompilerId Hugs version, compilerExtensions = hugsLanguageExtensions } return (comp, conf'') + where+ hugsProgram' = hugsProgram { programFindVersion = getVersion }++getVersion :: Verbosity -> FilePath -> IO (Maybe Version)+getVersion verbosity hugsPath = do+ (output, _err, exit) <- rawSystemStdInOut verbosity hugsPath []+ (Just (":quit", False)) False+ if exit == ExitSuccess+ then return $! findVersion output+ else return Nothing++ where+ findVersion output = do+ (monthStr, yearStr) <- selectWords output+ year <- convertYear yearStr+ month <- convertMonth monthStr+ return (Version [year, month] [])++ selectWords output =+ case [ (month, year)+ | [_,_,"Version:", month, year,_] <- map words (lines output) ] of+ [(month, year)] -> Just (month, year)+ _ -> Nothing+ convertYear year = case reads year of+ [(y, [])] | y >= 1999 && y < 2020 -> Just y+ _ -> Nothing+ convertMonth month = lookup month (zip months [1..])+ months = [ "January", "February", "March", "April", "May", "June", "July"+ , "August", "September", "October", "November", "December" ]+ -- | The flags for the supported extensions hugsLanguageExtensions :: [(Extension, Flag)] hugsLanguageExtensions =@@ -132,6 +188,114 @@ ,(EmptyDataDecls , "") ,(CPP , "") ]++getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration+ -> IO PackageIndex+getInstalledPackages verbosity packagedbs conf = do+ homedir <- getHomeDirectory+ (hugsProg, _) <- requireProgram verbosity hugsProgram conf+ let bindir = takeDirectory (programPath hugsProg)+ libdir = takeDirectory bindir </> "lib" </> "hugs"+ dbdirs = nub (concatMap (packageDbPaths homedir libdir) packagedbs)+ indexes <- mapM getIndividualDBPackages dbdirs+ return $! mconcat indexes++ where+ getIndividualDBPackages :: FilePath -> IO PackageIndex+ getIndividualDBPackages dbdir = do+ pkgdirs <- getPackageDbDirs dbdir+ pkgs <- sequence [ getInstalledPackage pkgname pkgdir+ | (pkgname, pkgdir) <- pkgdirs ]+ let pkgs' = map setInstalledPackageId (catMaybes pkgs)+ return (PackageIndex.fromList pkgs')++packageDbPaths :: FilePath -> FilePath -> PackageDB -> [FilePath]+packageDbPaths home hugslibdir db = case db of+ GlobalPackageDB -> [ hugslibdir </> "packages"+ , "/usr/local/lib/hugs/packages" ]+ UserPackageDB -> [ home </> "lib/hugs/packages" ]+ SpecificPackageDB path -> [ path ]++getPackageDbDirs :: FilePath -> IO [(PackageName, FilePath)]+getPackageDbDirs dbdir = do+ dbexists <- doesDirectoryExist dbdir+ if not dbexists+ then return []+ else do+ entries <- getDirectoryContents dbdir+ pkgdirs <- sequence+ [ do pkgdirExists <- doesDirectoryExist pkgdir+ return (pkgname, pkgdir, pkgdirExists)+ | (entry, Just pkgname) <- [ (entry, simpleParse entry)+ | entry <- entries ]+ , let pkgdir = dbdir </> entry ]+ return [ (pkgname, pkgdir) | (pkgname, pkgdir, True) <- pkgdirs ]++getInstalledPackage :: PackageName -> FilePath -> IO (Maybe InstalledPackageInfo)+getInstalledPackage pkgname pkgdir = do+ let pkgconfFile = pkgdir </> "package.conf"+ pkgconfExists <- doesFileExist pkgconfFile++ let pathsModule = pkgdir </> ("Paths_" ++ display pkgname) <.> "hs"+ pathsModuleExists <- doesFileExist pathsModule++ case () of+ _ | pkgconfExists -> getFullInstalledPackageInfo pkgname pkgconfFile+ | pathsModuleExists -> getPhonyInstalledPackageInfo pkgname pathsModule+ | otherwise -> return Nothing++getFullInstalledPackageInfo :: PackageName -> FilePath+ -> IO (Maybe InstalledPackageInfo)+getFullInstalledPackageInfo pkgname pkgconfFile =+ withUTF8FileContents pkgconfFile $ \contents ->+ case parseInstalledPackageInfo contents of+ ParseOk _ pkginfo | packageName pkginfo == pkgname+ -> return (Just pkginfo)+ _ -> return Nothing++-- | This is a backup option for existing versions of Hugs which do not supply+-- proper installed package info files for the bundled libs. Instead we look+-- for the Paths_pkgname.hs file and extract the package version from that.+-- We don't know any other details for such packages, in particular we pretend+-- that they have no dependencies.+--+getPhonyInstalledPackageInfo :: PackageName -> FilePath+ -> IO (Maybe InstalledPackageInfo)+getPhonyInstalledPackageInfo pkgname pathsModule = do+ content <- readFile pathsModule+ case extractVersion content of+ Nothing -> return Nothing+ Just version -> return (Just pkginfo)+ where+ pkgid = PackageIdentifier pkgname version+ pkginfo = emptyInstalledPackageInfo { sourcePackageId = pkgid }+ where+ -- search through the Paths_pkgname.hs file, looking for a line like:+ --+ -- > version = Version {versionBranch = [2,0], versionTags = []}+ --+ -- and parse it using 'Read'. Yes we are that evil.+ --+ extractVersion content =+ case [ version+ | ("version":"=":rest) <- map words (lines content)+ , (version, []) <- reads (concat rest) ] of+ [version] -> Just version+ _ -> Nothing++-- Older installed package info files did not have the installedPackageId+-- field, so if it is missing then we fill it as the source package ID.+setInstalledPackageId :: InstalledPackageInfo -> InstalledPackageInfo+setInstalledPackageId pkginfo@InstalledPackageInfo {+ installedPackageId = InstalledPackageId "",+ sourcePackageId = pkgid+ }+ = pkginfo {+ --TODO use a proper named function for the conversion+ -- from source package id to installed package id+ installedPackageId = InstalledPackageId (display pkgid)+ }+setInstalledPackageId pkginfo = pkginfo -- ----------------------------------------------------------------------------- -- Building
Distribution/Simple/InstallDirs.hs view
@@ -216,7 +216,7 @@ -- Default installation directories defaultInstallDirs :: CompilerFlavor -> Bool -> Bool -> IO InstallDirTemplates-defaultInstallDirs comp userInstall hasLibs = do+defaultInstallDirs comp userInstall _hasLibs = do windowsProgramFilesDir <- getWindowsProgramFilesDir userInstallPrefix <- getAppUserDataDirectory "cabal" lhcPrefix <- getAppUserDataDirectory "lhc"@@ -244,13 +244,10 @@ progdir = "$libdir" </> "hugs" </> "programs", includedir = "$libdir" </> "$libsubdir" </> "include", datadir = case buildOS of- Windows | hasLibs -> windowsProgramFilesDir </> "Haskell"- | otherwise -> "$prefix"+ Windows -> "$prefix" _other -> "$prefix" </> "share", datasubdir = "$pkgid",- docdir = case buildOS of- Windows -> "$prefix" </> "doc" </> "$pkgid"- _other -> "$datadir" </> "doc" </> "$pkgid",+ docdir = "$datadir" </> "doc" </> "$pkgid", mandir = "$datadir" </> "man", htmldir = "$docdir" </> "html", haddockdir = "$htmldir"@@ -443,7 +440,7 @@ ] platformTemplateEnv :: Platform -> PathTemplateEnv-platformTemplateEnv (Platform os arch) =+platformTemplateEnv (Platform arch os) = [(OSVar, PathTemplate [Ordinary $ display os]) ,(ArchVar, PathTemplate [Ordinary $ display arch]) ]
Distribution/Simple/LHC.hs view
@@ -654,7 +654,7 @@ (GlobalPackageDB:dbs) -> "-no-user-package-conf" : concatMap specific dbs _ -> ierror- where+ where specific (SpecificPackageDB db) = [ "-package-conf", db ] specific _ = ierror ierror = error "internal error: unexpected package db stack"
Distribution/Simple/NHC.hs view
@@ -2,6 +2,7 @@ -- | -- Module : Distribution.Simple.NHC -- Copyright : Isaac Jones 2003-2006+-- Duncan Coutts 2009 -- -- Maintainer : cabal-devel@haskell.org -- Portability : portable@@ -40,14 +41,23 @@ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} -module Distribution.Simple.NHC- ( configure- , buildLib, buildExe- , installLib, installExe+module Distribution.Simple.NHC (+ configure,+ getInstalledPackages,+ buildLib,+ buildExe,+ installLib,+ installExe, ) where import Distribution.Package- ( PackageIdentifier, packageName, Package(..) )+ ( PackageName, PackageIdentifier(..), InstalledPackageId(..)+ , packageId, packageName )+import Distribution.InstalledPackageInfo+ ( InstalledPackageInfo+ , InstalledPackageInfo_( InstalledPackageInfo, installedPackageId+ , sourcePackageId )+ , emptyInstalledPackageInfo, parseInstalledPackageInfo ) import Distribution.PackageDescription ( PackageDescription(..), BuildInfo(..), Library(..), Executable(..) , hcOptions )@@ -59,7 +69,9 @@ ( mkLibName, objExtension, exeExtension ) import Distribution.Simple.Compiler ( CompilerFlavor(..), CompilerId(..), Compiler(..)- , Flag, extensionsToFlags )+ , Flag, extensionsToFlags, PackageDB(..), PackageDBStack )+import qualified Distribution.Simple.PackageIndex as PackageIndex+import Distribution.Simple.PackageIndex (PackageIndex) import Language.Haskell.Extension ( Extension(..) ) import Distribution.Simple.Program@@ -70,19 +82,25 @@ import Distribution.Simple.Utils ( die, info, findFileWithExtension, findModuleFiles , installOrdinaryFile, installExecutableFile, installOrdinaryFiles- , createDirectoryIfMissingVerbose )+ , createDirectoryIfMissingVerbose, withUTF8FileContents ) import Distribution.Version ( Version(..), orLaterVersion ) import Distribution.Verbosity import Distribution.Text- ( display )+ ( display, simpleParse )+import Distribution.ParseUtils+ ( ParseResult(..) ) import System.FilePath ( (</>), (<.>), normalise, takeDirectory, dropExtension ) import System.Directory- ( removeFile )+ ( doesFileExist, doesDirectoryExist, getDirectoryContents+ , removeFile, getHomeDirectory ) +import Data.Char ( toLower ) import Data.List ( nub )+import Data.Maybe ( catMaybes )+import Data.Monoid ( Monoid(..) ) import Control.Monad ( when, unless ) import Distribution.Compat.Exception @@ -121,6 +139,7 @@ nhcLanguageExtensions = -- TODO: use -98 when no extensions are specified. -- NHC doesn't enforce the monomorphism restriction at all.+ -- TODO: pattern guards in 1.20 [(NoMonomorphismRestriction, "") ,(ForeignFunctionInterface, "") ,(ExistentialQuantification, "")@@ -128,6 +147,118 @@ ,(NamedFieldPuns, "-puns") ,(CPP, "-cpp") ]++getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration+ -> IO PackageIndex+getInstalledPackages verbosity packagedbs conf = do+ homedir <- getHomeDirectory+ (nhcProg, _) <- requireProgram verbosity nhcProgram conf+ let bindir = takeDirectory (programPath nhcProg)+ incdir = takeDirectory bindir </> "include" </> "nhc98"+ dbdirs = nub (concatMap (packageDbPaths homedir incdir) packagedbs)+ indexes <- mapM getIndividualDBPackages dbdirs+ return $! mconcat indexes++ where+ getIndividualDBPackages :: FilePath -> IO PackageIndex+ getIndividualDBPackages dbdir = do+ pkgdirs <- getPackageDbDirs dbdir+ pkgs <- sequence [ getInstalledPackage pkgname pkgdir+ | (pkgname, pkgdir) <- pkgdirs ]+ let pkgs' = map setInstalledPackageId (catMaybes pkgs)+ return (PackageIndex.fromList pkgs')++packageDbPaths :: FilePath -> FilePath -> PackageDB -> [FilePath]+packageDbPaths _home incdir db = case db of+ GlobalPackageDB -> [ incdir </> "packages" ]+ UserPackageDB -> [] --TODO any standard per-user db?+ SpecificPackageDB path -> [ path ]++getPackageDbDirs :: FilePath -> IO [(PackageName, FilePath)]+getPackageDbDirs dbdir = do+ dbexists <- doesDirectoryExist dbdir+ if not dbexists+ then return []+ else do+ entries <- getDirectoryContents dbdir+ pkgdirs <- sequence+ [ do pkgdirExists <- doesDirectoryExist pkgdir+ return (pkgname, pkgdir, pkgdirExists)+ | (entry, Just pkgname) <- [ (entry, simpleParse entry)+ | entry <- entries ]+ , let pkgdir = dbdir </> entry ]+ return [ (pkgname, pkgdir) | (pkgname, pkgdir, True) <- pkgdirs ]++getInstalledPackage :: PackageName -> FilePath -> IO (Maybe InstalledPackageInfo)+getInstalledPackage pkgname pkgdir = do+ let pkgconfFile = pkgdir </> "package.conf"+ pkgconfExists <- doesFileExist pkgconfFile++ let cabalFile = pkgdir <.> "cabal"+ cabalExists <- doesFileExist cabalFile++ case () of+ _ | pkgconfExists -> getFullInstalledPackageInfo pkgname pkgconfFile+ | cabalExists -> getPhonyInstalledPackageInfo pkgname cabalFile+ | otherwise -> return Nothing++getFullInstalledPackageInfo :: PackageName -> FilePath+ -> IO (Maybe InstalledPackageInfo)+getFullInstalledPackageInfo pkgname pkgconfFile =+ withUTF8FileContents pkgconfFile $ \contents ->+ case parseInstalledPackageInfo contents of+ ParseOk _ pkginfo | packageName pkginfo == pkgname+ -> return (Just pkginfo)+ _ -> return Nothing++-- | This is a backup option for existing versions of nhc98 which do not supply+-- proper installed package info files for the bundled libs. Instead we look+-- for the .cabal file and extract the package version from that.+-- We don't know any other details for such packages, in particular we pretend+-- that they have no dependencies.+--+getPhonyInstalledPackageInfo :: PackageName -> FilePath+ -> IO (Maybe InstalledPackageInfo)+getPhonyInstalledPackageInfo pkgname pathsModule = do+ content <- readFile pathsModule+ case extractVersion content of+ Nothing -> return Nothing+ Just version -> return (Just pkginfo)+ where+ pkgid = PackageIdentifier pkgname version+ pkginfo = emptyInstalledPackageInfo { sourcePackageId = pkgid }+ where+ -- search through the .cabal file, looking for a line like:+ --+ -- > version: 2.0+ --+ extractVersion :: String -> Maybe Version+ extractVersion content =+ case catMaybes (map extractVersionLine (lines content)) of+ [version] -> Just version+ _ -> Nothing+ extractVersionLine :: String -> Maybe Version+ extractVersionLine line =+ case words line of+ [versionTag, ":", versionStr]+ | map toLower versionTag == "version" -> simpleParse versionStr+ [versionTag, versionStr]+ | map toLower versionTag == "version:" -> simpleParse versionStr+ _ -> Nothing++-- Older installed package info files did not have the installedPackageId+-- field, so if it is missing then we fill it as the source package ID.+setInstalledPackageId :: InstalledPackageInfo -> InstalledPackageInfo+setInstalledPackageId pkginfo@InstalledPackageInfo {+ installedPackageId = InstalledPackageId "",+ sourcePackageId = pkgid+ }+ = pkginfo {+ --TODO use a proper named function for the conversion+ -- from source package id to installed package id+ installedPackageId = InstalledPackageId (display pkgid)+ }+setInstalledPackageId pkginfo = pkginfo -- ----------------------------------------------------------------------------- -- Building
Distribution/Simple/PackageIndex.hs view
@@ -445,7 +445,7 @@ dependencyClosure index pkgids0 = case closure mempty [] pkgids0 of (completed, []) -> Left completed (completed, _) -> Right (brokenPackages completed)- where+ where closure completed failed [] = (completed, failed) closure completed failed (pkgid:pkgids) = case lookupInstalledPackageId index pkgid of Nothing -> closure completed (pkgid:failed) pkgids
Distribution/Simple/PreProcess.hs view
@@ -59,7 +59,6 @@ import Distribution.Simple.PreProcess.Unlit (unlit) import Distribution.Package ( Package(..), PackageName(..) )-import Distribution.ModuleName (ModuleName) import qualified Distribution.ModuleName as ModuleName import Distribution.PackageDescription as PD ( PackageDescription(..), BuildInfo(..), Executable(..), withExe@@ -84,8 +83,6 @@ ( OS(OSX, Windows), buildOS ) import Distribution.Version (Version(..)) import Distribution.Verbosity-import Distribution.Text- ( display ) import Control.Monad (when, unless) import Data.Maybe (fromMaybe)@@ -182,8 +179,9 @@ setupMessage verbosity "Preprocessing library" (packageId pkg_descr) let bi = libBuildInfo lib let biHandlers = localHandlers bi- sequence_ [ preprocessModule (hsSourceDirs bi ++ [autogenModulesDir lbi]) (buildDir lbi) forSDist- modu verbosity builtinSuffixes biHandlers+ sequence_ [ preprocessFile (hsSourceDirs bi ++ [autogenModulesDir lbi]) (buildDir lbi) forSDist+ (ModuleName.toFilePath modu) verbosity+ builtinSuffixes biHandlers | modu <- libModules lib ] unless (null (executables pkg_descr)) $ setupMessage verbosity "Preprocessing executables for" (packageId pkg_descr)@@ -191,12 +189,12 @@ let bi = buildInfo theExe let biHandlers = localHandlers bi let exeDir = buildDir lbi </> exeName theExe </> exeName theExe ++ "-tmp"- sequence_ [ preprocessModule (hsSourceDirs bi ++ [autogenModulesDir lbi]) exeDir forSDist- modu verbosity builtinSuffixes biHandlers+ sequence_ [ preprocessFile (hsSourceDirs bi ++ [autogenModulesDir lbi]) exeDir forSDist+ (ModuleName.toFilePath modu) verbosity+ builtinSuffixes biHandlers | modu <- otherModules bi]- preprocessModule (hsSourceDirs bi) exeDir forSDist- --FIXME: we should not pretend it's a module name:- (ModuleName.simple (dropExtensions (modulePath theExe)))+ preprocessFile (hsSourceDirs bi) exeDir forSDist+ (dropExtensions (modulePath theExe)) verbosity builtinSuffixes biHandlers where hc = compilerFlavor (compiler lbi) builtinSuffixes@@ -206,27 +204,25 @@ -- |Find the first extension of the file that exists, and preprocess it -- if required.-preprocessModule+preprocessFile :: [FilePath] -- ^source directories -> FilePath -- ^build directory -> Bool -- ^preprocess for sdist- -> ModuleName -- ^module name+ -> FilePath -- ^module file name -> Verbosity -- ^verbosity -> [String] -- ^builtin suffixes -> [(String, PreProcessor)] -- ^possible preprocessors -> IO ()-preprocessModule searchLoc buildLoc forSDist modu verbosity builtinSuffixes handlers = do+preprocessFile searchLoc buildLoc forSDist baseFile verbosity builtinSuffixes handlers = do -- look for files in the various source dirs with this module name -- and a file extension of a known preprocessor- psrcFiles <- findFileWithExtension' (map fst handlers) searchLoc- (ModuleName.toFilePath modu)+ psrcFiles <- findFileWithExtension' (map fst handlers) searchLoc baseFile case psrcFiles of -- no preprocessor file exists, look for an ordinary source file Nothing -> do- bsrcFiles <- findFileWithExtension builtinSuffixes searchLoc- (ModuleName.toFilePath modu)+ bsrcFiles <- findFileWithExtension builtinSuffixes searchLoc baseFile case bsrcFiles of- Nothing -> die $ "can't find source for " ++ display modu+ Nothing -> die $ "can't find source for " ++ baseFile ++ " in " ++ intercalate ", " searchLoc _ -> return () -- found a pre-processable file in one of the source dirs@@ -243,11 +239,11 @@ -- platform independent files and put them into the 'buildLoc' -- (which we assume is set to the temp. directory that will become -- the tarball).+ --TODO: eliminate sdist variant, just supply different handlers when (not forSDist || forSDist && platformIndependent pp) $ do -- look for existing pre-processed source file in the dest dir to -- see if we really have to re-run the preprocessor.- ppsrcFiles <- findFileWithExtension builtinSuffixes [buildLoc]- (ModuleName.toFilePath modu)+ ppsrcFiles <- findFileWithExtension builtinSuffixes [buildLoc] baseFile recomp <- case ppsrcFiles of Nothing -> return True Just ppsrcFile -> do@@ -261,9 +257,9 @@ (psrcLoc, psrcRelFile) (buildLoc, srcStem <.> "hs") verbosity - where dirName = takeDirectory- tailNotNull [] = []- tailNotNull x = tail x+ where dirName = takeDirectory+ tailNotNull [] = []+ tailNotNull x = tail x -- ------------------------------------------------------------ -- * known preprocessors
Distribution/Simple/Register.hs view
@@ -71,13 +71,18 @@ import qualified Distribution.Simple.GHC as GHC import Distribution.Simple.Compiler ( compilerVersion, CompilerFlavor(..), compilerFlavor- , PackageDB(..), registrationPackageDB )+ , PackageDB(..), PackageDBStack, registrationPackageDB ) import Distribution.Simple.Program- ( ConfiguredProgram, runProgramInvocation+ ( ConfiguredProgram , requireProgram, lookupProgram, ghcPkgProgram, lhcPkgProgram ) import Distribution.Simple.Program.Script ( invocationAsSystemScript ) import qualified Distribution.Simple.Program.HcPkg as HcPkg+import Distribution.Simple.Program.Run+ ( ProgramInvocation(..), IOEncoding(..), programInvocation+ , runProgramInvocation )+import Distribution.Simple.Program.Types+ ( ConfiguredProgram(programId, programVersion) ) import Distribution.Simple.Setup ( RegisterFlags(..), CopyDest(..) , fromFlag, fromFlagOrDefault, flagToMaybe )@@ -98,7 +103,7 @@ ( display ) import Distribution.Version ( Version(..) ) import Distribution.Verbosity as Verbosity- ( Verbosity, normal )+ ( Verbosity, normal, deafening, silent ) import Distribution.Compat.CopyFile ( setFileExecutable ) @@ -109,7 +114,7 @@ import Control.Monad (when) import Data.Maybe- ( isJust, fromMaybe )+ ( isJust, fromMaybe, maybeToList ) import Data.List (partition) @@ -130,8 +135,8 @@ case () of _ | modeGenerateRegFile -> writeRegistrationFile installedPkgInfo | modeGenerateRegScript -> writeRegisterScript installedPkgInfo- | otherwise -> registerPackage verbosity- installedPkgInfo pkg lbi inplace packageDb+ | otherwise -> registerPackage' verbosity+ installedPkgInfo pkg lbi inplace packageDbs where modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags))@@ -141,8 +146,8 @@ modeGenerateRegScript = fromFlag (regGenScript regFlags) inplace = fromFlag (regInPlace regFlags)- packageDb = fromFlagOrDefault (registrationPackageDB (withPackageDB lbi))- (regPackageDB regFlags)+ packageDbs = withPackageDB lbi+ ++ maybeToList (flagToMaybe (regPackageDB regFlags)) distPref = fromFlag (regDistPref regFlags) verbosity = fromFlag (regVerbosity regFlags) @@ -153,9 +158,9 @@ writeRegisterScript installedPkgInfo = case compilerFlavor (compiler lbi) of GHC -> do (ghcPkg, _) <- requireProgram verbosity ghcPkgProgram (withPrograms lbi)- writeHcPkgRegisterScript verbosity installedPkgInfo ghcPkg packageDb+ writeHcPkgRegisterScript verbosity installedPkgInfo ghcPkg packageDbs LHC -> do (lhcPkg, _) <- requireProgram verbosity lhcPkgProgram (withPrograms lbi)- writeHcPkgRegisterScript verbosity installedPkgInfo lhcPkg packageDb+ writeHcPkgRegisterScript verbosity installedPkgInfo lhcPkg packageDbs Hugs -> notice verbosity "Registration scripts not needed for hugs" JHC -> notice verbosity "Registration scripts not needed for jhc" NHC -> notice verbosity "Registration scripts not needed for nhc98"@@ -205,12 +210,27 @@ -> Bool -> PackageDB -> IO ()-registerPackage verbosity installedPkgInfo pkg lbi inplace packageDb = do+registerPackage verbosity installedPkgInfo pkg lbi inplace packageDb =+ registerPackage' verbosity installedPkgInfo pkg lbi inplace packageDbs+ where+ packageDbs+ | registrationPackageDB (withPackageDB lbi) == packageDb+ = withPackageDB lbi+ | otherwise = withPackageDB lbi ++ [packageDb]++registerPackage' :: Verbosity+ -> InstalledPackageInfo+ -> PackageDescription+ -> LocalBuildInfo+ -> Bool+ -> PackageDBStack+ -> IO ()+registerPackage' verbosity installedPkgInfo pkg lbi inplace packageDbs = do setupMessage verbosity "Registering" (packageId pkg) case compilerFlavor (compiler lbi) of- GHC -> registerPackageGHC verbosity installedPkgInfo pkg lbi inplace packageDb- LHC -> registerPackageLHC verbosity installedPkgInfo pkg lbi inplace packageDb- Hugs -> registerPackageHugs verbosity installedPkgInfo pkg lbi inplace packageDb+ GHC -> registerPackageGHC verbosity installedPkgInfo pkg lbi inplace packageDbs+ LHC -> registerPackageLHC verbosity installedPkgInfo pkg lbi inplace packageDbs+ Hugs -> registerPackageHugs verbosity installedPkgInfo pkg lbi inplace packageDbs JHC -> notice verbosity "Registering for jhc (nothing to do)" NHC -> notice verbosity "Registering for nhc98 (nothing to do)" _ -> die "Registering is not implemented for this compiler"@@ -222,17 +242,17 @@ -> PackageDescription -> LocalBuildInfo -> Bool- -> PackageDB+ -> PackageDBStack -> IO ()-registerPackageGHC verbosity installedPkgInfo _pkg lbi _inplace packageDb = do+registerPackageGHC verbosity installedPkgInfo _pkg lbi _inplace packageDbs = do let Just ghcPkg = lookupProgram ghcPkgProgram (withPrograms lbi)- HcPkg.reregister verbosity ghcPkg packageDb (Right installedPkgInfo)+ reregister verbosity ghcPkg packageDbs installedPkgInfo -registerPackageLHC verbosity installedPkgInfo _pkg lbi _inplace packageDb = do+registerPackageLHC verbosity installedPkgInfo _pkg lbi _inplace packageDbs = do let Just lhcPkg = lookupProgram lhcPkgProgram (withPrograms lbi)- HcPkg.reregister verbosity lhcPkg packageDb (Right installedPkgInfo)+ reregister verbosity lhcPkg packageDbs installedPkgInfo -registerPackageHugs verbosity installedPkgInfo pkg lbi inplace _packageDb = do+registerPackageHugs verbosity installedPkgInfo pkg lbi inplace _packageDbs = do when inplace $ die "--inplace is not supported with Hugs" let installDirs = absoluteInstallDirs pkg lbi NoCopyDest createDirectoryIfMissingVerbose verbosity True (libdir installDirs)@@ -243,11 +263,11 @@ writeHcPkgRegisterScript :: Verbosity -> InstalledPackageInfo -> ConfiguredProgram- -> PackageDB+ -> PackageDBStack -> IO ()-writeHcPkgRegisterScript verbosity installedPkgInfo hcPkg packageDb = do- let invocation = HcPkg.reregisterInvocation hcPkg Verbosity.normal- packageDb (Right installedPkgInfo)+writeHcPkgRegisterScript verbosity installedPkgInfo hcPkg packageDbs = do+ let invocation = reregisterInvocation hcPkg Verbosity.normal+ packageDbs installedPkgInfo regScript = invocationAsSystemScript buildOS invocation notice verbosity ("Creating package registration script: " ++ regScriptFileName)@@ -403,3 +423,48 @@ unregScriptFileName = case buildOS of Windows -> "unregister.bat" _ -> "unregister.sh"++reregister :: Verbosity -> ConfiguredProgram -> PackageDBStack+ -> InstalledPackageInfo+ -> IO ()+reregister verbosity hcPkg packagedb pkgFile =+ runProgramInvocation verbosity+ (reregisterInvocation hcPkg verbosity packagedb pkgFile)++reregisterInvocation :: ConfiguredProgram -> Verbosity -> PackageDBStack+ -> InstalledPackageInfo+ -> ProgramInvocation+reregisterInvocation hcPkg verbosity packagedbs pkgInfo =+ (programInvocation hcPkg args) {+ progInvokeInput = Just (showInstalledPackageInfo pkgInfo),+ progInvokeInputEncoding = IOEncodingUTF8+ }+ where+ args = ["update", "-"] ++ packageDbStackOpts packagedbs+ ++ verbosityOpts verbosity++ verbosityOpts :: Verbosity -> [String]+ verbosityOpts v++ -- ghc-pkg < 6.11 does not support -v+ | programId hcPkg == "ghc-pkg"+ && programVersion hcPkg < Just (Version [6,11] [])+ = []++ | v >= deafening = ["-v2"]+ | v == silent = ["-v0"]+ | otherwise = []++ packageDbStackOpts :: PackageDBStack -> [String]+ packageDbStackOpts dbstack = case dbstack of+ (GlobalPackageDB:UserPackageDB:dbs) -> "--global"+ : "--user"+ : map specific dbs+ (GlobalPackageDB:dbs) -> "--global"+ : "--no-user-package-conf"+ : map specific dbs+ _ -> ierror+ where+ specific (SpecificPackageDB db) = "--package-conf=" ++ db+ specific _ = ierror+ ierror = error "internal error: unexpected package db stack"
Distribution/Simple/Utils.hs view
@@ -161,7 +161,7 @@ , hGetContents, stderr, stdout, hPutStr, hFlush, hClose ) import System.IO.Error as IO.Error ( isDoesNotExistError, ioeSetFileName, ioeGetFileName, ioeGetErrorString )-#if !defined(__GLASGOW_HASKELL__) || (__GLASGOW_HASKELL__ >= 608)+#if !(defined(__HUGS__) || (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 608)) import System.IO.Error ( ioeSetLocation, ioeGetLocation ) #endif@@ -220,7 +220,7 @@ . flip ioeSetFileName (normalise filename) $ userError msg where-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 608)+#if defined(__HUGS__) || (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 608) setLocation _ err = err #else setLocation Nothing err = err@@ -243,7 +243,7 @@ file = case ioeGetFileName ioe of Nothing -> "" Just path -> path ++ location ++ ": "-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 608)+#if defined(__HUGS__) || (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 608) location = "" #else location = case ioeGetLocation ioe of
changelog view
@@ -1,5 +1,14 @@ -*-change-log-*- +1.8.0.4 Duncan Coutts <duncan@haskell.org> March 2010+ * Fix exe-depends-on-lib feature with ghc-6.12+ * Fix use of --package-db with ghc-6.12+ * By default $datadir now follows the $prefix on Windows+ * Find ar.exe on windows better+ * Fix mixup between $arch and $os path variables+ * Support for for hugs and nhc package databases+ * Set dynlib name for shared libs on OSX+ 1.8.0.2 Duncan Coutts <duncan@haskell.org> December 2009 * Support for GHC-6.12 * New unique installed package IDs which use a package hash