Commit 749a4e6b authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Move registering to per-compiler modules, fix inplace register for hugs

parent ea28f84d
......@@ -65,6 +65,7 @@ module Distribution.Simple.GHC (
buildLib, buildExe,
installLib, installExe,
libAbiHash,
registerPackage,
ghcOptions,
ghcVerbosityOptions,
ghcPackageDbOptions,
......@@ -945,3 +946,19 @@ updateLibArchive verbosity lbi path
(ranlib, _) <- requireProgram verbosity ranlibProgram (withPrograms lbi)
rawSystemProgram verbosity ranlib [path]
| otherwise = return ()
-- -----------------------------------------------------------------------------
-- Registering
registerPackage
:: Verbosity
-> InstalledPackageInfo
-> PackageDescription
-> LocalBuildInfo
-> Bool
-> PackageDBStack
-> IO ()
registerPackage verbosity installedPkgInfo _pkg lbi _inplace packageDbs = do
let Just ghcPkg = lookupProgram ghcPkgProgram (withPrograms lbi)
HcPkg.reregister verbosity ghcPkg packageDbs (Right installedPkgInfo)
......@@ -46,17 +46,18 @@ module Distribution.Simple.Hugs (
getInstalledPackages,
buildLib,
buildExe,
install
install,
registerPackage,
) where
import Distribution.Package
( PackageName, PackageIdentifier(..), InstalledPackageId(..)
, packageName )
import Distribution.InstalledPackageInfo
( InstalledPackageInfo
( InstalledPackageInfo, emptyInstalledPackageInfo
, InstalledPackageInfo_( InstalledPackageInfo, installedPackageId
, sourcePackageId )
, emptyInstalledPackageInfo, parseInstalledPackageInfo )
, parseInstalledPackageInfo, showInstalledPackageInfo )
import Distribution.PackageDescription
( PackageDescription(..), BuildInfo(..), hcOptions,
Executable(..), withExe, Library(..), withLib, libModules )
......@@ -79,14 +80,17 @@ import Distribution.Simple.PreProcess ( ppCpp, runSimplePreProcessor )
import Distribution.Simple.PreProcess.Unlit
( unlit )
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), ComponentLocalBuildInfo(..) )
( LocalBuildInfo(..), ComponentLocalBuildInfo(..)
, InstallDirs(..), absoluteInstallDirs )
import Distribution.Simple.BuildPaths
( autogenModuleName, autogenModulesDir,
dllExtension )
import Distribution.Simple.Setup
( CopyDest(..) )
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, installOrdinaryFiles
, withUTF8FileContents, writeFileAtomic, copyFileVerbose
, findFile, findFileWithExtension, findModuleFiles
, withUTF8FileContents, writeFileAtomic, writeUTF8File
, copyFileVerbose, findFile, findFileWithExtension, findModuleFiles
, rawSystemStdInOut
, die, info, notice )
import Language.Haskell.Extension
......@@ -591,3 +595,24 @@ hugsInstallSuffixes = [".hs", ".lhs", dllExtension]
hugsMainFilename :: Executable -> FilePath
hugsMainFilename exe = "Main" <.> ext
where ext = takeExtension (modulePath exe)
-- -----------------------------------------------------------------------------
-- Registering
registerPackage
:: Verbosity
-> InstalledPackageInfo
-> PackageDescription
-> LocalBuildInfo
-> Bool
-> PackageDBStack
-> IO ()
registerPackage verbosity installedPkgInfo pkg lbi inplace _packageDbs = do
--TODO: prefer to have it based on the packageDbs, but how do we know
-- the package subdir based on the name? the user can set crazy libsubdir
let installDirs = absoluteInstallDirs pkg lbi NoCopyDest
pkgdir | inplace = buildDir lbi
| otherwise = libdir installDirs
createDirectoryIfMissingVerbose verbosity True pkgdir
writeUTF8File (pkgdir </> "package.conf")
(showInstalledPackageInfo installedPkgInfo)
......@@ -64,6 +64,7 @@ module Distribution.Simple.LHC (
configure, getInstalledPackages,
buildLib, buildExe,
installLib, installExe,
registerPackage,
ghcOptions,
ghcVerbosityOptions
) where
......@@ -98,6 +99,7 @@ import Distribution.Simple.Program
, arProgram, ranlibProgram, ldProgram
, gccProgram, stripProgram
, lhcProgram, lhcPkgProgram )
import qualified Distribution.Simple.Program.HcPkg as HcPkg
import Distribution.Simple.Compiler
( CompilerFlavor(..), CompilerId(..), Compiler(..), compilerVersion
, OptimisationLevel(..), PackageDB(..), PackageDBStack
......@@ -797,3 +799,18 @@ updateLibArchive verbosity lbi path =
"Unable to generate a symbol index for the static "
++ "library '" ++ path
++ "' (missing the 'ranlib' and 'ar' programs)"
-- -----------------------------------------------------------------------------
-- Registering
registerPackage
:: Verbosity
-> InstalledPackageInfo
-> PackageDescription
-> LocalBuildInfo
-> Bool
-> PackageDBStack
-> IO ()
registerPackage verbosity installedPkgInfo _pkg lbi _inplace packageDbs = do
let Just lhcPkg = lookupProgram lhcPkgProgram (withPrograms lbi)
HcPkg.reregister verbosity lhcPkg packageDbs (Right installedPkgInfo)
......@@ -68,7 +68,9 @@ import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), ComponentLocalBuildInfo(..)
, InstallDirs(..), absoluteInstallDirs )
import Distribution.Simple.BuildPaths (haddockName)
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.LHC as LHC
import qualified Distribution.Simple.Hugs as Hugs
import Distribution.Simple.Compiler
( compilerVersion, CompilerFlavor(..), compilerFlavor
, PackageDBStack, registrationPackageDB )
......@@ -90,7 +92,7 @@ import Distribution.InstalledPackageInfo
, showInstalledPackageInfo )
import qualified Distribution.InstalledPackageInfo as IPI
import Distribution.Simple.Utils
( createDirectoryIfMissingVerbose, writeUTF8File, writeFileAtomic
( writeUTF8File, writeFileAtomic
, die, notice, setupMessage )
import Distribution.System
( OS(..), buildOS )
......@@ -107,7 +109,6 @@ import System.Directory
( getCurrentDirectory, removeDirectoryRecursive )
import System.IO.Error (try)
import Control.Monad (when)
import Data.Maybe
( isJust, fromMaybe, maybeToList )
import Data.List (partition)
......@@ -208,38 +209,14 @@ registerPackage :: Verbosity
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 packageDbs
LHC -> registerPackageLHC verbosity installedPkgInfo pkg lbi inplace packageDbs
Hugs -> registerPackageHugs verbosity installedPkgInfo pkg lbi inplace packageDbs
GHC -> GHC.registerPackage verbosity installedPkgInfo pkg lbi inplace packageDbs
LHC -> LHC.registerPackage verbosity installedPkgInfo pkg lbi inplace packageDbs
Hugs -> Hugs.registerPackage 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"
registerPackageGHC, registerPackageLHC, registerPackageHugs
:: Verbosity
-> InstalledPackageInfo
-> PackageDescription
-> LocalBuildInfo
-> Bool
-> PackageDBStack
-> IO ()
registerPackageGHC verbosity installedPkgInfo _pkg lbi _inplace packageDbs = do
let Just ghcPkg = lookupProgram ghcPkgProgram (withPrograms lbi)
HcPkg.reregister verbosity ghcPkg packageDbs (Right installedPkgInfo)
registerPackageLHC verbosity installedPkgInfo _pkg lbi _inplace packageDbs = do
let Just lhcPkg = lookupProgram lhcPkgProgram (withPrograms lbi)
HcPkg.reregister verbosity lhcPkg packageDbs (Right installedPkgInfo)
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)
writeUTF8File (libdir installDirs </> "package.conf")
(showInstalledPackageInfo installedPkgInfo)
writeHcPkgRegisterScript :: Verbosity
-> InstalledPackageInfo
-> ConfiguredProgram
......
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