Skip to content

Commit

Permalink
When extracting local GHC from tarball on windows, use temp dir #3188
Browse files Browse the repository at this point in the history
  • Loading branch information
mgsloan committed Jun 11, 2017
1 parent 62220ce commit 3f15cdd
Show file tree
Hide file tree
Showing 2 changed files with 7 additions and 11 deletions.
3 changes: 3 additions & 0 deletions ChangeLog.md
Original file line number Diff line number Diff line change
Expand Up @@ -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:

Expand Down
15 changes: 4 additions & 11 deletions src/Stack/Setup.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down

0 comments on commit 3f15cdd

Please sign in to comment.