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