Allow configuring programs directory

ChangeLog.md

@@ -79,6 +79,9 @@ Other enhancements:
   [#2235](https://github.com/commercialhaskell/stack/issues/2235)
 * Replace enclosed-exceptions with safe-exceptions.
   [#2768](https://github.com/commercialhaskell/stack/issues/2768)
+* The install location for GHC and other programs can now be configured with the
+  `local-programs-path` option in `config.yaml`.
+  [#1644](https://github.com/commercialhaskell/stack/issues/1644)
 
 Bug fixes:
 

doc/faq.md

@@ -324,22 +324,19 @@ Cf. issue [#425](https://github.com/commercialhaskell/stack/issues/425).
 
 ## Can I change stack's default temporary directory?
 
-Stack makes use of a temporary directory for some commands (/tmp by default on
-linux). If there is not enough free space in this directory, stack may fail
-(see issue [#429](https://github.com/commercialhaskell/stack/issues/429) ). For
-instance `stack setup` with a GHC installation requires roughly 1GB free.
-
-A custom temporary directory can be forced:
-
-* on Linux by setting the environment variable TMPDIR (eg `$ TMPDIR=path-to-tmp stack setup`)
-* on Windows by setting one of the environment variable (given in priority order), TMP, TEMP, USERPROFILE
-
-If you use Stack with Nix integration, be aware that Nix _also_ uses that TMPDIR
+Stack downloads and extracts files to `$STACK_ROOT/programs` on most platforms,
+which defaults to `~/.stack/programs`. On Windows `$LOCALAPPDATA\Programs\stack`
+is used. If there is not enough free space in this directory, Stack may fail.
+For instance, `stack setup` with a GHC installation requires roughly 1GB free.
+If this is an issue, you can set `local-programs-path` in your
+`~/.stack/config.yaml` to a directory on a file system with more free space.
+
+If you use Stack with Nix integration, be aware that Nix uses a `TMPDIR`
 variable, and if it is not set Nix sets it to some subdirectory of `/run`, which
-on most Linuxes is a Ramdir. Nix will run the builds in TMPDIR, therefore if you
-don't have enough RAM you will get errors about disk space.  If this happens to
-you, please _manually_ set TMPDIR before launching Stack to some directory on the
-disk.
+on most Linuxes is a Ramdir. Nix will run the builds in `TMPDIR`, therefore if
+you don't have enough RAM you will get errors about disk space. If this happens
+to you, please _manually_ set `TMPDIR` before launching Stack to some directory
+on the disk.
 
 ## Why doesn't stack rebuild my project when I specify `--ghc-options` on the command line?
 

src/Stack/Config.hs

@@ -294,15 +294,10 @@ configFromConfigMonoid configStackRoot configUserConfigPath mresolver mproject C
      origEnv <- mkEnvOverride configPlatform pathsEnv
      let configEnvOverride _ = return origEnv
 
-     platformOnlyDir <- runReaderT platformOnlyRelDir (configPlatform,configPlatformVariant)
-     configLocalProgramsBase <-
-         case configPlatform of
-             Platform _ Windows -> do
-                 progsDir <- getWindowsProgsDir configStackRoot origEnv
-                 return $ progsDir </> $(mkRelDir stackProgName)
-             _ ->
-                 return $
-                 configStackRoot </> $(mkRelDir "programs")
+     configLocalProgramsBase <- case getFirst configMonoidLocalProgramsBase of
+       Nothing -> getDefaultLocalProgramsBase configStackRoot configPlatform origEnv
+       Just path -> return path
+     platformOnlyDir <- runReaderT platformOnlyRelDir (configPlatform, configPlatformVariant)
      let configLocalPrograms = configLocalProgramsBase </> platformOnlyDir
 
      configLocalBin <-
@@ -352,19 +347,28 @@ configFromConfigMonoid configStackRoot configUserConfigPath mresolver mproject C
 
      return Config {..}
 
--- | Get the directory on Windows where we should install extra programs. For
--- more information, see discussion at:
--- https://github.com/fpco/minghc/issues/43#issuecomment-99737383
-getWindowsProgsDir :: MonadThrow m
-                   => Path Abs Dir
-                   -> EnvOverride
-                   -> m (Path Abs Dir)
-getWindowsProgsDir stackRoot m =
-    case Map.lookup "LOCALAPPDATA" $ unEnvOverride m of
-        Just t -> do
+-- | Get the default location of the local programs directory.
+getDefaultLocalProgramsBase :: MonadThrow m
+                            => Path Abs Dir
+                            -> Platform
+                            -> EnvOverride
+                            -> m (Path Abs Dir)
+getDefaultLocalProgramsBase configStackRoot configPlatform override =
+  let
+    defaultBase = configStackRoot </> $(mkRelDir "programs")
+  in
+    case configPlatform of
+      -- For historical reasons, on Windows a subdirectory of LOCALAPPDATA is
+      -- used instead of a subdirectory of STACK_ROOT. Unifying the defaults would
+      -- mean that Windows users would manually have to move data from the old
+      -- location to the new one, which is undesirable.
+      Platform _ Windows ->
+        case Map.lookup "LOCALAPPDATA" $ unEnvOverride override of
+          Just t -> do
             lad <- parseAbsDir $ T.unpack t
-            return $ lad </> $(mkRelDir "Programs")
-        Nothing -> return $ stackRoot </> $(mkRelDir "Programs")
+            return $ lad </> $(mkRelDir "Programs") </> $(mkRelDir stackProgName)
+          Nothing -> return defaultBase
+      _ -> return defaultBase
 
 -- | An environment with a subset of BuildConfig used for setup.
 data MiniConfig = MiniConfig GHCVariant Config

src/Stack/Types/Config.hs

@@ -783,6 +783,8 @@ data ConfigMonoid =
     -- ^ Additional paths to search for executables in
     ,configMonoidSetupInfoLocations  :: ![SetupInfoLocation]
     -- ^ Additional setup info (inline or remote) to use for installing tools
+    ,configMonoidLocalProgramsBase   :: !(First (Path Abs Dir))
+    -- ^ Override the default local programs dir, where e.g. GHC is installed.
     ,configMonoidPvpBounds           :: !(First PvpBounds)
     -- ^ See 'configPvpBounds'
     ,configMonoidModifyCodePage      :: !(First Bool)
@@ -860,6 +862,7 @@ parseConfigMonoidJSON obj = do
     configMonoidExtraPath <- obj ..:? configMonoidExtraPathName ..!= []
     configMonoidSetupInfoLocations <-
         maybeToList <$> jsonSubWarningsT (obj ..:?  configMonoidSetupInfoLocationsName)
+    configMonoidLocalProgramsBase <- First <$> obj ..:? configMonoidLocalProgramsBaseName
     configMonoidPvpBounds <- First <$> obj ..:? configMonoidPvpBoundsName
     configMonoidModifyCodePage <- First <$> obj ..:? configMonoidModifyCodePageName
     configMonoidExplicitSetupDeps <-
@@ -974,6 +977,9 @@ configMonoidExtraPathName = "extra-path"
 configMonoidSetupInfoLocationsName :: Text
 configMonoidSetupInfoLocationsName = "setup-info"
 
+configMonoidLocalProgramsBaseName :: Text
+configMonoidLocalProgramsBaseName = "local-programs-path"
+
 configMonoidPvpBoundsName :: Text
 configMonoidPvpBoundsName = "pvp-bounds"