Commit d3da19f7 authored by Simon Marlow's avatar Simon Marlow
Browse files

Implement "setup register --inplace", and a few other minor things

 
There are a few changes in this patch:
 
   - New flag to register, --inplace.  "setup register --inplace"
     registers the package for use in the build tree, i.e. without
     installing.  It works with GHC only, currently.
     
   - The parameters to RegisterCmd, UnregisterCmd and InstallCmd are a
     legacy from before the time of hooks (or something) and don't
     serve any purpose any more, AFAICT.  So I removed them.
 
   - I don't think "setup register" worked propertly before if
     --user was given to configure.  It does now.

   - New flag to register: --with-hc-pkg (just the same as when
     given to configure, but lets you override it at register-time)
parent c3ee35e1
......@@ -134,8 +134,8 @@ defaultMainNoRead pkg_descr
-- CopyPrefix is backwards compat, DEPRECATED
maybeExit $ system $ ("make " ++ cmd)
InstallCmd uInst -> do
((InstallFlags _ _), _, args) <- parseInstallArgs (InstallFlags uInst 0) args []
InstallCmd -> do
((InstallFlags _ _), _, args) <- parseInstallArgs emptyInstallFlags args []
no_extra_flags args
maybeExit $ system $ "make install"
retVal <- exec "make register"
......@@ -164,11 +164,11 @@ defaultMainNoRead pkg_descr
SDistCmd -> basicCommand "SDist" "make dist" (parseSDistArgs args [])
RegisterCmd uInst genScript -> basicCommand "Register" "make register"
(parseRegisterArgs (RegisterFlags uInst genScript 0) args [])
RegisterCmd -> basicCommand "Register" "make register"
(parseRegisterArgs emptyRegisterFlags args [])
UnregisterCmd uInst genScript -> basicCommand "Unregister" "make unregister"
(parseUnregisterArgs (RegisterFlags uInst genScript 0) args [])
UnregisterCmd -> basicCommand "Unregister" "make unregister"
(parseUnregisterArgs emptyRegisterFlags args [])
ProgramaticaCmd -> basicCommand "Programatica" "make programatica"
(parseProgramaticaArgs args [])
......
......@@ -44,10 +44,12 @@ module Distribution.Setup (--parseArgs,
module Distribution.Compiler,
Action(..),
ConfigFlags(..), emptyConfigFlags, configureArgs,
CopyFlags(..), CopyDest(..), InstallFlags(..),
CopyFlags(..), CopyDest(..),
InstallFlags(..), emptyInstallFlags,
BuildFlags(..), CleanFlags(..), HaddockFlags(..), PFEFlags(..),
RegisterFlags(..), SDistFlags(..),
InstallUserFlag(..),
RegisterFlags(..), emptyRegisterFlags,
SDistFlags(..),
MaybeUserFlag(..), userOverride,
--optionHelpString,
#ifdef DEBUG
hunitTests,
......@@ -68,10 +70,8 @@ import HUnit (Test(..))
import Distribution.Compiler (CompilerFlavor(..), Compiler(..))
import Distribution.Simple.Utils (die)
import Distribution.Program(ProgramLocation(..), ProgramConfiguration(..),
Program(..),
defaultProgramConfiguration, userSpecifyPath,
userSpecifyArgs, haddockProgram)
import Distribution.Program(ProgramConfiguration(..),
userSpecifyPath, userSpecifyArgs)
import Data.List(find)
import Data.FiniteMap(keysFM)
import Distribution.GetOpt
......@@ -82,18 +82,18 @@ import System.Environment
-- type CommandLineOpts = (Action,
-- [String]) -- The un-parsed remainder
data Action = ConfigCmd ConfigFlags -- config
| BuildCmd -- build
| CleanCmd -- clean
| CopyCmd CopyDest -- copy (--destdir flag)
| HaddockCmd -- haddock
| ProgramaticaCmd -- pfesetup
| InstallCmd InstallUserFlag -- install (install-prefix) (--user flag)
| SDistCmd -- sdist
| TestCmd -- test
| RegisterCmd Bool Bool -- register (--user flag, --gen-script)
| UnregisterCmd Bool Bool -- unregister (--user flag, --gen-script)
| HelpCmd -- help
data Action = ConfigCmd ConfigFlags -- config
| BuildCmd -- build
| CleanCmd -- clean
| CopyCmd CopyDest -- copy (--destdir flag)
| HaddockCmd -- haddock
| ProgramaticaCmd -- pfesetup
| InstallCmd -- install (install-prefix)
| SDistCmd -- sdist
| TestCmd -- test
| RegisterCmd -- register
| UnregisterCmd -- unregister
| HelpCmd -- help
-- | NoCmd -- error case, help case.
-- | TestCmd 1.0?
-- | BDist -- 1.0
......@@ -177,23 +177,44 @@ data CopyDest
| CopyPrefix FilePath -- DEPRECATED
deriving (Eq, Show)
data InstallUserFlag = InstallUserNone -- ^no --user OR --global flag.
| InstallUserUser -- ^--user flag
| InstallUserGlobal -- ^--global flag
data MaybeUserFlag = MaybeUserNone -- ^no --user OR --global flag.
| MaybeUserUser -- ^--user flag
| MaybeUserGlobal -- ^--global flag
-- |A 'MaybeUserFlag' overrides the default --user setting
userOverride :: MaybeUserFlag -> Bool -> Bool
MaybeUserUser `userOverride` _ = True
MaybeUserGlobal `userOverride` _ = False
_ `userOverride` r = r
-- | Flags to @install@: (user package, verbose)
data InstallFlags = InstallFlags {installUserFlags::InstallUserFlag
data InstallFlags = InstallFlags {installUserFlags::MaybeUserFlag
,installVerbose :: Int}
emptyInstallFlags :: InstallFlags
emptyInstallFlags = InstallFlags{ installUserFlags=MaybeUserNone,
installVerbose=0 }
-- | Flags to @sdist@: (snapshot, verbose)
data SDistFlags = SDistFlags {sDistSnapshot::Bool
,sDistVerbose:: Int}
-- | Flags to @register@ and @unregister@: (user package, gen-script, verbose)
data RegisterFlags = RegisterFlags {regUserPackage::Bool
-- | Flags to @register@ and @unregister@: (user package, gen-script,
-- in-place, verbose)
data RegisterFlags = RegisterFlags {regUser::MaybeUserFlag
,regGenScript::Bool
,regInPlace::Bool
,regWithHcPkg::Maybe FilePath
,regVerbose::Int}
emptyRegisterFlags :: RegisterFlags
emptyRegisterFlags = RegisterFlags { regUser=MaybeUserNone,
regGenScript=False,
regInPlace=False,
regWithHcPkg=Nothing,
regVerbose=0 }
-- Following only have verbose flags, but for consistency and
-- extensibility we make them into a type.
data BuildFlags = BuildFlags {buildVerbose :: Int}
......@@ -227,6 +248,7 @@ data Flag a = GhcFlag | NhcFlag | HugsFlag | JhcFlag
| UserFlag | GlobalFlag
-- for register & unregister
| GenScriptFlag
| InPlaceFlag
-- For copy:
| InstPrefix FilePath
| DestDir FilePath
......@@ -293,6 +315,10 @@ cmd_verbose = Option "v" ["verbose"] (OptArg verboseFlag "n") "Control verbosity
where
verboseFlag mb_s = Verbose (maybe 3 read mb_s)
cmd_with_hc_pkg :: OptDescr (Flag a)
cmd_with_hc_pkg = Option "" ["with-hc-pkg"] (reqPathArg WithHcPkg)
"give the path to the package tool"
-- Do we have any other interesting global flags?
globalOptions :: [OptDescr (Flag a)]
globalOptions = [
......@@ -376,8 +402,7 @@ configureCmd progConf = Cmd {
Option "" ["hugs"] (NoArg HugsFlag) "compile with hugs",
Option "w" ["with-compiler"] (reqPathArg WithCompiler)
"give the path to a particular compiler",
Option "" ["with-hc-pkg"] (reqPathArg WithHcPkg)
"give the path to the package tool",
cmd_with_hc_pkg,
Option "" ["prefix"] (reqDirArg Prefix)
"bake this prefix in preparation of installation",
Option "" ["bindir"] (reqDirArg BinDir)
......@@ -556,7 +581,7 @@ installCmd = Cmd {
Option "" ["global"] (NoArg GlobalFlag)
"(default; override with configure) upon registration, register this package in the system-wide package database"
],
cmdAction = InstallCmd InstallUserNone
cmdAction = InstallCmd
}
copyCmd :: Cmd a
......@@ -588,8 +613,8 @@ parseInstallArgs :: InstallFlags -> [String] -> [OptDescr a] ->
parseInstallArgs = parseArgs installCmd updateCfg
where updateCfg (InstallFlags uFlag verbose) fl = case fl of
InstPrefix _ -> error "--install-prefix is obsolete. Use copy command instead."
UserFlag -> (InstallFlags InstallUserUser verbose)
GlobalFlag -> (InstallFlags InstallUserGlobal verbose)
UserFlag -> (InstallFlags MaybeUserUser verbose)
GlobalFlag -> (InstallFlags MaybeUserGlobal verbose)
Verbose n -> (InstallFlags uFlag n)
_ -> error $ "Unexpected flag!"
......@@ -634,20 +659,25 @@ registerCmd = Cmd {
"upon registration, register this package in the user's local package database",
Option "" ["global"] (NoArg GlobalFlag)
"(default) upon registration, register this package in the system-wide package database",
Option "" ["inplace"] (NoArg InPlaceFlag)
"register the package in the build location, so it can be used without being installed",
Option "" ["gen-script"] (NoArg GenScriptFlag)
"Instead of performing the register command, generate a script to register later"
"Instead of performing the register command, generate a script to register later",
cmd_with_hc_pkg
],
cmdAction = RegisterCmd False False
cmdAction = RegisterCmd
}
parseRegisterArgs :: RegisterFlags -> [String] -> [OptDescr a] ->
IO (RegisterFlags, [a], [String])
parseRegisterArgs = parseArgs registerCmd updateCfg
where updateCfg (RegisterFlags uFlag genScriptFlag verbose) fl = case fl of
UserFlag -> (RegisterFlags True genScriptFlag verbose)
GlobalFlag -> (RegisterFlags False genScriptFlag verbose)
Verbose n -> (RegisterFlags uFlag genScriptFlag n)
GenScriptFlag -> (RegisterFlags uFlag True verbose)
where updateCfg reg fl = case fl of
UserFlag -> reg { regUser=MaybeUserUser }
GlobalFlag -> reg { regUser=MaybeUserGlobal }
Verbose n -> reg { regVerbose=n }
GenScriptFlag -> reg { regGenScript=True }
InPlaceFlag -> reg { regInPlace=True }
WithHcPkg f -> reg { regWithHcPkg=Just f }
_ -> error $ "Unexpected flag!"
unregisterCmd :: Cmd a
......@@ -664,7 +694,7 @@ unregisterCmd = Cmd {
"Instead of performing the unregister command, generate a script to unregister later"
],
cmdAction = UnregisterCmd False False
cmdAction = UnregisterCmd
}
parseUnregisterArgs :: RegisterFlags -> [String] -> [OptDescr a] ->
......
......@@ -82,13 +82,14 @@ import Distribution.Simple.Register ( register, unregister,
regScriptLocation, unregScriptLocation
)
import Distribution.Simple.Configure(LocalBuildInfo(..), getPersistBuildConfig, maybeGetPersistBuildConfig,
findProgram, configure, writePersistBuildConfig,
import Distribution.Simple.Configure(getPersistBuildConfig, maybeGetPersistBuildConfig,
configure, writePersistBuildConfig,
localBuildInfoFile)
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), distPref, srcPref)
import Distribution.Simple.Install(install)
import Distribution.Simple.Utils (die, currentDir, rawSystemVerbose,
defaultPackageDesc, defaultHookedPackageDesc,
moduleToFilePath, findFile, distPref, srcPref)
moduleToFilePath, findFile)
#if mingw32_HOST_OS || mingw32_TARGET_OS
import Distribution.Simple.Utils (rawSystemPath)
#endif
......@@ -101,7 +102,7 @@ import System.Directory(removeFile, doesFileExist, doesDirectoryExist)
import Distribution.License
import Control.Monad(when, unless)
import Data.List ( intersperse, unionBy )
import Data.Maybe ( isNothing, isJust, fromJust )
import Data.Maybe ( isJust, fromJust )
import System.IO.Error (try)
import Distribution.GetOpt
......@@ -269,8 +270,7 @@ defaultMainWorker :: PackageDescription
-> Maybe UserHooks
-> IO ExitCode
defaultMainWorker pkg_descr_in action args hooks
= do let pps = allSuffixHandlers hooks
case action of
= do case action of
ConfigCmd flags -> do
(flags, optFns, args) <-
parseConfigureArgs (allPrograms hooks) flags args [buildDirOpt]
......@@ -323,8 +323,8 @@ defaultMainWorker pkg_descr_in action args hooks
cmdHook copyHook pkg_descr localbuildinfo flags
postHook postCopy args flags pkg_descr localbuildinfo
InstallCmd uInst -> do
(flags@(InstallFlags uInst verbose), _, args) <- parseInstallArgs (InstallFlags uInst 0) args []
InstallCmd -> do
(flags, _, args) <- parseInstallArgs emptyInstallFlags args []
pkg_descr <- hookOrInArgs preInst args flags
localbuildinfo <- getPersistBuildConfig
......@@ -332,7 +332,6 @@ defaultMainWorker pkg_descr_in action args hooks
postHook postInst args flags pkg_descr localbuildinfo
SDistCmd -> do
let srcPref = distPref `joinFileName` "src"
(flags,_, args) <- parseSDistArgs args []
pkg_descr <- hookOrInArgs preSDist args flags
maybeLocalbuildinfo <- maybeGetPersistBuildConfig
......@@ -349,16 +348,16 @@ defaultMainWorker pkg_descr_in action args hooks
when (isFailure out) (exitWith out)
return out
RegisterCmd uInst genScript -> do
(flags, _, args) <- parseRegisterArgs (RegisterFlags uInst genScript 0) args []
RegisterCmd -> do
(flags, _, args) <- parseRegisterArgs emptyRegisterFlags args []
pkg_descr <- hookOrInArgs preReg args flags
localbuildinfo <- getPersistBuildConfig
cmdHook regHook pkg_descr localbuildinfo flags
postHook postReg args flags pkg_descr localbuildinfo
UnregisterCmd uInst genScript -> do
(flags,_, args) <- parseUnregisterArgs (RegisterFlags uInst genScript 0) args []
UnregisterCmd -> do
(flags,_, args) <- parseUnregisterArgs emptyRegisterFlags args []
pkg_descr <- hookOrInArgs preUnreg args flags
localbuildinfo <- getPersistBuildConfig
......@@ -646,21 +645,22 @@ defaultUserHooks
putStrLn $ "Reading parameters from " ++ infoFile
readHookedBuildInfo infoFile
defaultInstallHook :: PackageDescription -> LocalBuildInfo
-> Maybe UserHooks ->InstallFlags -> IO ()
defaultInstallHook pkg_descr localbuildinfo _ (InstallFlags uInstFlag verbose) = do
let uInst = case uInstFlag of
InstallUserUser -> True
InstallUserGlobal -> False --over-rides configure setting
-- no flag, check how it was configured:
InstallUserNone -> userConf localbuildinfo
install pkg_descr localbuildinfo (CopyFlags NoCopyDest verbose)
when (hasLibs pkg_descr)
(register pkg_descr localbuildinfo (RegisterFlags uInst False verbose))
when (hasLibs pkg_descr) $
register pkg_descr localbuildinfo emptyRegisterFlags{ regUser=uInstFlag }
defaultBuildHook :: PackageDescription -> LocalBuildInfo
-> Maybe UserHooks -> BuildFlags -> IO ()
defaultBuildHook pkg_descr localbuildinfo hooks flags = do
build pkg_descr localbuildinfo flags (allSuffixHandlers hooks)
when (hasLibs pkg_descr) $
writeInstalledConfig pkg_descr localbuildinfo
writeInstalledConfig pkg_descr localbuildinfo False
defaultRegHook :: PackageDescription -> LocalBuildInfo
-> Maybe UserHooks -> RegisterFlags -> IO ()
defaultRegHook pkg_descr localbuildinfo _ flags =
if hasLibs pkg_descr
then register pkg_descr localbuildinfo flags
......
......@@ -64,7 +64,7 @@ module Distribution.Simple.Register (
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), mkLibDir)
import Distribution.Compiler (CompilerFlavor(..), Compiler(..))
import Distribution.Setup (RegisterFlags(..), CopyDest(..))
import Distribution.Setup (RegisterFlags(..), CopyDest(..), userOverride)
import Distribution.PackageDescription (setupMessage, PackageDescription(..),
BuildInfo(..), Library(..))
import Distribution.Package (PackageIdentifier(..), showPackageId)
......@@ -84,7 +84,7 @@ import Distribution.Compat.Directory
)
import Distribution.Compat.FilePath (joinFileName)
import System.Directory(doesFileExist, removeFile)
import System.Directory(doesFileExist, removeFile, getCurrentDirectory)
import System.IO.Error (try)
import Control.Monad (when, unless)
......@@ -111,28 +111,27 @@ unregScriptLocation = "unregister.sh"
-- -----------------------------------------------------------------------------
-- Registration
-- |Be sure to call writeInstalledConfig first. If the --user flag
-- was passed, and ~\/.ghc-packages is writable, or can be created,
-- then we use that file, perhaps creating it.
register :: PackageDescription -> LocalBuildInfo
-> RegisterFlags -- ^Install in the user's database?; verbose
-> IO ()
register pkg_descr lbi (RegisterFlags userInst genScript verbose)
register pkg_descr lbi regFlags
| isNothing (library pkg_descr) = do
setupMessage "No package to register" pkg_descr
return ()
| otherwise = do
let ghc_63_plus = compilerVersion (compiler lbi) >= Version [6,3] []
genScript = regGenScript regFlags
verbose = regVerbose regFlags
user = regUser regFlags `userOverride` userConf lbi
inplace = regInPlace regFlags
setupMessage (if genScript
then ("Writing registration script: " ++ regScriptLocation)
else "Registering")
pkg_descr
case compilerFlavor (compiler lbi) of
GHC -> do
let ghc_63_plus = compilerVersion (compiler lbi) >= Version [6,3] []
config_flags <-
if userInst
if user
then if ghc_63_plus
then return ["--user"]
else do
......@@ -144,40 +143,46 @@ register pkg_descr lbi (RegisterFlags userInst genScript verbose)
return ["--config-file=" ++ localConf]
else return []
instConfExists <- doesFileExist installedPkgConfigFile
let instConf = if inplace then inplacePkgConfigFile
else installedPkgConfigFile
instConfExists <- doesFileExist instConf
when (not instConfExists && not genScript) $ do
when (verbose > 0) $
putStrLn ("create "++installedPkgConfigFile)
writeInstalledConfig pkg_descr lbi
putStrLn ("create " ++ instConf)
writeInstalledConfig pkg_descr lbi inplace
let register_flags
let register_flags
| ghc_63_plus = "update":
#if !(mingw32_HOST_OS || mingw32_TARGET_OS)
if genScript
then []
else
#endif
[installedPkgConfigFile]
[instConf]
| otherwise = "--update-package":
#if !(mingw32_HOST_OS || mingw32_TARGET_OS)
if genScript
then []
else
#endif
["--input-file="++installedPkgConfigFile]
["--input-file="++instConf]
let allFlags = register_flags
++ config_flags
++ if ghc_63_plus && genScript then ["-"] else []
let pkgTool = compilerPkgTool (compiler lbi)
let pkgTool = case regWithHcPkg regFlags of
Just f -> f
Nothing -> compilerPkgTool (compiler lbi)
if genScript
then rawSystemPipe regScriptLocation verbose
(showInstalledConfig pkg_descr lbi)
then do cfg <- showInstalledConfig pkg_descr lbi inplace
rawSystemPipe regScriptLocation verbose cfg
pkgTool allFlags
else rawSystemExit verbose pkgTool allFlags
Hugs -> do
when inplace $ die "--inplace is not supported with Hugs"
createDirectoryIfMissing True (hugsPackageDir pkg_descr lbi)
copyFileVerbose verbose installedPkgConfigFile
(hugsPackageDir pkg_descr lbi `joinFileName` "package.conf")
......@@ -189,40 +194,61 @@ userPkgConfErr local_conf =
die ("--user flag passed, but cannot write to local package config: "
++ local_conf )
-- |Register doesn't drop the register info file, it must be done in a separate step.
writeInstalledConfig :: PackageDescription -> LocalBuildInfo -> IO ()
writeInstalledConfig pkg_descr lbi = do
let pkg_config = showInstalledConfig pkg_descr lbi
writeFile installedPkgConfigFile (pkg_config ++ "\n")
-- -----------------------------------------------------------------------------
-- The installed package config
-- |Register doesn't drop the register info file, it must be done in a
-- separate step.
writeInstalledConfig :: PackageDescription -> LocalBuildInfo -> Bool -> IO ()
writeInstalledConfig pkg_descr lbi inplace = do
pkg_config <- showInstalledConfig pkg_descr lbi inplace
writeFile (if inplace then inplacePkgConfigFile else installedPkgConfigFile)
(pkg_config ++ "\n")
-- |Create a string suitable for writing out to the package config file
showInstalledConfig :: PackageDescription -> LocalBuildInfo -> String
showInstalledConfig pkg_descr lbi
= let hc = compiler lbi
in case compilerFlavor hc of
GHC | compilerVersion hc < Version [6,3] [] ->
showGHCPackageConfig (mkGHCPackageConfig pkg_descr lbi)
_ -> showInstalledPackageInfo (mkInstalledPackageInfo pkg_descr lbi)
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 = try (removeFile installedPkgConfigFile) >> return ()
removeInstalledConfig = do
try (removeFile installedPkgConfigFile) >> return ()
try (removeFile inplacePkgConfigFile) >> return ()
installedPkgConfigFile :: String
installedPkgConfigFile = ".installed-pkg-config"
inplacePkgConfigFile :: String
inplacePkgConfigFile = ".inplace-pkg-config"
-- -----------------------------------------------------------------------------
-- Making the InstalledPackageInfo
mkInstalledPackageInfo
:: PackageDescription
-> LocalBuildInfo
-> InstalledPackageInfo
mkInstalledPackageInfo pkg_descr lbi
= let
-> Bool
-> IO InstalledPackageInfo
mkInstalledPackageInfo pkg_descr lbi inplace = do
pwd <- getCurrentDirectory
let
lib = fromJust (library pkg_descr) -- checked for Nothing earlier
bi = libBuildInfo lib
in
emptyInstalledPackageInfo{
build_dir = pwd `joinFileName` buildDir lbi
--
return
emptyInstalledPackageInfo{
IPI.package = package pkg_descr,
IPI.license = license pkg_descr,
IPI.copyright = copyright pkg_descr,
......@@ -236,8 +262,11 @@ mkInstalledPackageInfo pkg_descr lbi
IPI.exposed = True,
IPI.exposedModules = exposedModules lib,
IPI.hiddenModules = otherModules bi,
IPI.importDirs = [mkLibDir pkg_descr lbi NoCopyDest],
IPI.libraryDirs = (mkLibDir pkg_descr lbi NoCopyDest) : extraLibDirs bi,
IPI.importDirs = [if inplace then build_dir else
mkLibDir pkg_descr lbi NoCopyDest],
IPI.libraryDirs = (if inplace then build_dir else
mkLibDir pkg_descr lbi NoCopyDest)
: extraLibDirs bi,
IPI.hsLibraries = ["HS" ++ showPackageId (package pkg_descr)],
IPI.extraLibraries = extraLibs bi,
IPI.includeDirs = includeDirs bi,
......@@ -250,19 +279,22 @@ mkInstalledPackageInfo pkg_descr lbi
IPI.frameworks = frameworks bi,
IPI.haddockInterfaces = [],
IPI.haddockHTMLs = []
}
}
-- -----------------------------------------------------------------------------
-- Unregistration
unregister :: PackageDescription -> LocalBuildInfo -> RegisterFlags -> IO ()
unregister pkg_descr lbi (RegisterFlags user_unreg genScript verbose) = do
unregister pkg_descr lbi regFlags = do
setupMessage "Unregistering" pkg_descr
let ghc_63_plus = compilerVersion (compiler lbi) >= Version [6,3] []
genScript = regGenScript regFlags
verbose = regVerbose regFlags
user = regUser regFlags `userOverride` userConf lbi
case compilerFlavor (compiler lbi) of
GHC -> do
config_flags <-
if user_unreg
if user
then if ghc_63_plus
then return ["--user"]
else do
......@@ -274,7 +306,10 @@ unregister pkg_descr lbi (RegisterFlags user_unreg genScript verbose) = do
let removeCmd = if ghc_63_plus
then ["unregister",showPackageId (package pkg_descr)]
else ["--remove-package="++(pkgName $ package pkg_descr)]
rawSystemEmit unregScriptLocation genScript verbose (compilerPkgTool (compiler lbi))
let pkgTool = case regWithHcPkg regFlags of
Just f -> f
Nothing -> compilerPkgTool (compiler lbi)
rawSystemEmit unregScriptLocation genScript verbose pkgTool
(removeCmd++config_flags)
Hugs -> do
try $ removeDirectoryRecursive (hugsPackageDir pkg_descr lbi)
......
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