Commit cccfc650 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Remove support for using ghc-6.2

No longer inlcude compatability hacks and remove code that handles
the old style of ghc-pkg package registration files.
parent 3d9ca2f9
......@@ -58,7 +58,6 @@ Library
Distribution.Simple.Configure,
Distribution.Simple.GHC,
Distribution.Simple.GHC.Makefile,
Distribution.Simple.GHC.PackageConfig,
Distribution.Simple.Haddock,
Distribution.Simple.Hugs,
Distribution.Simple.Install,
......
......@@ -73,9 +73,6 @@ import Distribution.Simple.Program ( rawSystemProgram, rawSystemProgramConf,
import Distribution.Simple.Compiler
import Distribution.Version ( Version(..), showVersion,
VersionRange(..), orLaterVersion )
import qualified Distribution.Simple.GHC.PackageConfig as GHC
( localPackageConfig,
canReadLocalPackageConfig )
import Distribution.System
import Distribution.Verbosity
import Language.Haskell.Extension (Extension(..))
......@@ -314,16 +311,6 @@ build pkg_descr lbi verbosity = do
ifSharedLib = when (withSharedLib lbi)
ifGHCiLib = when (withGHCiLib lbi)
-- GHC versions prior to 6.4 didn't have the user package database,
-- so we fake it. TODO: This can go away in due course.
pkg_conf <- if versionBranch (compilerVersion (compiler lbi)) >= [6,4]
then return []
else do pkgConf <- GHC.localPackageConfig
pkgConfReadable <- GHC.canReadLocalPackageConfig
if pkgConfReadable
then return ["-package-conf", pkgConf]
else return []
-- Build lib
withLib pkg_descr () $ \lib -> do
info verbosity "Building library..."
......@@ -342,8 +329,7 @@ build pkg_descr lbi verbosity = do
| otherwise = pkgName (package pkg_descr)
-- Only use the version number with ghc-6.4 and later
ghcArgs =
pkg_conf
++ ["-package-name", packageId ]
["-package-name", packageId ]
++ constructGHCCmdLine lbi libBi libTargetDir verbosity
++ (libModules pkg_descr)
ghcArgsProf = ghcArgs
......@@ -503,8 +489,7 @@ build pkg_descr lbi verbosity = do
let cObjs = map (`replaceExtension` objExtension) (cSources exeBi)
let binArgs linkExe profExe =
pkg_conf
++ (if linkExe
(if linkExe
then ["-o", targetDir </> exeNameReal]
else ["-c"])
++ constructGHCCmdLine lbi exeBi exeDir verbosity
......
{-# OPTIONS -cpp #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.GHC.PackageConfig
-- Copyright : (c) The University of Glasgow 2004
--
-- Maintainer : libraries@haskell.org
-- Stability : alpha
-- Portability : portable
--
-- Explanation: Performs registration for GHC. Specific to
-- ghc-pkg. Creates a GHC package config file. See also
-- 'Distribution.Simple.GHC.build', etc.
module Distribution.Simple.GHC.PackageConfig (
GHCPackageConfig(..),
mkGHCPackageConfig,
defaultGHCPackageConfig,
showGHCPackageConfig,
localPackageConfig, maybeCreateLocalPackageConfig,
canWriteLocalPackageConfig, canReadLocalPackageConfig
) where
import Distribution.PackageDescription (PackageDescription(..), BuildInfo(..), Library(..))
import Distribution.Package (PackageIdentifier(..), showPackageId)
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), absoluteInstallDirs)
import Distribution.Simple.InstallDirs (InstallDirs(..))
import Distribution.Simple.Setup (CopyDest(..))
#ifndef __NHC__
import Control.Exception (try)
#else
import IO (try)
#endif
import Control.Monad(unless)
import Text.PrettyPrint.HughesPJ
import System.Directory (doesFileExist, getPermissions, Permissions (..),
getHomeDirectory)
import System.FilePath ((</>))
-- |Where ghc versions < 6.3 keeps the --user files.
-- |return the file, whether it exists, and whether it's readable
localPackageConfig :: IO FilePath
localPackageConfig = do u <- getHomeDirectory
return $ (u </> ".ghc-packages")
-- |If the package file doesn't exist, we should try to create it. If
-- it already exists, do nothing and return true. This does not take
-- into account whether it is readable or writeable.
maybeCreateLocalPackageConfig :: IO Bool -- ^success?
maybeCreateLocalPackageConfig
= do f <- localPackageConfig
exists <- doesFileExist f
unless exists $ (try (writeFile f "[]\n") >> return ())
doesFileExist f
-- |Helper function for canReadPackageConfig and canWritePackageConfig
checkPermission :: (Permissions -> Bool) -> IO Bool
checkPermission perm
= do f <- localPackageConfig
exists <- doesFileExist f
if exists
then getPermissions f >>= (return . perm)
else return False
-- |Check for read permission on the localPackageConfig
canReadLocalPackageConfig :: IO Bool
canReadLocalPackageConfig = checkPermission readable
-- |Check for write permission on the localPackageConfig
canWriteLocalPackageConfig :: IO Bool
canWriteLocalPackageConfig = checkPermission writable
-- -----------------------------------------------------------------------------
-- GHC 6.2 PackageConfig type
-- Until GHC supports the InstalledPackageInfo type above, we use its
-- existing PackagConfig type.
mkGHCPackageConfig :: PackageDescription -> LocalBuildInfo -> GHCPackageConfig
mkGHCPackageConfig pkg_descr lbi
= defaultGHCPackageConfig {
name = pkgName pkg,
auto = True,
import_dirs = [libdir installDirs],
library_dirs = libdir installDirs
: maybe [] (extraLibDirs . libBuildInfo) lib,
hs_libraries = ["HS"++(showPackageId (package pkg_descr))],
extra_libraries = maybe [] (extraLibs . libBuildInfo) lib,
include_dirs = maybe [] (includeDirs . libBuildInfo) lib,
c_includes = maybe [] (includes . libBuildInfo) lib,
package_deps = map pkgName (packageDeps lbi)
}
where
pkg = package pkg_descr
lib = library pkg_descr
installDirs = absoluteInstallDirs pkg_descr lbi NoCopyDest
data GHCPackageConfig
= GHCPackage {
name :: String,
auto :: Bool,
import_dirs :: [String],
source_dirs :: [String],
library_dirs :: [String],
hs_libraries :: [String],
extra_libraries :: [String],
include_dirs :: [String],
c_includes :: [String],
package_deps :: [String],
extra_ghc_opts :: [String],
extra_cc_opts :: [String],
extra_ld_opts :: [String],
framework_dirs :: [String], -- ignored everywhere but on Darwin/MacOS X
extra_frameworks:: [String] -- ignored everywhere but on Darwin/MacOS X
}
defaultGHCPackageConfig :: GHCPackageConfig
defaultGHCPackageConfig
= GHCPackage {
name = error "defaultPackage",
auto = False,
import_dirs = [],
source_dirs = [],
library_dirs = [],
hs_libraries = [],
extra_libraries = [],
include_dirs = [],
c_includes = [],
package_deps = [],
extra_ghc_opts = [],
extra_cc_opts = [],
extra_ld_opts = [],
framework_dirs = [],
extra_frameworks= []
}
-- ---------------------------------------------------------------------------
-- Pretty printing package info
showGHCPackageConfig :: GHCPackageConfig -> String
showGHCPackageConfig pkg = render $
text "Package" $$ nest 3 (braces (
sep (punctuate comma [
text "name = " <> text (show (name pkg)),
text "auto = " <> text (show (auto pkg)),
dumpField "import_dirs" (import_dirs pkg),
dumpField "source_dirs" (source_dirs pkg),
dumpField "library_dirs" (library_dirs pkg),
dumpField "hs_libraries" (hs_libraries pkg),
dumpField "extra_libraries" (extra_libraries pkg),
dumpField "include_dirs" (include_dirs pkg),
dumpField "c_includes" (c_includes pkg),
dumpField "package_deps" (package_deps pkg),
dumpField "extra_ghc_opts" (extra_ghc_opts pkg),
dumpField "extra_cc_opts" (extra_cc_opts pkg),
dumpField "extra_ld_opts" (extra_ld_opts pkg),
dumpField "framework_dirs" (framework_dirs pkg),
dumpField "extra_frameworks"(extra_frameworks pkg)
])))
dumpField :: String -> [String] -> Doc
dumpField name' val = hang (text name' <+> equals) 2 (dumpFieldContents val)
dumpFieldContents :: [String] -> Doc
dumpFieldContents val = brackets (sep (punctuate comma (map (text . show) val)))
......@@ -65,7 +65,7 @@ import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), distPref,
InstallDirs(..),
absoluteInstallDirs)
import Distribution.Simple.Compiler (CompilerFlavor(..), Compiler(..),
compilerVersion, PackageDB(..))
PackageDB(..))
import Distribution.Simple.Program (ConfiguredProgram, programPath,
programArgs, rawSystemProgram,
lookupProgram, ghcPkgProgram)
......@@ -74,7 +74,6 @@ import Distribution.Simple.Setup (RegisterFlags(..), CopyDest(..),
import Distribution.PackageDescription (setupMessage, PackageDescription(..),
BuildInfo(..), Library(..), haddockName)
import Distribution.Package (PackageIdentifier(..), showPackageId)
import Distribution.Version (Version(..))
import Distribution.Verbosity
import Distribution.InstalledPackageInfo
(InstalledPackageInfo, showInstalledPackageInfo,
......@@ -82,9 +81,6 @@ import Distribution.InstalledPackageInfo
import qualified Distribution.InstalledPackageInfo as IPI
import Distribution.Simple.Utils (createDirectoryIfMissingVerbose,
copyFileVerbose, die, info)
import Distribution.Simple.GHC.PackageConfig (mkGHCPackageConfig, showGHCPackageConfig)
import qualified Distribution.Simple.GHC.PackageConfig
as GHC (localPackageConfig, canWriteLocalPackageConfig, maybeCreateLocalPackageConfig)
import Distribution.System
import System.FilePath ((</>), (<.>), isAbsolute)
......@@ -123,8 +119,7 @@ register pkg_descr lbi regFlags
setupMessage (fromFlag $ regVerbose regFlags) "No package to register" pkg_descr
return ()
| otherwise = do
let ghc_63_plus = compilerVersion (compiler lbi) >= Version [6,3] []
isWindows = case os of Windows _ -> True; _ -> False
let isWindows = case os of Windows _ -> True; _ -> False
genScript = fromFlag (regGenScript regFlags)
genPkgConf = isJust (fromFlag (regGenPkgConf regFlags))
genPkgConfigDefault = showPackageId (package pkg_descr) <.> "conf"
......@@ -143,19 +138,9 @@ register pkg_descr lbi regFlags
case compilerFlavor (compiler lbi) of
GHC -> do
config_flags <- case packageDB of
GlobalPackageDB -> return []
UserPackageDB
| ghc_63_plus -> return ["--user"]
| otherwise -> do
GHC.maybeCreateLocalPackageConfig
localConf <- GHC.localPackageConfig
pkgConfWriteable <- GHC.canWriteLocalPackageConfig
when (not pkgConfWriteable && not genScript)
$ userPkgConfErr localConf
return ["--config-file=" ++ localConf]
SpecificPackageDB db
| ghc_63_plus -> return ["-package-conf", db]
| otherwise -> return ["--config-file=" ++ db]
GlobalPackageDB -> return []
UserPackageDB -> return ["--user"]
SpecificPackageDB db -> return ["-package-conf", db]
let instConf | genPkgConf = genPkgConfigFile
| inplace = inplacePkgConfigFile
......@@ -165,15 +150,10 @@ register pkg_descr lbi regFlags
info verbosity ("create " ++ instConf)
writeInstalledConfig pkg_descr lbi inplace (Just instConf)
let register_flags
| ghc_63_plus = let conf = if genScript && not isWindows
let register_flags = let conf = if genScript && not isWindows
then ["-"]
else [instConf]
in "update" : conf
| otherwise = let conf = if genScript && not isWindows
then []
else ["--input-file="++instConf]
in "--update-package" : conf
let allFlags = config_flags ++ register_flags
let Just pkgTool = lookupProgram ghcPkgProgram (withPrograms lbi)
......@@ -195,11 +175,6 @@ register pkg_descr lbi regFlags
NHC -> when (verbosity >= normal) $ putStrLn "registering nhc98 (nothing to do)"
_ -> die ("only registering with GHC/Hugs/jhc/nhc98 is implemented")
userPkgConfErr :: String -> IO a
userPkgConfErr local_conf =
die ("--user flag passed, but cannot write to local package config: "
++ local_conf )
-- -----------------------------------------------------------------------------
-- The installed package config
......@@ -218,17 +193,8 @@ writeInstalledConfig pkg_descr lbi inplace instConfOverride = do
showInstalledConfig :: PackageDescription -> LocalBuildInfo -> Bool
-> IO String
showInstalledConfig pkg_descr lbi inplace
| (case compilerFlavor hc of GHC -> True; _ -> False) &&
compilerVersion hc < Version [6,3] []
= if inplace then
error "--inplace not supported for GHC < 6.3"
else
return (showGHCPackageConfig (mkGHCPackageConfig pkg_descr lbi))
| otherwise
= do cfg <- mkInstalledPackageInfo pkg_descr lbi inplace
return (showInstalledPackageInfo cfg)
where
hc = compiler lbi
removeInstalledConfig :: IO ()
removeInstalledConfig = do
......@@ -323,8 +289,7 @@ mkInstalledPackageInfo pkg_descr lbi inplace = do
unregister :: PackageDescription -> LocalBuildInfo -> RegisterFlags -> IO ()
unregister pkg_descr lbi regFlags = do
let ghc_63_plus = compilerVersion (compiler lbi) >= Version [6,3] []
genScript = fromFlag (regGenScript regFlags)
let genScript = fromFlag (regGenScript regFlags)
verbosity = fromFlag (regVerbose regFlags)
packageDB = fromFlagOrDefault (withPackageDB lbi) (regPackageDB regFlags)
installDirs = absoluteInstallDirs pkg_descr lbi NoCopyDest
......@@ -332,23 +297,11 @@ unregister pkg_descr lbi regFlags = do
case compilerFlavor (compiler lbi) of
GHC -> do
config_flags <- case packageDB of
GlobalPackageDB -> return []
UserPackageDB
| ghc_63_plus -> return ["--user"]
| otherwise -> do
GHC.maybeCreateLocalPackageConfig
localConf <- GHC.localPackageConfig
pkgConfWriteable <- GHC.canWriteLocalPackageConfig
when (not pkgConfWriteable && not genScript)
$ userPkgConfErr localConf
return ["--config-file=" ++ localConf]
SpecificPackageDB db
| ghc_63_plus -> return ["-package-conf", db]
| otherwise -> return ["--config-file=" ++ db]
let removeCmd = if ghc_63_plus
then ["unregister",showPackageId (package pkg_descr)]
else ["--remove-package="++(pkgName $ package pkg_descr)]
GlobalPackageDB -> return []
UserPackageDB -> return ["--user"]
SpecificPackageDB db -> return ["-package-conf", db]
let removeCmd = ["unregister",showPackageId (package pkg_descr)]
let Just pkgTool = lookupProgram ghcPkgProgram (withPrograms lbi)
allArgs = removeCmd ++ config_flags
if genScript
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment