From 3f15cdd3ed2729b1f3d532171dc3b3ddc222601d Mon Sep 17 00:00:00 2001
From: Michael Sloan <mgsloan@gmail.com>
Date: Sun, 11 Jun 2017 15:59:55 -0700
Subject: [PATCH] When extracting local GHC from tarball on windows, use temp
 dir #3188

---
 ChangeLog.md       |  3 +++
 src/Stack/Setup.hs | 15 ++++-----------
 2 files changed, 7 insertions(+), 11 deletions(-)

diff --git a/ChangeLog.md b/ChangeLog.md
index 78ed5e7319..a3fc011b7a 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -55,6 +55,9 @@ Other enhancements:
   wired-in packages. See
   [#3172](https://github.com/commercialhaskell/stack/issues/3172).
 * MinGW bin folder now is searched for dynamic libraries. See [#3126](https://github.com/commercialhaskell/stack/issues/3126)
+* For filesystem setup-info paths, it's no longer assumed that the
+  directory is writable, instead a temp dir is used.  See
+  [#3188](https://github.com/commercialhaskell/stack/issues/3188).
 
 Bug fixes:
 
diff --git a/src/Stack/Setup.hs b/src/Stack/Setup.hs
index 3261913aa2..319e55084e 100644
--- a/src/Stack/Setup.hs
+++ b/src/Stack/Setup.hs
@@ -1315,26 +1315,19 @@ withUnpackedTarball7z name si archiveFile archiveType msrcDir destDir = do
             TarGz -> return ".gz"
             _ -> throwString $ name ++ " must be a tarball file"
     tarFile <-
-        case T.stripSuffix suffix $ T.pack $ toFilePath archiveFile of
+        case T.stripSuffix suffix $ T.pack $ toFilePath (filename archiveFile) of
             Nothing -> throwString $ "Invalid " ++ name ++ " filename: " ++ show archiveFile
-            Just x -> parseAbsFile $ T.unpack x
+            Just x -> parseRelFile $ T.unpack x
     run7z <- setup7z si
     let tmpName = toFilePathNoTrailingSep (dirname destDir) ++ "-tmp"
     ensureDir (parent destDir)
     withTempDir (parent destDir) tmpName $ \tmpDir -> do
         ignoringAbsence (removeDirRecur destDir)
-        run7z (parent archiveFile) archiveFile
-        run7z tmpDir tarFile
+        run7z tmpDir archiveFile
+        run7z tmpDir (tmpDir </> tarFile)
         absSrcDir <- case msrcDir of
             Just srcDir -> return $ tmpDir </> srcDir
             Nothing -> expectSingleUnpackedDir archiveFile tmpDir
-        removeFile tarFile `catchIO` \e ->
-            $logWarn (T.concat
-                [ "Exception when removing "
-                , T.pack $ toFilePath tarFile
-                , ": "
-                , T.pack $ show e
-                ])
         renameDir absSrcDir destDir
 
 expectSingleUnpackedDir :: (MonadIO m, MonadThrow m) => Path Abs File -> Path Abs Dir -> m (Path Abs Dir)