Avoid unpacking ghc to /tmp #996

Also gives a good error message letting you know that directories now
exist which won't be used by stack

src/Stack/Setup.hs

@@ -49,6 +49,7 @@ import              Data.Monoid
 import              Data.Ord (comparing)
 import              Data.Set (Set)
 import qualified    Data.Set as Set
+import              Data.String
 import              Data.Text (Text)
 import qualified    Data.Text as T
 import qualified    Data.Text.Encoding as T
@@ -75,6 +76,7 @@ import              Stack.Constants (distRelativeDir, stackProgName)
 import              Stack.Exec (defaultEnvSettings)
 import              Stack.Fetch
 import              Stack.GhcPkg (createDatabase, getCabalPkgVer, getGlobalDB, mkGhcPackagePath)
+import              Stack.PrettyPrint
 import              Stack.Setup.Installed
 import              Stack.Types.Build
 import              Stack.Types.Compiler
@@ -650,15 +652,19 @@ downloadAndInstallTool :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader en
                        -> SetupInfo
                        -> DownloadInfo
                        -> Tool
-                       -> (SetupInfo -> Path Abs File -> ArchiveType -> Path Abs Dir -> m ())
+                       -> (SetupInfo -> Path Abs File -> ArchiveType -> Path Abs Dir -> Path Abs Dir -> m ())
                        -> m Tool
 downloadAndInstallTool programsDir si downloadInfo tool installer = do
     ensureDir programsDir
     (file, at) <- downloadFromInfo programsDir downloadInfo tool
     dir <- installDir programsDir tool
+    tempDir <- tempInstallDir programsDir tool
+    ignoringAbsence (removeDirRecur tempDir)
+    ensureDir tempDir
     unmarkInstalled programsDir tool
-    installer si file at dir
+    installer si file at tempDir dir
     markInstalled programsDir tool
+    ignoringAbsence (removeDirRecur tempDir)
     return tool
 
 downloadAndInstallCompiler :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader env m, HasConfig env, HasGHCVariant env, HasHttpManager env, HasTerminal env, HasReExec env, HasLogLevel env, MonadBaseControl IO m)
@@ -801,14 +807,15 @@ data ArchiveType
     | TarGz
     | SevenZ
 
-installGHCPosix :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader env m, HasConfig env, HasHttpManager env, MonadBaseControl IO m)
+installGHCPosix :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader env m, HasConfig env, HasHttpManager env, MonadBaseControl IO m, HasTerminal env)
                 => Version
                 -> SetupInfo
                 -> Path Abs File
                 -> ArchiveType
                 -> Path Abs Dir
+                -> Path Abs Dir
                 -> m ()
-installGHCPosix version _ archiveFile archiveType destDir = do
+installGHCPosix version _ archiveFile archiveType tempDir destDir = do
     platform <- asks getPlatform
     menv0 <- getMinimalEnvOverride
     menv <- mkEnvOverride platform (removeHaskellEnvVars (unEnvOverride menv0))
@@ -834,33 +841,40 @@ installGHCPosix version _ archiveFile archiveType destDir = do
     $logDebug $ "make: " <> T.pack makeTool
     $logDebug $ "tar: " <> T.pack tarTool
 
-    withSystemTempDir "stack-setup" $ \root -> do
-        dir <-
-            liftM (root </>) $
-            parseRelDir $
-            "ghc-" ++ versionString version
+    dir <-
+        liftM (tempDir </>) $
+        parseRelDir $
+        "ghc-" ++ versionString version
+
+    errMsg <- fmap Just $ displayAnsiIfPossible $
+        "Error encountered while installing GHC." <> line <> line <>
+        "The following directories may now contain files, but won't be used by stack:" <> line <>
+        -- TODO: pretty-print utilities for this
+        "  -" <+> display tempDir <> line <>
+        "  -" <+> display destDir <> line
 
-        $logSticky $ T.concat ["Unpacking GHC into ", T.pack . toFilePath $ root, " ..."]
-        $logDebug $ "Unpacking " <> T.pack (toFilePath archiveFile)
-        readInNull root tarTool menv [compOpt : "xf", toFilePath archiveFile] Nothing
+    $logSticky $ T.concat ["Unpacking GHC into ", T.pack . toFilePath $ tempDir, " ..."]
+    $logDebug $ "Unpacking " <> T.pack (toFilePath archiveFile)
+    readInNull tempDir tarTool menv [compOpt : "xf", toFilePath archiveFile] errMsg
 
-        $logSticky "Configuring GHC ..."
-        readInNull dir (toFilePath $ dir </> $(mkRelFile "configure"))
-                   menv ["--prefix=" ++ toFilePath destDir] Nothing
+    $logSticky "Configuring GHC ..."
+    readInNull dir (toFilePath $ dir </> $(mkRelFile "configure"))
+               menv ["--prefix=" ++ toFilePath destDir] errMsg
 
-        $logSticky "Installing GHC ..."
-        readInNull dir makeTool menv ["install"] Nothing
+    $logSticky "Installing GHC ..."
+    readInNull dir makeTool menv ["install"] errMsg
 
-        $logStickyDone $ "Installed GHC."
-        $logDebug $ "GHC installed to " <> T.pack (toFilePath destDir)
+    $logStickyDone $ "Installed GHC."
+    $logDebug $ "GHC installed to " <> T.pack (toFilePath destDir)
 
 installGHCJS :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader env m, HasConfig env, HasHttpManager env, HasTerminal env, HasReExec env, HasLogLevel env, MonadBaseControl IO m)
              => SetupInfo
              -> Path Abs File
              -> ArchiveType
              -> Path Abs Dir
+             -> Path Abs Dir
              -> m ()
-installGHCJS si archiveFile archiveType destDir = do
+installGHCJS si archiveFile archiveType _tempDir destDir = do
     platform <- asks getPlatform
     menv0 <- getMinimalEnvOverride
     -- This ensures that locking is disabled for the invocations of
@@ -869,7 +883,7 @@ installGHCJS si archiveFile archiveType destDir = do
     menv <- mkEnvOverride platform (removeLockVar (removeHaskellEnvVars (unEnvOverride menv0)))
     $logDebug $ "menv = " <> T.pack (show (unEnvOverride menv))
 
-    -- NOTE: this is a bit of a hack - instead of using a temp
+    -- NOTE: this is a bit of a hack - instead of using the temp
     -- directory, leave the unpacked source tarball in the destination
     -- directory. This way, the absolute paths in the wrapper scripts
     -- will point to executables that exist in
@@ -940,8 +954,9 @@ installDockerStackExe
     -> Path Abs File
     -> ArchiveType
     -> Path Abs Dir
+    -> Path Abs Dir
     -> m ()
-installDockerStackExe _ archiveFile _ destDir = do
+installDockerStackExe _ archiveFile _ _tempDir destDir = do
     (_,tarTool) <-
         checkDependencies $
         (,) <$> checkDependency "gzip" <*> checkDependency "tar"
@@ -1108,8 +1123,9 @@ installGHCWindows :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader env m,
                   -> Path Abs File
                   -> ArchiveType
                   -> Path Abs Dir
+                  -> Path Abs Dir
                   -> m ()
-installGHCWindows version si archiveFile archiveType destDir = do
+installGHCWindows version si archiveFile archiveType _tempDir destDir = do
     tarComponent <- parseRelDir $ "ghc-" ++ versionString version
     withUnpackedTarball7z "GHC" si archiveFile archiveType (Just tarComponent) destDir
     $logInfo $ "GHC installed to " <> T.pack (toFilePath destDir)
@@ -1120,8 +1136,9 @@ installMsys2Windows :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader env m
                   -> Path Abs File
                   -> ArchiveType
                   -> Path Abs Dir
+                  -> Path Abs Dir
                   -> m ()
-installMsys2Windows osKey si archiveFile archiveType destDir = do
+installMsys2Windows osKey si archiveFile archiveType _tempDir destDir = do
     exists <- liftIO $ D.doesDirectoryExist $ toFilePath destDir
     when exists $ liftIO (D.removeDirectoryRecursive $ toFilePath destDir) `catchIO` \e -> do
         $logError $ T.pack $

src/Stack/Setup/Installed.hs

@@ -17,6 +17,7 @@ module Stack.Setup.Installed
     , ExtraDirs (..)
     , extraDirs
     , installDir
+    , tempInstallDir
     ) where
 
 import           Control.Applicative
@@ -187,3 +188,11 @@ installDir :: (MonadReader env m, MonadThrow m)
 installDir programsDir tool = do
     reldir <- parseRelDir $ toolString tool
     return $ programsDir </> reldir
+
+tempInstallDir :: (MonadReader env m, MonadThrow m)
+           => Path Abs Dir
+           -> Tool
+           -> m (Path Abs Dir)
+tempInstallDir programsDir tool = do
+    reldir <- parseRelDir $ toolString tool ++ ".temp"
+    return $ programsDir </> reldir