From 23b9aa1f781a9e0a6b1b43fd313ea54c3f725bea Mon Sep 17 00:00:00 2001 From: Mike Pilgrem <mpilgrem@users.noreply.github.com> Date: Thu, 30 Nov 2023 21:38:04 +0000 Subject: [PATCH] Fix #6340 `stack path --stack-root` does not need environment --- ChangeLog.md | 2 ++ src/Stack/Config.hs | 1 + src/Stack/Path.hs | 21 +++++++++++++++++---- 3 files changed, 20 insertions(+), 4 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index 39346e2a5a..51b9192b1c 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -22,6 +22,8 @@ Behavior changes: manager is available. In YAML configuration files, the `notify-if-nix-on-path` key is introduced, to allow the notification to be muted if unwanted. * Drop support for Intero (end of life in November 2019). +* `stack path --stack-root` no longer sets up Stack's environment and does not + load Stack's configuration. Other enhancements: diff --git a/src/Stack/Config.hs b/src/Stack/Config.hs index 53d63ee4a5..f323d8da56 100644 --- a/src/Stack/Config.hs +++ b/src/Stack/Config.hs @@ -29,6 +29,7 @@ module Stack.Config , getProjectConfig , withBuildConfig , withNewLogFunc + , determineStackRootAndOwnership ) where import Control.Monad.Extra ( firstJustM ) diff --git a/src/Stack/Path.hs b/src/Stack/Path.hs index e2f3b5b82b..e8fb830030 100644 --- a/src/Stack/Path.hs +++ b/src/Stack/Path.hs @@ -15,6 +15,7 @@ import qualified Data.Text.IO as T import Path ( (</>), parent ) import Path.Extra ( toFilePathNoTrailingSep ) import RIO.Process ( HasProcessContext (..), exeSearchPathL ) +import Stack.Config ( determineStackRootAndOwnership ) import Stack.Constants ( docDirSuffix, stackGlobalConfigOptionName , stackRootOptionName @@ -41,14 +42,22 @@ import Stack.Types.EnvConfig , packageDatabaseExtra, packageDatabaseLocal ) import Stack.Types.GHCVariant ( HasGHCVariant (..) ) -import Stack.Types.GlobalOpts ( globalOptsBuildOptsMonoidL ) +import Stack.Types.GlobalOpts + ( GlobalOpts (..), globalOptsBuildOptsMonoidL ) import Stack.Types.Platform ( HasPlatform (..) ) import Stack.Types.Runner ( HasRunner (..), Runner, globalOptsL ) import qualified System.FilePath as FP --- | Print out useful path information in a human-readable format (and --- support others later). +-- | Print out useful path information in a human-readable format (and support +-- others later). path :: [Text] -> RIO Runner () +-- Distinguish a request for only the Stack root, as such a request does not +-- require 'withDefaultEnvConfig'. +path [key] | key == stackRootOptionName' = do + clArgs <- view $ globalOptsL.to globalConfigMonoid + liftIO $ do + (_, stackRoot, _) <- determineStackRootAndOwnership clArgs + T.putStrLn $ T.pack $ toFilePathNoTrailingSep stackRoot path keys = do let -- filter the chosen paths in flags (keys), or show all of them if no -- specific paths chosen. @@ -172,7 +181,7 @@ data UseHaddocks a paths :: [(String, Text, UseHaddocks (PathInfo -> Text))] paths = [ ( "Global Stack root directory" - , T.pack stackRootOptionName + , stackRootOptionName' , WithoutHaddocks $ view (stackRootL.to toFilePathNoTrailingSep.to T.pack)) , ( "Global Stack configuration file" , T.pack stackGlobalConfigOptionName @@ -258,3 +267,7 @@ paths = , "local-hpc-root" , WithoutHaddocks $ T.pack . toFilePathNoTrailingSep . piHpcDir ) ] + +-- | 'Text' equivalent of 'stackRootOptionName'. +stackRootOptionName' :: Text +stackRootOptionName' = T.pack stackRootOptionName