Fix build-tools PATH usage with per-component new-build

Signed-off-by: Edward Z. Yang <[email protected]>

Author: ezyang

cabal-install/Distribution/Client/Configure.hs

@@ -203,6 +203,7 @@ configureSetupScript packageDBs
     , useDistPref              = distPref
     , useLoggingHandle         = Nothing
     , useWorkingDir            = Nothing
+    , useExtraPathEnv          = []
     , setupCacheLock           = lock
     , useWin32CleanHack        = False
     , forceExternalSetupMethod = forceExternal

cabal-install/Distribution/Client/ProjectBuilding.hs

@@ -1199,6 +1199,8 @@ buildInplaceUnpackedPackage verbosity
                                         pkg buildStatus
                                         allSrcFiles buildResult
 
+        -- PURPOSELY omitted: no copy!
+
         mipkg <- whenReRegister $
                  annotateFailureNoLog InstallFailed $ do
           -- Register locally

cabal-install/Distribution/Client/ProjectPlanning.hs

@@ -1060,9 +1060,9 @@ elaborateInstallPlan platform compiler compilerprogdb
         internalPkgSet = pkgInternalPackages pkg
         comps_graph = Cabal.mkComponentsGraph (pkgEnabled pkg) pd internalPkgSet
 
-        buildComponent :: (Map PackageName ConfiguredId, Map String ConfiguredId)
+        buildComponent :: (Map PackageName ConfiguredId, Map String (ConfiguredId, FilePath))
                      -> (Cabal.Component, [Cabal.ComponentName])
-                     -> ((Map PackageName ConfiguredId, Map String ConfiguredId),
+                     -> ((Map PackageName ConfiguredId, Map String (ConfiguredId, FilePath)),
                          ElaboratedComponent)
         buildComponent (internal_map, exe_map) (comp, _cdeps) =
             ((internal_map', exe_map'), ecomp)
@@ -1079,6 +1079,8 @@ elaborateInstallPlan platform compiler compilerprogdb
                         internal_lib_deps,
                     elabComponentExeDependencies =
                         internal_exe_deps,
+                    elabComponentExeDependencyPaths =
+                        internal_exe_dep_paths,
                     elabComponentInstallDirs = installDirs,
                     -- These are filled in later
                     elabComponentBuildTargets = [],
@@ -1106,11 +1108,12 @@ elaborateInstallPlan platform compiler compilerprogdb
                 = [ confid'
                 | Dependency pkgname _ <- PD.targetBuildDepends bi
                 , Just confid' <- [Map.lookup pkgname internal_map] ]
-            internal_exe_deps
-                = [ confInstId confid'
+            (internal_exe_deps, internal_exe_dep_paths)
+                = unzip $
+                  [ (confInstId confid', path)
                   | Dependency (PackageName toolname) _ <- PD.buildTools bi
                   , toolname `elem` map PD.exeName (PD.executables pd)
-                  , Just confid' <- [Map.lookup toolname exe_map]
+                  , Just (confid', path) <- [Map.lookup toolname exe_map]
                   ]
             internal_map' = case cname of
                 CLibName
@@ -1119,8 +1122,25 @@ elaborateInstallPlan platform compiler compilerprogdb
                     -> Map.insert (PackageName libname) confid internal_map
                 _   -> internal_map
             exe_map' = case cname of
-                CExeName exename -> Map.insert exename confid exe_map
-                _                -> exe_map
+                CExeName exename
+                    -> Map.insert exename (confid, inplace_bin_dir) exe_map
+                _   -> exe_map
+            -- NB: For inplace NOT InstallPaths.bindir installDirs; for an
+            -- inplace build those values are utter nonsense.  So we
+            -- have to guess where the directory is going to be.
+            -- Fortunately this is "stable" part of Cabal API.
+            -- But the way we get the build directory is A HORRIBLE
+            -- HACK.
+            inplace_bin_dir
+              | shouldBuildInplaceOnly spkg
+              = distBuildDirectory
+                    (elabDistDirParams elaboratedSharedConfig (ElabComponent ecomp)) </>
+                    "build" </> case Cabal.componentNameString cname of
+                                    Just n -> n
+                                    Nothing -> ""
+              | otherwise
+              = InstallDirs.bindir installDirs
+
 
             installDirs
               | shouldBuildInplaceOnly spkg
@@ -2044,7 +2064,7 @@ setupHsScriptOptions :: ElaboratedReadyPackage
                      -> SetupScriptOptions
 -- TODO: Fix this so custom is a separate component.  Custom can ALWAYS
 -- be a separate component!!!
-setupHsScriptOptions (ReadyPackage (getElaboratedPackage -> ElaboratedPackage{..}))
+setupHsScriptOptions (ReadyPackage pkg_or_comp)
                      ElaboratedSharedConfig{..} srcdir builddir
                      isParallelBuild cacheLock =
     SetupScriptOptions {
@@ -2062,10 +2082,13 @@ setupHsScriptOptions (ReadyPackage (getElaboratedPackage -> ElaboratedPackage{..
       useDistPref              = builddir,
       useLoggingHandle         = Nothing, -- this gets set later
       useWorkingDir            = Just srcdir,
+      useExtraPathEnv          = elabExeDependencyPaths pkg_or_comp,
       useWin32CleanHack        = False,   --TODO: [required eventually]
       forceExternalSetupMethod = isParallelBuild,
       setupCacheLock           = Just cacheLock
     }
+  where
+    ElaboratedPackage{..} = getElaboratedPackage pkg_or_comp
 
 
 -- | To be used for the input for elaborateInstallPlan.

cabal-install/Distribution/Client/ProjectPlanning/Types.hs

@@ -17,6 +17,7 @@ module Distribution.Client.ProjectPlanning.Types (
     elabInstallDirs,
     elabDistDirParams,
     elabRequiresRegistration,
+    elabExeDependencyPaths,
     elabBuildTargets,
     elabReplTarget,
     elabBuildHaddocks,
@@ -170,6 +171,10 @@ elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool
 elabBuildHaddocks (ElabPackage pkg) = pkgBuildHaddocks pkg
 elabBuildHaddocks (ElabComponent comp) = elabComponentBuildHaddocks comp
 
+elabExeDependencyPaths :: ElaboratedConfiguredPackage -> [FilePath]
+elabExeDependencyPaths (ElabPackage _) = [] -- TODO: not implemented
+elabExeDependencyPaths (ElabComponent comp) = elabComponentExeDependencyPaths comp
+
 getElaboratedPackage :: ElaboratedConfiguredPackage -> ElaboratedPackage
 getElaboratedPackage (ElabPackage pkg) = pkg
 getElaboratedPackage (ElabComponent comp) = elabComponentPackage comp
@@ -209,6 +214,8 @@ data ElaboratedComponent
     -- | The order-only dependencies of this component; e.g.,
     -- if you depend on an executable it goes here.
     elabComponentExeDependencies :: [ComponentId],
+    -- | The file paths of all our executable dependencies.
+    elabComponentExeDependencyPaths :: [FilePath],
     -- | The 'ElaboratedPackage' this component came from
     elabComponentPackage :: ElaboratedPackage,
     -- | What in this component should we build (TRANSIENT, see 'pkgBuildTargets')

cabal-install/Distribution/Client/SetupWrapper.hs

@@ -52,7 +52,7 @@ import Distribution.Simple.Program
          , getProgramSearchPath, getDbProgramOutput, runDbProgram, ghcProgram
          , ghcjsProgram )
 import Distribution.Simple.Program.Find
-         ( programSearchPathAsPATHVar )
+         ( programSearchPathAsPATHVar, ProgramSearchPathEntry(ProgramSearchPathDir) )
 import Distribution.Simple.Program.Run
          ( getEffectiveEnvironment )
 import qualified Distribution.Simple.Program.Strip as Strip
@@ -80,7 +80,7 @@ import Distribution.Simple.Utils
          , createDirectoryIfMissingVerbose, installExecutableFile
          , copyFileVerbose, rewriteFile, intercalate )
 import Distribution.Client.Utils
-         ( inDir, tryCanonicalizePath
+         ( inDir, tryCanonicalizePath, withExtraPathEnv
          , existsAndIsMoreRecentThan, moreRecentFile, withEnv
 #if mingw32_HOST_OS
          , canonicalizePathNoThrow
@@ -160,6 +160,8 @@ data SetupScriptOptions = SetupScriptOptions {
     useDistPref              :: FilePath,
     useLoggingHandle         :: Maybe Handle,
     useWorkingDir            :: Maybe FilePath,
+    -- | Extra things to add to PATH when invoking the setup script.
+    useExtraPathEnv          :: [FilePath],
     forceExternalSetupMethod :: Bool,
 
     -- | List of dependencies to use when building Setup.hs.
@@ -228,6 +230,7 @@ defaultSetupScriptOptions = SetupScriptOptions {
     useDistPref              = defaultDistPref,
     useLoggingHandle         = Nothing,
     useWorkingDir            = Nothing,
+    useExtraPathEnv          = [],
     useWin32CleanHack        = False,
     forceExternalSetupMethod = False,
     setupCacheLock           = Nothing
@@ -304,9 +307,10 @@ internalSetupMethod verbosity options _ bt mkargs = do
   let args = mkargs cabalVersion
   info verbosity $ "Using internal setup method with build-type " ++ show bt
                 ++ " and args:\n  " ++ show args
-  inDir (useWorkingDir options) $
+  inDir (useWorkingDir options) $ do
     withEnv "HASKELL_DIST_DIR" (useDistPref options) $
-      buildTypeAction bt args
+      withExtraPathEnv (useExtraPathEnv options) $
+        buildTypeAction bt args
 
 buildTypeAction :: BuildType -> ([String] -> IO ())
 buildTypeAction Simple    = Simple.defaultMainArgs
@@ -335,7 +339,8 @@ selfExecSetupMethod verbosity options _pkg bt mkargs = do
                                     ++ show logHandle
 
   searchpath <- programSearchPathAsPATHVar
-                (getProgramSearchPath (useProgramConfig options))
+                (map ProgramSearchPathDir (useExtraPathEnv options) ++
+                 getProgramSearchPath (useProgramConfig options))
   env        <- getEffectiveEnvironment [("PATH", Just searchpath)
                                         ,("HASKELL_DIST_DIR", Just (useDistPref options))]
 
@@ -689,7 +694,8 @@ externalSetupMethod verbosity options pkg bt mkargs = do
     where
       doInvoke path' = do
         searchpath <- programSearchPathAsPATHVar
-                      (getProgramSearchPath (useProgramConfig options'))
+                      (map ProgramSearchPathDir (useExtraPathEnv options') ++
+                       getProgramSearchPath (useProgramConfig options'))
         env        <- getEffectiveEnvironment [("PATH", Just searchpath)
                                               ,("HASKELL_DIST_DIR", Just (useDistPref options))]
 

cabal-install/Distribution/Client/Utils.hs

@@ -4,6 +4,7 @@ module Distribution.Client.Utils ( MergeResult(..)
                                  , mergeBy, duplicates, duplicatesBy
                                  , readMaybe
                                  , inDir, withEnv, logDirChange
+                                 , withExtraPathEnv
                                  , determineNumJobs, numberOfProcessors
                                  , removeExistingFile
                                  , withTempFileName
@@ -18,7 +19,7 @@ module Distribution.Client.Utils ( MergeResult(..)
                                  , relaxEncodingErrors)
        where
 
-import Distribution.Compat.Environment ( lookupEnv, setEnv, unsetEnv )
+import Distribution.Compat.Environment
 import Distribution.Compat.Exception   ( catchIO )
 import Distribution.Compat.Time ( getModTime )
 import Distribution.Simple.Setup       ( Flag(..) )
@@ -31,14 +32,15 @@ import Control.Monad
          ( when )
 import Data.Bits
          ( (.|.), shiftL, shiftR )
+import System.FilePath
 import Data.Char
          ( ord, chr )
 #if MIN_VERSION_base(4,6,0)
 import Text.Read
          ( readMaybe )
 #endif
 import Data.List
-         ( isPrefixOf, sortBy, groupBy )
+         ( isPrefixOf, sortBy, groupBy, intercalate )
 import Data.Word
          ( Word8, Word32)
 import Foreign.C.Types ( CInt(..) )
@@ -47,8 +49,6 @@ import qualified Control.Exception as Exception
 import System.Directory
          ( canonicalizePath, doesFileExist, getCurrentDirectory
          , removeFile, setCurrentDirectory )
-import System.FilePath
-         ( (</>), isAbsolute, takeDrive, splitPath, joinPath )
 import System.IO
          ( Handle, hClose, openTempFile
 #if MIN_VERSION_base(4,4,0)
@@ -153,6 +153,23 @@ withEnv k v m = do
     Nothing -> unsetEnv k
     Just old -> setEnv k old)
 
+-- | Executes the action, increasing the PATH environment
+-- in some way
+--
+-- Warning: This operation is NOT thread-safe, because the
+-- environment variables are a process-global concept.
+withExtraPathEnv :: [FilePath] -> IO a -> IO a
+withExtraPathEnv paths m = do
+  oldPathSplit <- getSearchPath
+  let newPath = mungePath $ intercalate [searchPathSeparator] (paths ++ oldPathSplit)
+      oldPath = mungePath $ intercalate [searchPathSeparator] oldPathSplit
+      -- TODO: This is a horrible hack to work around the fact that
+      -- setEnv can't take empty values as an argument
+      mungePath p | p == ""   = "/dev/null"
+                  | otherwise = p
+  setEnv "PATH" newPath
+  m `Exception.finally` setEnv "PATH" oldPath
+
 -- | Log directory change in 'make' compatible syntax
 logDirChange :: (String -> IO ()) -> Maybe FilePath -> IO a -> IO a
 logDirChange _ Nothing m = m

cabal-install/cabal-install.cabal

@@ -77,6 +77,12 @@ Extra-Source-Files:
   tests/IntegrationTests/multiple-source/p/p.cabal
   tests/IntegrationTests/multiple-source/q/Setup.hs
   tests/IntegrationTests/multiple-source/q/q.cabal
+  tests/IntegrationTests/new-build/BuildToolsPath.sh
+  tests/IntegrationTests/new-build/BuildToolsPath/A.hs
+  tests/IntegrationTests/new-build/BuildToolsPath/MyCustomPreprocessor.hs
+  tests/IntegrationTests/new-build/BuildToolsPath/build-tools-path.cabal
+  tests/IntegrationTests/new-build/BuildToolsPath/cabal.project
+  tests/IntegrationTests/new-build/BuildToolsPath/hello/Hello.hs
   tests/IntegrationTests/new-build/T3460.sh
   tests/IntegrationTests/new-build/T3460/C.hs
   tests/IntegrationTests/new-build/T3460/Setup.hs

cabal-install/tests/IntegrationTests/new-build/BuildToolsPath.sh

@@ -0,0 +1,3 @@
+. ./common.sh
+cd BuildToolsPath
+cabal new-build build-tools-path hello-world

cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/A.hs

@@ -0,0 +1,5 @@
+{-# OPTIONS_GHC -F -pgmF my-custom-preprocessor #-}
+module A where
+
+a :: String
+a = "0000"

cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/MyCustomPreprocessor.hs

@@ -0,0 +1,11 @@
+module Main where
+
+import System.Environment
+import System.IO
+
+main :: IO ()
+main = do
+  (_:source:target:_) <- getArgs
+  let f '0' = '1'
+      f c = c
+  writeFile target . map f  =<< readFile source

cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/build-tools-path.cabal

@@ -0,0 +1,25 @@
+name:                build-tools-path
+version:             0.1.0.0
+synopsis:            Checks build-tools are put in PATH
+license:             BSD3
+category:            Testing
+build-type:          Simple
+cabal-version:       >=1.10
+
+executable             my-custom-preprocessor
+  main-is:             MyCustomPreprocessor.hs
+  build-depends:       base, directory
+  default-language:    Haskell2010
+
+library
+  exposed-modules:     A
+  build-depends:       base
+  build-tools:         my-custom-preprocessor
+  -- ^ Note the internal dependency.
+  default-language:    Haskell2010
+
+executable             hello-world
+  main-is:             Hello.hs
+  build-depends:       base, build-tools-path
+  default-language:    Haskell2010
+  hs-source-dirs:      hello

cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/cabal.project

@@ -0,0 +1 @@
+packages: .

cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/hello/Hello.hs

@@ -0,0 +1,6 @@
+module Main where
+
+import A
+
+main :: IO ()
+main = putStrLn a