diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs index ebef58cb4a6..b3cff371a2d 100644 --- a/cabal-install/Distribution/Client/Config.hs +++ b/cabal-install/Distribution/Client/Config.hs @@ -208,7 +208,8 @@ instance Monoid SavedConfig where globalLogsDir = combine globalLogsDir, globalWorldFile = combine globalWorldFile, globalRequireSandbox = combine globalRequireSandbox, - globalIgnoreSandbox = combine globalIgnoreSandbox + globalIgnoreSandbox = combine globalIgnoreSandbox, + globalCabalDir = combine globalCabalDir } where combine = combine' savedGlobalFlags diff --git a/cabal-install/Distribution/Client/Configure.hs b/cabal-install/Distribution/Client/Configure.hs index 03186d4081f..69826a2b154 100644 --- a/cabal-install/Distribution/Client/Configure.hs +++ b/cabal-install/Distribution/Client/Configure.hs @@ -22,7 +22,7 @@ import Distribution.Client.InstallPlan (InstallPlan) import Distribution.Client.IndexUtils as IndexUtils ( getSourcePackages, getInstalledPackages ) import Distribution.Client.Setup - ( ConfigExFlags(..), configureCommand, filterConfigureFlags ) + ( ConfigExFlags(..), GlobalFlags(..), configureCommand, filterConfigureFlags ) import Distribution.Client.Types as Source import Distribution.Client.SetupWrapper ( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions ) @@ -82,9 +82,10 @@ configure :: Verbosity -> ConfigFlags -> ConfigExFlags -> [String] + -> GlobalFlags -> IO () configure verbosity packageDBs repos comp platform conf - configFlags configExFlags extraArgs = do + configFlags configExFlags extraArgs globalFlags = do installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf sourcePkgDb <- getSourcePackages verbosity repos @@ -99,7 +100,7 @@ configure verbosity packageDBs repos comp platform conf Left message -> do info verbosity message setupWrapper verbosity (setupScriptOptions installedPkgIndex) Nothing - configureCommand (const configFlags) extraArgs + configureCommand (const configFlags) extraArgs globalFlags Right installPlan -> case InstallPlan.ready installPlan of [pkg@(ReadyPackage (SourcePackage _ _ (LocalUnpackedPackage _) _) _ _ _)] -> @@ -107,7 +108,7 @@ configure verbosity packageDBs repos comp platform conf (InstallPlan.planPlatform installPlan) (InstallPlan.planCompiler installPlan) (setupScriptOptions installedPkgIndex) - configFlags pkg extraArgs + configFlags pkg extraArgs globalFlags _ -> die $ "internal error: configure install plan should have exactly " ++ "one local ready package." @@ -219,12 +220,13 @@ configurePackage :: Verbosity -> ConfigFlags -> ReadyPackage -> [String] + -> GlobalFlags -> IO () configurePackage verbosity platform comp scriptOptions configFlags - (ReadyPackage (SourcePackage _ gpkg _ _) flags stanzas deps) extraArgs = + (ReadyPackage (SourcePackage _ gpkg _ _) flags stanzas deps) extraArgs globalFlags = setupWrapper verbosity - scriptOptions (Just pkg) configureCommand configureFlags extraArgs + scriptOptions (Just pkg) configureCommand configureFlags extraArgs globalFlags where configureFlags = filterConfigureFlags configFlags { diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index 0ae8c00f1f3..ad95907eb3a 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/cabal-install/Distribution/Client/Install.hs @@ -999,7 +999,7 @@ performInstallations verbosity (packageId pkg) src' distPref $ \mpath -> installUnpackedPackage verbosity buildLimit installLock numJobs pkg_key (setupScriptOptions installedPkgIndex cacheLock) - miscOptions configFlags' installFlags haddockFlags + miscOptions configFlags' installFlags haddockFlags globalFlags cinfo platform pkg pkgoverride mpath useLogFile where @@ -1308,6 +1308,7 @@ installUnpackedPackage -> ConfigFlags -> InstallFlags -> HaddockFlags + -> GlobalFlags -> CompilerInfo -> Platform -> PackageDescription @@ -1317,7 +1318,7 @@ installUnpackedPackage -> IO BuildResult installUnpackedPackage verbosity buildLimit installLock numJobs pkg_key scriptOptions miscOptions - configFlags installFlags haddockFlags + configFlags installFlags haddockFlags globalFlags cinfo platform pkg pkgoverride workingDir useLogFile = do -- Override the .cabal file if necessary @@ -1478,7 +1479,7 @@ installUnpackedPackage verbosity buildLimit installLock numJobs pkg_key scriptOptions { useLoggingHandle = logFileHandle , useWorkingDir = workingDir } (Just pkg) - cmd flags []) + cmd flags [] globalFlags) reexec cmd = do -- look for our own executable file and re-exec ourselves using a helper diff --git a/cabal-install/Distribution/Client/Sandbox.hs b/cabal-install/Distribution/Client/Sandbox.hs index 663dd2582b2..e3ea3014671 100644 --- a/cabal-install/Distribution/Client/Sandbox.hs +++ b/cabal-install/Distribution/Client/Sandbox.hs @@ -637,7 +637,7 @@ withSandboxPackageInfo verbosity configFlags globalFlags -- Get the package ids of modified (and installed) add-source deps. modifiedAddSourceDeps <- listModifiedDeps verbosity sandboxDir - (compilerId comp) platform installedDepsMap + (compilerId comp) platform installedDepsMap globalFlags -- 'fromJust' here is safe because 'modifiedAddSourceDeps' are guaranteed to -- be a subset of the keys of 'depsMap'. let modifiedDeps = [ (modDepPath, fromJust $ M.lookup modDepPath depsMap) diff --git a/cabal-install/Distribution/Client/Sandbox/Timestamp.hs b/cabal-install/Distribution/Client/Sandbox/Timestamp.hs index 09fe78c74cf..888fb353998 100644 --- a/cabal-install/Distribution/Client/Sandbox/Timestamp.hs +++ b/cabal-install/Distribution/Client/Sandbox/Timestamp.hs @@ -46,6 +46,7 @@ import Distribution.Client.Sandbox.Index import Distribution.Client.SetupWrapper (SetupScriptOptions (..), defaultSetupScriptOptions, setupWrapper) +import Distribution.Client.Setup (GlobalFlags(..)) import Distribution.Client.Utils (inDir, removeExistingFile, tryCanonicalizePath, tryFindAddSourcePackageDesc) @@ -212,8 +213,8 @@ withActionOnCompilerTimestamps f sandboxDir compId platform act = do -- | List all source files of a given add-source dependency. Exits with error if -- something is wrong (e.g. there is no .cabal file in the given directory). -- FIXME: This function is not thread-safe because of 'inDir'. -allPackageSourceFiles :: Verbosity -> FilePath -> IO [FilePath] -allPackageSourceFiles verbosity packageDir = inDir (Just packageDir) $ do +allPackageSourceFiles :: Verbosity -> FilePath -> GlobalFlags -> IO [FilePath] +allPackageSourceFiles verbosity packageDir globalFlags = inDir (Just packageDir) $ do pkg <- do let err = "Error reading source files of add-source dependency." desc <- tryFindAddSourcePackageDesc packageDir err @@ -231,7 +232,7 @@ allPackageSourceFiles verbosity packageDir = inDir (Just packageDir) $ do doListSources :: IO [FilePath] doListSources = do - setupWrapper verbosity setupOpts (Just pkg) sdistCommand (const flags) [] + setupWrapper verbosity setupOpts (Just pkg) sdistCommand (const flags) [] globalFlags srcs <- fmap lines . readFile $ file mapM tryCanonicalizePath srcs @@ -249,10 +250,10 @@ allPackageSourceFiles verbosity packageDir = inDir (Just packageDir) $ do return ret -- | Has this dependency been modified since we have last looked at it? -isDepModified :: Verbosity -> EpochTime -> AddSourceTimestamp -> IO Bool -isDepModified verbosity now (packageDir, timestamp) = do +isDepModified :: Verbosity -> GlobalFlags -> EpochTime -> AddSourceTimestamp -> IO Bool +isDepModified verbosity globalFlags now (packageDir, timestamp) = do debug verbosity ("Checking whether the dependency is modified: " ++ packageDir) - depSources <- allPackageSourceFiles verbosity packageDir + depSources <- allPackageSourceFiles verbosity packageDir globalFlags go depSources where @@ -274,14 +275,15 @@ isDepModified verbosity now (packageDir, timestamp) = do listModifiedDeps :: Verbosity -> FilePath -> CompilerId -> Platform -> M.Map FilePath a -- ^ The set of all installed add-source deps. + -> GlobalFlags -> IO [FilePath] -listModifiedDeps verbosity sandboxDir compId platform installedDepsMap = do +listModifiedDeps verbosity sandboxDir compId platform installedDepsMap globalFlags = do timestampRecords <- readTimestampFile (sandboxDir timestampFileName) let needle = timestampRecordKey compId platform timestamps <- maybe noTimestampRecord return (lookup needle timestampRecords) now <- getCurTime - fmap (map fst) . filterM (isDepModified verbosity now) + fmap (map fst) . filterM (isDepModified verbosity globalFlags now) . filter (\ts -> fst ts `M.member` installedDepsMap) $ timestamps diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index d25e97a5db5..e627ce5c180 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -120,7 +120,8 @@ data GlobalFlags = GlobalFlags { globalLogsDir :: Flag FilePath, globalWorldFile :: Flag FilePath, globalRequireSandbox :: Flag Bool, - globalIgnoreSandbox :: Flag Bool + globalIgnoreSandbox :: Flag Bool, + globalCabalDir :: Flag FilePath } defaultGlobalFlags :: GlobalFlags @@ -135,7 +136,8 @@ defaultGlobalFlags = GlobalFlags { globalLogsDir = mempty, globalWorldFile = mempty, globalRequireSandbox = Flag False, - globalIgnoreSandbox = Flag False + globalIgnoreSandbox = Flag False, + globalCabalDir = mempty } globalCommand :: [Command action] -> CommandUI GlobalFlags @@ -310,6 +312,11 @@ globalCommand commands = CommandUI { "The location of the world file" globalWorldFile (\v flags -> flags { globalWorldFile = v }) (reqArgFlag "FILE") + + ,option [] ["cabal-default-dir"] + "The location of the cabal directory" + globalCabalDir (\v flags -> flags { globalCabalDir = v }) + (reqArgFlag "DIR") ] } @@ -325,7 +332,8 @@ instance Monoid GlobalFlags where globalLogsDir = mempty, globalWorldFile = mempty, globalRequireSandbox = mempty, - globalIgnoreSandbox = mempty + globalIgnoreSandbox = mempty, + globalCabalDir = mempty } mappend a b = GlobalFlags { globalVersion = combine globalVersion, @@ -338,7 +346,8 @@ instance Monoid GlobalFlags where globalLogsDir = combine globalLogsDir, globalWorldFile = combine globalWorldFile, globalRequireSandbox = combine globalRequireSandbox, - globalIgnoreSandbox = combine globalIgnoreSandbox + globalIgnoreSandbox = combine globalIgnoreSandbox, + globalCabalDir = combine globalCabalDir } where combine field = field a `mappend` field b diff --git a/cabal-install/Distribution/Client/SetupWrapper.hs b/cabal-install/Distribution/Client/SetupWrapper.hs index 1d257bc78fa..e461a4f6d72 100644 --- a/cabal-install/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/Distribution/Client/SetupWrapper.hs @@ -23,6 +23,7 @@ module Distribution.Client.SetupWrapper ( import qualified Distribution.Make as Make import qualified Distribution.Simple as Simple +import Distribution.Client.Setup ( GlobalFlags(..) ) import Distribution.Version ( Version(..), VersionRange, anyVersion , intersectVersionRanges, orLaterVersion @@ -174,8 +175,9 @@ setupWrapper :: Verbosity -> CommandUI flags -> (Version -> flags) -> [String] + -> GlobalFlags -> IO () -setupWrapper verbosity options mpkg cmd flags extraArgs = do +setupWrapper verbosity options mpkg cmd flags extraArgs globalFlags = do pkg <- maybe getPkg return mpkg let setupMethod = determineSetupMethod options' buildType' options' = options { @@ -188,7 +190,7 @@ setupWrapper verbosity options mpkg cmd flags extraArgs = do : commandShowOptions cmd (flags cabalLibVersion) ++ extraArgs checkBuildType buildType' - setupMethod verbosity options' (packageId pkg) buildType' mkArgs + setupMethod verbosity options' (packageId pkg) buildType' mkArgs globalFlags where getPkg = tryFindPackageDesc (fromMaybe "." (useWorkingDir options)) >>= readPackageDescription verbosity @@ -216,14 +218,14 @@ type SetupMethod = Verbosity -> SetupScriptOptions -> PackageIdentifier -> BuildType - -> (Version -> [String]) -> IO () + -> (Version -> [String]) -> GlobalFlags -> IO () -- ------------------------------------------------------------ -- * Internal SetupMethod -- ------------------------------------------------------------ internalSetupMethod :: SetupMethod -internalSetupMethod verbosity options _ bt mkargs = do +internalSetupMethod verbosity options _ bt mkargs _ = do let args = mkargs cabalVersion debug verbosity $ "Using internal setup method with build-type " ++ show bt ++ " and args:\n " ++ show args @@ -243,7 +245,7 @@ buildTypeAction (UnknownBuildType _) = error "buildTypeAction UnknownBuildType" -- ------------------------------------------------------------ externalSetupMethod :: SetupMethod -externalSetupMethod verbosity options pkg bt mkargs = do +externalSetupMethod verbosity options pkg bt mkargs globalFlags = do debug verbosity $ "Using external setup method with build-type " ++ show bt createDirectoryIfMissingVerbose verbosity True setupDir (cabalLibVersion, mCabalLibInstalledPkgId, options') <- cabalLibVersionToUse @@ -419,7 +421,9 @@ externalSetupMethod verbosity options pkg bt mkargs = do cachedSetupDirAndProg :: SetupScriptOptions -> Version -> IO (FilePath, FilePath) cachedSetupDirAndProg options' cabalLibVersion = do - cabalDir <- defaultCabalDir + cabalDir <- case globalCabalDir globalFlags of + Flag dir -> return dir + NoFlag -> defaultCabalDir let setupCacheDir = cabalDir "setup-exe-cache" cachedSetupProgFile = setupCacheDir ("setup-" ++ buildTypeString ++ "-" diff --git a/cabal-install/Distribution/Client/SrcDist.hs b/cabal-install/Distribution/Client/SrcDist.hs index 437ef838bcd..68046bb7dea 100644 --- a/cabal-install/Distribution/Client/SrcDist.hs +++ b/cabal-install/Distribution/Client/SrcDist.hs @@ -22,7 +22,7 @@ import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose, defaultPackageDesc , die, notice, withTempDirectory ) import Distribution.Client.Setup - ( SDistFlags(..), SDistExFlags(..), ArchiveFormat(..) ) + ( GlobalFlags(..), SDistFlags(..), SDistExFlags(..), ArchiveFormat(..) ) import Distribution.Simple.Setup ( Flag(..), sdistCommand, flagToList, fromFlag, fromFlagOrDefault ) import Distribution.Simple.BuildPaths ( srcPref) @@ -39,8 +39,8 @@ import System.Process (runProcess, waitForProcess) import System.Exit (ExitCode(..)) -- |Create a source distribution. -sdist :: SDistFlags -> SDistExFlags -> IO () -sdist flags exflags = do +sdist :: SDistFlags -> SDistExFlags -> GlobalFlags -> IO () +sdist flags exflags globalFlags = do pkg <- return . flattenPackageDescription =<< readPackageDescription verbosity =<< defaultPackageDesc verbosity @@ -59,7 +59,7 @@ sdist flags exflags = do -- Run 'setup sdist --output-directory=tmpDir' (or -- '--list-source'/'--output-directory=someOtherDir') in case we were passed -- those options. - setupWrapper verbosity setupOpts (Just pkg) sdistCommand (const flags') [] + setupWrapper verbosity setupOpts (Just pkg) sdistCommand (const flags') [] globalFlags -- Unless we were given --list-sources or --output-directory ourselves, -- create an archive. diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs index f25ecebf4f4..de4879ff5ca 100644 --- a/cabal-install/Main.hs +++ b/cabal-install/Main.hs @@ -261,7 +261,7 @@ wrapperAction :: Monoid flags -> Command (GlobalFlags -> IO ()) wrapperAction command verbosityFlag distPrefFlag = commandAddAction command - { commandDefaultFlags = mempty } $ \flags extraArgs _globalFlags -> do + { commandDefaultFlags = mempty } $ \flags extraArgs globalFlags -> do let verbosity = fromFlagOrDefault normal (verbosityFlag flags) setupScriptOptions = defaultSetupScriptOptions { useDistPref = fromFlagOrDefault @@ -269,7 +269,7 @@ wrapperAction command verbosityFlag distPrefFlag = (distPrefFlag flags) } setupWrapper verbosity setupScriptOptions Nothing - command (const flags) extraArgs + command (const flags) extraArgs globalFlags configureAction :: (ConfigFlags, ConfigExFlags) -> [String] -> GlobalFlags -> IO () @@ -305,7 +305,7 @@ configureAction (configFlags, configExFlags) extraArgs globalFlags = do configure verbosity (configPackageDB' configFlags'') (globalRepos globalFlags') - comp platform conf configFlags'' configExFlags' extraArgs + comp platform conf configFlags'' configExFlags' extraArgs globalFlags buildAction :: (BuildFlags, BuildExFlags) -> [String] -> GlobalFlags -> IO () buildAction (buildFlags, buildExFlags) extraArgs globalFlags = do @@ -322,16 +322,16 @@ buildAction (buildFlags, buildExFlags) extraArgs globalFlags = do (buildNumJobs buildFlags) (const Nothing) maybeWithSandboxDirOnSearchPath useSandbox $ - build verbosity config distPref buildFlags extraArgs + build verbosity config distPref buildFlags extraArgs globalFlags -- | Actually do the work of building the package. This is separate from -- 'buildAction' so that 'testAction' and 'benchmarkAction' do not invoke -- 'reconfigure' twice. -build :: Verbosity -> SavedConfig -> FilePath -> BuildFlags -> [String] -> IO () -build verbosity config distPref buildFlags extraArgs = +build :: Verbosity -> SavedConfig -> FilePath -> BuildFlags -> [String] -> GlobalFlags -> IO () +build verbosity config distPref buildFlags extraArgs globalFlags = setupWrapper verbosity setupOptions Nothing - (Cabal.buildCommand progConf) mkBuildFlags extraArgs + (Cabal.buildCommand progConf) mkBuildFlags extraArgs globalFlags where progConf = defaultProgramConfiguration setupOptions = defaultSetupScriptOptions { useDistPref = distPref } @@ -396,7 +396,7 @@ replAction (replFlags, buildExFlags) extraArgs globalFlags = do maybeWithSandboxDirOnSearchPath useSandbox $ setupWrapper verbosity setupOptions Nothing - (Cabal.replCommand progConf) (const replFlags') extraArgs + (Cabal.replCommand progConf) (const replFlags') extraArgs globalFlags -- No .cabal file in the current directory: just start the REPL (possibly -- using the sandbox package DB). @@ -625,11 +625,11 @@ reconfigure verbosity distPref addConfigFlags extraArgs globalFlags installAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) -> [String] -> GlobalFlags -> IO () -installAction (configFlags, _, installFlags, _) _ _globalFlags +installAction (configFlags, _, installFlags, _) _ globalFlags | fromFlagOrDefault False (installOnly installFlags) = let verbosity = fromFlagOrDefault normal (configVerbosity configFlags) in setupWrapper verbosity defaultSetupScriptOptions Nothing - installCommand (const mempty) [] + installCommand (const mempty) [] globalFlags installAction (configFlags, configExFlags, installFlags, haddockFlags) extraArgs globalFlags = do @@ -740,11 +740,11 @@ testAction (testFlags, buildFlags, buildExFlags) extraArgs globalFlags = do | otherwise = extraArgs maybeWithSandboxDirOnSearchPath useSandbox $ - build verbosity config distPref buildFlags' extraArgs' + build verbosity config distPref buildFlags' extraArgs' globalFlags maybeWithSandboxDirOnSearchPath useSandbox $ setupWrapper verbosity setupOptions Nothing - Cabal.testCommand (const testFlags) extraArgs' + Cabal.testCommand (const testFlags) extraArgs' globalFlags benchmarkAction :: (BenchmarkFlags, BuildFlags, BuildExFlags) -> [String] -> GlobalFlags @@ -785,11 +785,11 @@ benchmarkAction (benchmarkFlags, buildFlags, buildExFlags) | otherwise = extraArgs maybeWithSandboxDirOnSearchPath useSandbox $ - build verbosity config distPref buildFlags' extraArgs' + build verbosity config distPref buildFlags' extraArgs' globalFlags maybeWithSandboxDirOnSearchPath useSandbox $ setupWrapper verbosity setupOptions Nothing - Cabal.benchmarkCommand (const benchmarkFlags) extraArgs' + Cabal.benchmarkCommand (const benchmarkFlags) extraArgs' globalFlags haddockAction :: HaddockFlags -> [String] -> GlobalFlags -> IO () haddockAction haddockFlags extraArgs globalFlags = do @@ -803,12 +803,12 @@ haddockAction haddockFlags extraArgs globalFlags = do (haddockDistPref haddockFlags') } setupWrapper verbosity setupScriptOptions Nothing - haddockCommand (const haddockFlags') extraArgs + haddockCommand (const haddockFlags') extraArgs globalFlags cleanAction :: CleanFlags -> [String] -> GlobalFlags -> IO () -cleanAction cleanFlags extraArgs _globalFlags = +cleanAction cleanFlags extraArgs globalFlags = setupWrapper verbosity setupScriptOptions Nothing - cleanCommand (const cleanFlags) extraArgs + cleanCommand (const cleanFlags) extraArgs globalFlags where verbosity = fromFlagOrDefault normal (cleanVerbosity cleanFlags) setupScriptOptions = defaultSetupScriptOptions { @@ -965,10 +965,10 @@ formatAction verbosityFlag extraArgs _globalFlags = do writeGenericPackageDescription path pkgDesc sdistAction :: (SDistFlags, SDistExFlags) -> [String] -> GlobalFlags -> IO () -sdistAction (sdistFlags, sdistExFlags) extraArgs _globalFlags = do +sdistAction (sdistFlags, sdistExFlags) extraArgs globalFlags = do unless (null extraArgs) $ die $ "'sdist' doesn't take any extra arguments: " ++ unwords extraArgs - sdist sdistFlags sdistExFlags + sdist sdistFlags sdistExFlags globalFlags reportAction :: ReportFlags -> [String] -> GlobalFlags -> IO () reportAction reportFlags extraArgs globalFlags = do @@ -1002,7 +1002,7 @@ runAction (buildFlags, buildExFlags) extraArgs globalFlags = do (exe, exeArgs) <- splitRunArgs lbi extraArgs maybeWithSandboxDirOnSearchPath useSandbox $ - build verbosity config distPref buildFlags ["exe:" ++ exeName exe] + build verbosity config distPref buildFlags ["exe:" ++ exeName exe] globalFlags maybeWithSandboxDirOnSearchPath useSandbox $ run verbosity lbi exe exeArgs