Add cabal default dir flag

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

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,15 +100,15 @@ 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 _) _) _ _ _)] ->
         configurePackage verbosity
           (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 {

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

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)

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
 

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
 

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 ++ "-"

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.