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