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

Simplify HcPkg.register interface

Remove the variants reregister and registerMultiInstance and generalise
the main register variant to cover them all. Introduce a RegisterOptions
record for the variations.

Eliminate an unused form where we supply a file rather than an
InstalledPackageInfo value.

The motivation is so we can more easily add yet more variations shortly.

This is an API change.
parent 8d3e1203
......@@ -220,8 +220,11 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
(mkAbiHash "inplace") lib' lbi clbi
debug verbosity $ "Registering inplace:\n" ++ (IPI.showInstalledPackageInfo installedPkgInfo)
registerPackage verbosity (compiler lbi) (withPrograms lbi) HcPkg.MultiInstance
registerPackage verbosity (compiler lbi) (withPrograms lbi)
(withPackageDB lbi) installedPkgInfo
HcPkg.defaultRegisterOptions {
HcPkg.registerMultiInstance = True
}
return (Just installedPkgInfo)
else return Nothing
......@@ -279,8 +282,11 @@ buildComponent verbosity numJobs pkg_descr lbi0 suffixes
-- NB: need to enable multiple instances here, because on 7.10+
-- the package name is the same as the library, and we still
-- want the registration to go through.
registerPackage verbosity (compiler lbi) (withPrograms lbi) HcPkg.MultiInstance
registerPackage verbosity (compiler lbi) (withPrograms lbi)
(withPackageDB lbi) ipi
HcPkg.defaultRegisterOptions {
HcPkg.registerMultiInstance = True
}
let ebi = buildInfo exe
exe' = exe { buildInfo = addExtraCSources ebi extras }
buildExe verbosity numJobs pkg_descr lbi exe' exeClbi
......
......@@ -1626,18 +1626,13 @@ hcPkgInfo progdb = HcPkg.HcPkgInfo { HcPkg.hcPkgProgram = ghcPkgProg
registerPackage
:: Verbosity
-> ProgramDb
-> HcPkg.MultiInstance
-> PackageDBStack
-> InstalledPackageInfo
-> HcPkg.RegisterOptions
-> IO ()
registerPackage verbosity progdb multiInstance packageDbs installedPkgInfo
| HcPkg.MultiInstance <- multiInstance
= HcPkg.registerMultiInstance (hcPkgInfo progdb) verbosity
packageDbs installedPkgInfo
| otherwise
= HcPkg.reregister (hcPkgInfo progdb) verbosity
packageDbs (Right installedPkgInfo)
registerPackage verbosity progdb packageDbs installedPkgInfo registerOptions =
HcPkg.register (hcPkgInfo progdb) verbosity packageDbs
installedPkgInfo registerOptions
pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO FilePath
pkgRoot verbosity lbi = pkgRoot'
......
......@@ -806,18 +806,13 @@ adjustExts hiSuf objSuf opts =
registerPackage :: Verbosity
-> ProgramDb
-> HcPkg.MultiInstance
-> PackageDBStack
-> InstalledPackageInfo
-> HcPkg.RegisterOptions
-> IO ()
registerPackage verbosity progdb multiInstance packageDbs installedPkgInfo
| HcPkg.MultiInstance <- multiInstance
= HcPkg.registerMultiInstance (hcPkgInfo progdb) verbosity
packageDbs installedPkgInfo
| otherwise
= HcPkg.reregister (hcPkgInfo progdb) verbosity
packageDbs (Right installedPkgInfo)
registerPackage verbosity progdb packageDbs installedPkgInfo registerOptions =
HcPkg.register (hcPkgInfo progdb) verbosity packageDbs
installedPkgInfo registerOptions
componentGhcOptions :: Verbosity -> LocalBuildInfo
-> BuildInfo -> ComponentLocalBuildInfo -> FilePath
......
......@@ -758,10 +758,11 @@ registerPackage
-> ProgramDb
-> PackageDBStack
-> InstalledPackageInfo
-> HcPkg.RegisterOptions
-> IO ()
registerPackage verbosity progdb packageDbs installedPkgInfo =
HcPkg.reregister (hcPkgInfo progdb) verbosity packageDbs
(Right installedPkgInfo)
registerPackage verbosity progdb packageDbs installedPkgInfo registerOptions =
HcPkg.register (hcPkgInfo progdb) verbosity packageDbs
installedPkgInfo registerOptions
hcPkgInfo :: ProgramDb -> HcPkg.HcPkgInfo
hcPkgInfo progdb = HcPkg.HcPkgInfo { HcPkg.hcPkgProgram = lhcPkgProg
......
......@@ -13,14 +13,15 @@
-- Currently only GHC, GHCJS and LHC have hc-pkg programs.
module Distribution.Simple.Program.HcPkg (
-- * Types
HcPkgInfo(..),
MultiInstance(..),
RegisterOptions(..),
defaultRegisterOptions,
-- * Actions
init,
invoke,
register,
reregister,
registerMultiInstance,
unregister,
recache,
expose,
......@@ -32,8 +33,6 @@ module Distribution.Simple.Program.HcPkg (
-- * Program invocations
initInvocation,
registerInvocation,
reregisterInvocation,
registerMultiInstanceInvocation,
unregisterInvocation,
recacheInvocation,
exposeInvocation,
......@@ -80,9 +79,6 @@ data HcPkgInfo = HcPkgInfo
, recacheMultiInstance :: Bool -- ^ supports multi-instance via recache
}
-- | Whether or not use multi-instance functionality.
data MultiInstance = MultiInstance | NoMultiInstance
deriving (Show, Read, Eq, Ord)
-- | Call @hc-pkg@ to initialise a package database at the location {path}.
--
......@@ -106,39 +102,38 @@ invoke hpi verbosity dbStack extraArgs =
args = packageDbStackOpts hpi dbStack ++ extraArgs
invocation = programInvocation (hcPkgProgram hpi) args
-- | Additional variations in the behaviour for 'register'.
data RegisterOptions = RegisterOptions {
-- | Allows re-registering \/ overwriting an existing package
registerAllowOverwrite :: Bool,
-- | Insist on the ability to register multiple instances of a
-- single version of a single package. This will fail if the @hc-pkg@
-- does not support it, see 'nativeMultiInstance' and
-- 'recacheMultiInstance'.
registerMultiInstance :: Bool
}
-- | Defaults are @True@, @False@ and @False@
defaultRegisterOptions :: RegisterOptions
defaultRegisterOptions = RegisterOptions {
registerAllowOverwrite = True,
registerMultiInstance = False
}
-- | Call @hc-pkg@ to register a package.
--
-- > hc-pkg register {filename | -} [--user | --global | --package-db]
--
register :: HcPkgInfo -> Verbosity -> PackageDBStack
-> Either FilePath
InstalledPackageInfo
-> InstalledPackageInfo
-> RegisterOptions
-> IO ()
register hpi verbosity packagedb pkgFile =
runProgramInvocation verbosity
(registerInvocation hpi verbosity packagedb pkgFile)
-- | Call @hc-pkg@ to re-register a package.
--
-- > hc-pkg register {filename | -} [--user | --global | --package-db]
--
reregister :: HcPkgInfo -> Verbosity -> PackageDBStack
-> Either FilePath
InstalledPackageInfo
-> IO ()
reregister hpi verbosity packagedb pkgFile =
runProgramInvocation verbosity
(reregisterInvocation hpi verbosity packagedb pkgFile)
registerMultiInstance :: HcPkgInfo -> Verbosity
-> PackageDBStack
-> InstalledPackageInfo
-> IO ()
registerMultiInstance hpi verbosity packagedbs pkgInfo
| nativeMultiInstance hpi
= runProgramInvocation verbosity
(registerMultiInstanceInvocation hpi verbosity packagedbs (Right pkgInfo))
register hpi verbosity packagedbs pkgInfo registerOptions
| registerMultiInstance registerOptions
, not (nativeMultiInstance hpi || recacheMultiInstance hpi)
= die' verbosity $ "HcPkg.register: the compiler does not support "
++ "registering multiple instances of packages."
-- This is a trick. Older versions of GHC do not support the
-- --enable-multi-instance flag for ghc-pkg register but it turns out that
......@@ -149,14 +144,15 @@ registerMultiInstance hpi verbosity packagedbs pkgInfo
-- to write the package registration file directly into the package db and
-- then call hc-pkg recache.
--
| recacheMultiInstance hpi
| registerMultiInstance registerOptions
, recacheMultiInstance hpi
= do let pkgdb = last packagedbs
writeRegistrationFileDirectly verbosity hpi pkgdb pkgInfo
recache hpi verbosity pkgdb
| otherwise
= die' verbosity $ "HcPkg.registerMultiInstance: the compiler does not support "
++ "registering multiple instances of packages."
= runProgramInvocation verbosity
(registerInvocation hpi verbosity packagedbs pkgInfo registerOptions)
writeRegistrationFileDirectly :: Verbosity
-> HcPkgInfo
......@@ -363,35 +359,28 @@ initInvocation hpi verbosity path =
args = ["init", path]
++ verbosityOpts hpi verbosity
registerInvocation, reregisterInvocation, registerMultiInstanceInvocation
registerInvocation
:: HcPkgInfo -> Verbosity -> PackageDBStack
-> Either FilePath InstalledPackageInfo
-> InstalledPackageInfo
-> RegisterOptions
-> ProgramInvocation
registerInvocation = registerInvocation' "register" NoMultiInstance
reregisterInvocation = registerInvocation' "update" NoMultiInstance
registerMultiInstanceInvocation = registerInvocation' "update" MultiInstance
registerInvocation' :: String -> MultiInstance
-> HcPkgInfo -> Verbosity -> PackageDBStack
-> Either FilePath InstalledPackageInfo
-> ProgramInvocation
registerInvocation' cmdname multiInstance hpi
verbosity packagedbs pkgFileOrInfo =
case pkgFileOrInfo of
Left pkgFile ->
programInvocation (hcPkgProgram hpi) (args pkgFile)
Right pkgInfo ->
(programInvocation (hcPkgProgram hpi) (args "-")) {
progInvokeInput = Just (showInstalledPackageInfo pkgInfo),
progInvokeInputEncoding = IOEncodingUTF8
}
registerInvocation hpi verbosity packagedbs pkgInfo registerOptions =
(programInvocation (hcPkgProgram hpi) (args "-")) {
progInvokeInput = Just (showInstalledPackageInfo pkgInfo),
progInvokeInputEncoding = IOEncodingUTF8
}
where
cmdname
| registerAllowOverwrite registerOptions = "update"
| registerMultiInstance registerOptions = "update"
| otherwise = "register"
args file = [cmdname, file]
++ (if noPkgDbStack hpi
then [packageDbOpts hpi (last packagedbs)]
else packageDbStackOpts hpi packagedbs)
++ [ "--enable-multi-instance" | multiInstance == MultiInstance ]
++ [ "--enable-multi-instance"
| registerMultiInstance registerOptions ]
++ verbosityOpts hpi verbosity
unregisterInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId
......
......@@ -40,6 +40,8 @@ module Distribution.Simple.Register (
abiHash,
invokeHcPkg,
registerPackage,
HcPkg.RegisterOptions(..),
HcPkg.defaultRegisterOptions,
generateRegistrationInfo,
inplaceInstalledPackageInfo,
absoluteInstalledPackageInfo,
......@@ -168,7 +170,7 @@ registerAll pkg lbi regFlags ipis
(libraryComponentName (IPI.sourceLibName ipi))
(Just (IPI.instantiatedWith ipi))
registerPackage verbosity (compiler lbi) (withPrograms lbi)
HcPkg.NoMultiInstance packageDbs ipi
packageDbs ipi HcPkg.defaultRegisterOptions
where
modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags))
......@@ -339,17 +341,17 @@ withHcPkg verbosity name comp progdb f =
registerPackage :: Verbosity
-> Compiler
-> ProgramDb
-> HcPkg.MultiInstance
-> PackageDBStack
-> InstalledPackageInfo
-> HcPkg.RegisterOptions
-> IO ()
registerPackage verbosity comp progdb multiInstance packageDbs installedPkgInfo =
registerPackage verbosity comp progdb packageDbs installedPkgInfo registerOptions =
case compilerFlavor comp of
GHC -> GHC.registerPackage verbosity progdb multiInstance packageDbs installedPkgInfo
GHCJS -> GHCJS.registerPackage verbosity progdb multiInstance packageDbs installedPkgInfo
_ | HcPkg.MultiInstance == multiInstance
GHC -> GHC.registerPackage verbosity progdb packageDbs installedPkgInfo registerOptions
GHCJS -> GHCJS.registerPackage verbosity progdb packageDbs installedPkgInfo registerOptions
_ | HcPkg.registerMultiInstance registerOptions
-> die' verbosity "Registering multiple package instances is not yet supported for this compiler"
LHC -> LHC.registerPackage verbosity progdb packageDbs installedPkgInfo
LHC -> LHC.registerPackage verbosity progdb packageDbs installedPkgInfo registerOptions
UHC -> UHC.registerPackage verbosity comp progdb packageDbs installedPkgInfo
JHC -> notice verbosity "Registering for jhc (nothing to do)"
HaskellSuite {} ->
......@@ -363,8 +365,9 @@ writeHcPkgRegisterScript :: Verbosity
-> IO ()
writeHcPkgRegisterScript verbosity ipis packageDbs hpi = do
let genScript installedPkgInfo =
let invocation = HcPkg.reregisterInvocation hpi Verbosity.normal
packageDbs (Right installedPkgInfo)
let invocation = HcPkg.registerInvocation hpi Verbosity.normal
packageDbs installedPkgInfo
HcPkg.defaultRegisterOptions
in invocationAsSystemScript buildOS invocation
scripts = map genScript ipis
-- TODO: Do something more robust here
......
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