Merge pull request #6350 from commercialhaskell/fix6340

Fix #6340 `stack path --stack-root` does not need environment

Author: mpilgrem

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:
 

src/Stack/Config.hs

@@ -29,6 +29,7 @@ module Stack.Config
   , getProjectConfig
   , withBuildConfig
   , withNewLogFunc
+  , determineStackRootAndOwnership
   ) where
 
 import           Control.Monad.Extra ( firstJustM )

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