From e2580d6f7e589e2755cb6ac317120faa383d4e49 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Mon, 15 Apr 2019 16:55:31 +0300 Subject: [PATCH] Reconfigure on new PATH env var (fixes #3138) --- ChangeLog.md | 4 ++++ src/Stack/Build/ConstructPlan.hs | 9 +++++++-- src/Stack/Build/Execute.hs | 7 ++++++- src/Stack/Storage.hs | 3 +++ src/Stack/Types/Build.hs | 2 ++ 5 files changed, 22 insertions(+), 3 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index a55e5e1e8e..4da6836ef1 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -105,6 +105,10 @@ Behavior changes: can be disabled via the `hide-source-paths` configuration option in `stack.yaml`. See [#3784](https://github.com/commercialhaskell/stack/issues/3784) +* Stack will reconfigure a package if you modify your `PATH` environment + variable. See + [#3138](https://github.com/commercialhaskell/stack/issues/3138). + Other enhancements: * Defer loading up of files for local packages. This allows us to get diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs index 35fd52d50e..d2d29970d3 100644 --- a/src/Stack/Build/ConstructPlan.hs +++ b/src/Stack/Build/ConstructPlan.hs @@ -49,6 +49,7 @@ import Stack.Types.NamedComponent import Stack.Types.Package import Stack.Types.SourceMap import Stack.Types.Version +import System.Environment (lookupEnv) import System.IO (putStrLn) import RIO.PrettyPrint import RIO.Process (findExecutable, HasProcessContext (..)) @@ -124,6 +125,7 @@ data Ctx = Ctx , wanted :: !(Set PackageName) , localNames :: !(Set PackageName) , mcurator :: !(Maybe Curator) + , pathEnvVar :: !Text } instance HasPlatform Ctx @@ -187,7 +189,8 @@ constructPlan baseConfigOpts0 localDumpPkgs loadPackage0 sourceMap installedMap let onTarget = void . addDep let inner = mapM_ onTarget $ Map.keys (smtTargets $ smTargets sourceMap) - let ctx = mkCtx econfig globalCabalVersion sources mcur + pathEnvVar' <- liftIO $ maybe mempty T.pack <$> lookupEnv "PATH" + let ctx = mkCtx econfig globalCabalVersion sources mcur pathEnvVar' ((), m, W efinals installExes dirtyReason warnings parents) <- liftIO $ runRWST inner ctx M.empty mapM_ (logWarn . RIO.display) (warnings []) @@ -226,7 +229,7 @@ constructPlan baseConfigOpts0 localDumpPkgs loadPackage0 sourceMap installedMap where hasBaseInDeps = Map.member (mkPackageName "base") (smDeps sourceMap) - mkCtx econfig globalCabalVersion sources mcur = Ctx + mkCtx econfig globalCabalVersion sources mcur pathEnvVar' = Ctx { baseConfigOpts = baseConfigOpts0 , loadPackage = \x y z -> runRIO econfig $ applyForceCustomBuild globalCabalVersion <$> loadPackage0 x y z @@ -236,6 +239,7 @@ constructPlan baseConfigOpts0 localDumpPkgs loadPackage0 sourceMap installedMap , wanted = Map.keysSet (smtTargets $ smTargets sourceMap) , localNames = Map.keysSet (smProject sourceMap) , mcurator = mcur + , pathEnvVar = pathEnvVar' } prunedGlobalDeps = flip Map.mapMaybe (smGlobal sourceMap) $ \gp -> @@ -788,6 +792,7 @@ checkDirtiness ps installed package present = do PSFilePath lp -> Set.map (encodeUtf8 . renderComponent) $ lpComponents lp PSRemote{} -> Set.empty , configCachePkgSrc = toCachePkgSrc ps + , configCachePathEnvVar = pathEnvVar ctx } config = view configL ctx mreason <- diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 32411e8ca0..d1a200a33c 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -82,7 +82,7 @@ import Stack.Types.NamedComponent import Stack.Types.Package import Stack.Types.Version import qualified System.Directory as D -import System.Environment (getExecutablePath) +import System.Environment (getExecutablePath, lookupEnv) import System.Exit (ExitCode (..)) import qualified System.FilePath as FP import System.IO (stderr, stdout) @@ -209,6 +209,8 @@ data ExecuteEnv = ExecuteEnv -- Setup.hs built. , eeLargestPackageName :: !(Maybe Int) -- ^ For nicer interleaved output: track the largest package name size + , eePathEnvVar :: !Text + -- ^ Value of the PATH environment variable } buildSetupArgs :: [String] @@ -341,6 +343,7 @@ withExecuteEnv bopts boptsCli baseConfigOpts locals globalPackages snapshotPacka localPackagesTVar <- liftIO $ newTVarIO (toDumpPackagesByGhcPkgId localPackages) logFilesTChan <- liftIO $ atomically newTChan let totalWanted = length $ filter lpWanted locals + pathEnvVar <- liftIO $ maybe mempty T.pack <$> lookupEnv "PATH" inner ExecuteEnv { eeBuildOpts = bopts , eeBuildOptsCLI = boptsCli @@ -366,6 +369,7 @@ withExecuteEnv bopts boptsCli baseConfigOpts locals globalPackages snapshotPacka , eeLogFiles = logFilesTChan , eeCustomBuilt = customBuiltRef , eeLargestPackageName = mlargestPackageName + , eePathEnvVar = pathEnvVar } `finally` dumpLogs logFilesTChan totalWanted where toDumpPackagesByGhcPkgId = Map.fromList . map (\dp -> (dpGhcPkgId dp, dp)) @@ -824,6 +828,7 @@ getConfigCache ExecuteEnv {..} task@Task {..} installedMap enableTest enableBenc TTLocalMutable lp -> Set.map (encodeUtf8 . renderComponent) $ lpComponents lp TTRemotePackage{} -> Set.empty , configCachePkgSrc = taskCachePkgSrc + , configCachePathEnvVar = eePathEnvVar } allDepsMap = Map.union missing' taskPresent return (allDepsMap, cache) diff --git a/src/Stack/Storage.hs b/src/Stack/Storage.hs index 5554fcfa97..a926688c0a 100644 --- a/src/Stack/Storage.hs +++ b/src/Stack/Storage.hs @@ -64,6 +64,7 @@ ConfigCacheParent sql="config_cache" type ConfigCacheType default='' pkgSrc CachePkgSrc default='' active Bool default=0 + pathEnvVar Text default='' UniqueConfigCacheParent directory type sql="unique_config_cache" deriving Show @@ -199,6 +200,7 @@ readConfigCache (Entity parentId ConfigCacheParent {..}) = do configCacheComponents <- Set.fromList . map (configCacheComponentValue . entityVal) <$> selectList [ConfigCacheComponentParent ==. parentId] [] + let configCachePathEnvVar = configCacheParentPathEnvVar return ConfigCache {..} -- | Load 'ConfigCache' from the database. @@ -235,6 +237,7 @@ saveConfigCache key@(UniqueConfigCacheParent dir type_) new = , configCacheParentType = type_ , configCacheParentPkgSrc = configCachePkgSrc new , configCacheParentActive = True + , configCacheParentPathEnvVar = configCachePathEnvVar new } Just parentEntity@(Entity parentId _) -> do old <- readConfigCache parentEntity diff --git a/src/Stack/Types/Build.hs b/src/Stack/Types/Build.hs index 97bab17f0e..7a384decce 100644 --- a/src/Stack/Types/Build.hs +++ b/src/Stack/Types/Build.hs @@ -391,6 +391,8 @@ data ConfigCache = ConfigCache -- here, as it's not a configure option (just a build option), but this -- is a convenient way to force compilation when the components change. , configCachePkgSrc :: !CachePkgSrc + , configCachePathEnvVar :: !Text + -- ^ Value of the PATH env var, see } deriving (Generic, Eq, Show, Data, Typeable) instance NFData ConfigCache