Re-add cabal exec after failed rebase

Conflicts:
	cabal-install/Main.hs

Cabal/Distribution/Simple/GHC.hs

@@ -44,6 +44,7 @@ module Distribution.Simple.GHC (
         componentGhcOptions,
         ghcLibDir,
         ghcDynamic,
+        ghcGlobalPackageDB,
  ) where
 
 import qualified Distribution.Simple.GHC.IPI641 as IPI641
@@ -549,6 +550,13 @@ ghcLibDir' verbosity ghcProg =
     (reverse . dropWhile isSpace . reverse) `fmap`
      rawSystemProgramStdout verbosity ghcProg ["--print-libdir"]
 
+
+-- | Return the 'FilePath' to the global GHC package database.
+ghcGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
+ghcGlobalPackageDB verbosity ghcProg =
+    (reverse . dropWhile isSpace . reverse) `fmap`
+     rawSystemProgramStdout verbosity ghcProg ["--print-global-package-db"]
+
 -- Cabal does not use the environment variable GHC_PACKAGE_PATH; let users
 -- know that this is the case. See ticket #335. Simply ignoring it is not a
 -- good idea, since then ghc and cabal are looking at different sets of

cabal-install/Distribution/Client/Sandbox/PackageEnvironment.hs

@@ -19,6 +19,7 @@ module Distribution.Client.Sandbox.PackageEnvironment (
   , showPackageEnvironment
   , showPackageEnvironmentWithComments
   , setPackageDB
+  , sandboxPackageDBPath
   , loadUserConfig
 
   , basePackageEnvironment
@@ -210,14 +211,23 @@ initialPackageEnvironment sandboxDir compiler platform = do
        }
     }
 
+-- | Return the path to the sandbox package database.
+sandboxPackageDBPath :: FilePath -> Compiler -> Platform -> String
+sandboxPackageDBPath sandboxDir compiler platform =
+    sandboxDir
+         </> (Text.display platform ++ "-"
+             ++ showCompilerId compiler
+             ++ "-packages.conf.d")
+
+
 -- | Use the package DB location specific for this compiler.
 setPackageDB :: FilePath -> Compiler -> Platform -> ConfigFlags -> ConfigFlags
 setPackageDB sandboxDir compiler platform configFlags =
   configFlags {
-    configPackageDBs = [Just (SpecificPackageDB $ sandboxDir
-                              </> (Text.display platform ++ "-"
-                                   ++ showCompilerId compiler
-                                   ++ "-packages.conf.d"))]
+    configPackageDBs = [Just (SpecificPackageDB $ sandboxPackageDBPath
+                                                      sandboxDir
+                                                      compiler
+                                                      platform)]
     }
 
 -- | Almost the same as 'savedConf `mappend` pkgEnv', but some settings are

cabal-install/Distribution/Client/Setup.hs

@@ -34,6 +34,7 @@ module Distribution.Client.Setup
     , sdistCommand, SDistFlags(..), SDistExFlags(..), ArchiveFormat(..)
     , win32SelfUpgradeCommand, Win32SelfUpgradeFlags(..)
     , sandboxCommand, defaultSandboxLocation, SandboxFlags(..)
+    , execCommand, ExecFlags(..)
 
     , parsePackageArgs
     --TODO: stop exporting these:
@@ -1608,6 +1609,44 @@ instance Monoid SandboxFlags where
     }
     where combine field = field a `mappend` field b
 
+-- ------------------------------------------------------------
+-- * Exec Flags
+-- ------------------------------------------------------------
+
+data ExecFlags = ExecFlags {
+  execVerbosity :: Flag Verbosity
+}
+
+defaultExecFlags :: ExecFlags
+defaultExecFlags = ExecFlags {
+  execVerbosity = toFlag normal
+  }
+
+execCommand :: CommandUI ExecFlags
+execCommand = CommandUI {
+  commandName         = "exec",
+  commandSynopsis     = "Run a command with the cabal environment",
+  commandDescription  = Nothing,
+  commandUsage        = \pname ->
+       "Usage: " ++ pname ++ " exec [FLAGS] COMMAND [-- [ARGS...]]\n\n"
+    ++ "Flags for exec:",
+
+  commandDefaultFlags = defaultExecFlags,
+  commandOptions      = \_ ->
+    [ optionVerbosity execVerbosity
+      (\v flags -> flags { execVerbosity = v })
+    ]
+  }
+
+instance Monoid ExecFlags where
+  mempty = ExecFlags {
+    execVerbosity = mempty
+    }
+  mappend a b = ExecFlags {
+    execVerbosity = combine execVerbosity
+    }
+    where combine field = field a `mappend` field b
+
 -- ------------------------------------------------------------
 -- * GetOpt Utils
 -- ------------------------------------------------------------

cabal-install/Main.hs

@@ -36,6 +36,7 @@ import Distribution.Client.Setup
          , SDistFlags(..), SDistExFlags(..), sdistCommand
          , Win32SelfUpgradeFlags(..), win32SelfUpgradeCommand
          , SandboxFlags(..), sandboxCommand
+         , ExecFlags(..), execCommand
          , reportCommand
          )
 import Distribution.Simple.Setup
@@ -77,6 +78,7 @@ import Distribution.Client.Sandbox            (sandboxInit
                                               ,sandboxListSources
                                               ,sandboxHcPkg
                                               ,dumpPackageEnvironment
+                                              ,withSandboxBinDirOnSearchPath
 
                                               ,getSandboxConfigFilePath
                                               ,loadConfigOrSandboxConfig
@@ -93,6 +95,7 @@ import Distribution.Client.Sandbox            (sandboxInit
                                               ,configPackageDB')
 import Distribution.Client.Sandbox.PackageEnvironment
                                               (setPackageDB
+                                              ,sandboxPackageDBPath
                                               ,userPackageEnvironmentFile)
 import Distribution.Client.Sandbox.Timestamp  (maybeAddCompilerTimestampRecord)
 import Distribution.Client.Sandbox.Types      (UseSandbox(..), whenUsingSandbox)
@@ -119,11 +122,14 @@ import Distribution.Simple.Configure
          , ConfigStateFileErrorType(..), localBuildInfoFile
          , getPersistBuildConfig, tryGetPersistBuildConfig )
 import qualified Distribution.Simple.LocalBuildInfo as LBI
-import Distribution.Simple.Program (defaultProgramConfiguration)
+import Distribution.Simple.GHC (ghcGlobalPackageDB)
+import Distribution.Simple.Program (defaultProgramConfiguration, lookupProgram, ghcProgram)
+import Distribution.Simple.Program.Run (getEffectiveEnvironment)
 import qualified Distribution.Simple.Setup as Cabal
 import Distribution.Simple.Utils
-         ( cabalVersion, die, notice, info, topHandler
-         , findPackageDesc, tryFindPackageDesc )
+         ( cabalVersion, debug, die, notice, info, topHandler
+         , findPackageDesc, tryFindPackageDesc , rawSystemExit
+         , rawSystemExitWithEnv )
 import Distribution.Text
          ( display )
 import Distribution.Verbosity as Verbosity
@@ -215,6 +221,7 @@ mainWorker args = topHandler $
                               `commandAddAction` replAction
       ,sandboxCommand         `commandAddAction` sandboxAction
       ,haddockCommand         `commandAddAction` haddockAction
+      ,execCommand            `commandAddAction` execAction
       ,wrapperAction copyCommand
                      copyVerbosity     copyDistPref
       ,wrapperAction cleanCommand
@@ -1010,6 +1017,37 @@ sandboxAction sandboxFlags extraArgs globalFlags = do
   where
     noExtraArgs = (<1) . length
 
+execAction :: ExecFlags -> [String] -> GlobalFlags -> IO ()
+execAction execFlags extraArgs globalFlags = do
+  let verbosity = fromFlag (execVerbosity execFlags)
+  (useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags
+                           mempty
+  case extraArgs of
+    (exec:args) -> do
+      case useSandbox of
+          NoSandbox ->
+              rawSystemExit verbosity exec args
+          (UseSandbox sandboxDir) -> do
+              let configFlags = savedConfigureFlags config
+              (comp, platform, conf) <- configCompilerAux' configFlags
+              withSandboxBinDirOnSearchPath sandboxDir $ do
+                  menv <- newEnv sandboxDir comp platform conf verbosity
+                  case menv of
+                      Just env -> rawSystemExitWithEnv verbosity exec args env
+                      Nothing  -> rawSystemExit        verbosity exec args
+    -- Error handling.
+    [] -> die $ "Please specify an executable to run"
+  where
+    newEnv sandboxDir comp platform conf verbosity = do
+        let s = sandboxPackageDBPath sandboxDir comp platform
+        case lookupProgram ghcProgram conf of
+            Nothing -> do
+                debug verbosity "sandbox exec only works with GHC"
+                exitFailure
+            Just ghcProg ->  do
+                g <- ghcGlobalPackageDB verbosity ghcProg
+                getEffectiveEnvironment [("GHC_PACKAGE_PATH", Just $ s ++ ":" ++ g)]
+
 -- | See 'Distribution.Client.Install.withWin32SelfUpgrade' for details.
 --
 win32SelfUpgradeAction :: Win32SelfUpgradeFlags -> [String] -> GlobalFlags