Merge pull request #4642 from commercialhaskell/620-env-command

Add the config env command (fixes #620)

ChangeLog.md

@@ -127,6 +127,8 @@ Other enhancements:
 * Both `stack dot` and `stack ls dependencies` accept a
   `--global-hints` flag to bypass the need for an installed GHC. See
   [#4390](https://github.com/commercialhaskell/stack/issues/4390).
+* Add the `stack config env` command for getting shell script environment
+  variables. See [#620](https://github.com/commercialhaskell/stack/issues/620).
 * Less verbose output from `stack setup` on Windows. See
   [#1212](https://github.com/commercialhaskell/stack/issues/1212).
 

src/Stack/ConfigCmd.hs

@@ -11,21 +11,29 @@ module Stack.ConfigCmd
        ,configCmdSetParser
        ,cfgCmdSet
        ,cfgCmdSetName
+       ,configCmdEnvParser
+       ,cfgCmdEnv
+       ,cfgCmdEnvName
        ,cfgCmdName) where
 
 import           Stack.Prelude
 import qualified Data.ByteString as S
+import qualified Data.Map.Merge.Strict as Map
 import qualified Data.HashMap.Strict as HMap
 import qualified Data.Text as T
 import qualified Data.Yaml as Yaml
 import qualified Options.Applicative as OA
 import qualified Options.Applicative.Types as OA
+import           Options.Applicative.Builder.Extra
 import           Path
+import qualified RIO.Map as Map
+import           RIO.Process (envVarsL)
 import           Stack.Config (makeConcreteResolver, getProjectConfig, getImplicitGlobalProjectDir)
 import           Stack.Constants
 import           Stack.Snapshot (loadResolver)
 import           Stack.Types.Config
 import           Stack.Types.Resolver
+import           System.Environment (getEnvironment)
 
 data ConfigCmdSet
     = ConfigCmdSetResolver (Unresolved AbstractResolver)
@@ -101,6 +109,9 @@ cfgCmdName = "config"
 cfgCmdSetName :: String
 cfgCmdSetName = "set"
 
+cfgCmdEnvName :: String
+cfgCmdEnvName = "env"
+
 configCmdSetParser :: OA.Parser ConfigCmdSet
 configCmdSetParser =
     OA.hsubparser $
@@ -148,3 +159,39 @@ readBool = do
 
 boolArgument :: OA.Parser Bool
 boolArgument = OA.argument readBool (OA.metavar "true|false" <> OA.completeWith ["true", "false"])
+
+configCmdEnvParser :: OA.Parser EnvSettings
+configCmdEnvParser = EnvSettings
+  <$> boolFlags True "locals" "include local package information" mempty
+  <*> boolFlags True "ghc-package-path" "set GHC_PACKAGE_PATH variable" mempty
+  <*> boolFlags True "stack-exe" "set STACK_EXE environment variable" mempty
+  <*> boolFlags False "locale-utf8" "set the GHC_CHARENC environment variable to UTF8" mempty
+  <*> boolFlags False "keep-ghc-rts" "keep any GHC_RTS environment variables" mempty
+
+data EnvVarAction = EVASet !Text | EVAUnset
+  deriving Show
+
+cfgCmdEnv :: EnvSettings -> RIO EnvConfig ()
+cfgCmdEnv es = do
+  origEnv <- liftIO $ Map.fromList . map (first fromString) <$> getEnvironment
+  mkPC <- view $ configL.to configProcessContextSettings
+  pc <- liftIO $ mkPC es
+  let newEnv = pc ^. envVarsL
+      actions = Map.merge
+        (pure EVAUnset)
+        (Map.traverseMissing $ \_k new -> pure (EVASet new))
+        (Map.zipWithMaybeAMatched $ \_k old new -> pure $
+            if fromString old == new
+              then Nothing
+              else Just (EVASet new))
+        origEnv
+        newEnv
+      toLine key EVAUnset = "unset " <> encodeUtf8Builder key <> ";\n"
+      toLine key (EVASet value) =
+        encodeUtf8Builder key <> "='" <>
+        encodeUtf8Builder (T.concatMap escape value) <> -- TODO more efficient to use encodeUtf8BuilderEscaped
+        "'; export " <>
+        encodeUtf8Builder key <> ";\n"
+      escape '\'' = "'\"'\"'"
+      escape c = T.singleton c
+  hPutBuilder stdout $ Map.foldMapWithKey toLine actions

src/Stack/Setup.hs

@@ -292,7 +292,7 @@ setupEnv needTargets boptsCLI mResolveMissingGHC = do
     extras <- runReaderT packageDatabaseExtra envConfig0
     let mkGPP locals = mkGhcPackagePath locals localdb deps extras globaldb
 
-    distDir <- runReaderT distRelativeDir envConfig0
+    distDir <- runReaderT distRelativeDir envConfig0 >>= canonicalizePath
 
     executablePath <- liftIO getExecutablePath
 

src/main/Main.hs

@@ -464,11 +464,16 @@ commandLineHandler currentDir progName isInterpreter = complicatedOptions
                           dockerCleanupOptsParser)
         addSubCommands'
             ConfigCmd.cfgCmdName
-            "Subcommands specific to modifying stack.yaml files"
-            (addCommand' ConfigCmd.cfgCmdSetName
-                        "Sets a field in the project's stack.yaml to value"
-                        (withConfig . cfgCmdSet)
-                        configCmdSetParser)
+            "Subcommands for accessing and modifying configuration values"
+            (do
+               addCommand' ConfigCmd.cfgCmdSetName
+                          "Sets a field in the project's stack.yaml to value"
+                          (withConfig . cfgCmdSet)
+                          configCmdSetParser
+               addCommand' ConfigCmd.cfgCmdEnvName
+                          "Print environment variables for use in a shell"
+                          (withConfig . withDefaultEnvConfig . cfgCmdEnv)
+                          configCmdEnvParser)
         addSubCommands'
           "hpc"
           "Subcommands specific to Haskell Program Coverage"

test/integration/tests/620-env-command/Main.hs

@@ -0,0 +1,6 @@
+import StackTest
+import System.Process
+import Control.Exception (throwIO)
+
+main :: IO ()
+main = rawSystem "bash" ["run.sh"] >>= throwIO

test/integration/tests/620-env-command/files/.gitignore

@@ -0,0 +1,2 @@
+Main
+Main.exe

test/integration/tests/620-env-command/files/Main.hs

@@ -0,0 +1,4 @@
+import Control.Concurrent.Async ()
+
+main :: IO ()
+main = pure ()

test/integration/tests/620-env-command/files/run.sh

@@ -0,0 +1,7 @@
+#!/usr/bin/env bash
+
+set -euxo pipefail
+
+stack build --resolver lts-11.22 async
+eval `stack config env --resolver lts-11.22`
+ghc Main.hs