hasufell
/
ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Really fix `newTempDir` on Windows

This commit is contained in:
Daniel Gröber 2014-11-02 19:00:25 +01:00
parent 37af8e368d
commit 2af3383fad
2 changed files with 26 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
Language/Haskell/GhcMod/Cradle.hs
View File

@ -8,12 +8,11 @@ module Language.Haskell.GhcMod.Cradle (
import Language.Haskell.GhcMod.GhcPkg import Language.Haskell.GhcMod.GhcPkg
import Language.Haskell.GhcMod.PathsAndFiles import Language.Haskell.GhcMod.PathsAndFiles
import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Utils
import Control.Exception.IOChoice ((||>)) import Control.Exception.IOChoice ((||>))
import System.Directory (getCurrentDirectory, removeDirectoryRecursive, import System.Directory (getCurrentDirectory, removeDirectoryRecursive)
getTemporaryDirectory) import System.FilePath (takeDirectory)
import System.FilePath (takeDirectory,pathSeparators,splitDrive)
import System.IO.Temp
---------------------------------------------------------------- ----------------------------------------------------------------
@ -28,15 +27,6 @@ findCradle = findCradle' =<< getCurrentDirectory
findCradle' :: FilePath -> IO Cradle findCradle' :: FilePath -> IO Cradle
findCradle' dir = cabalCradle dir ||> sandboxCradle dir ||> plainCradle dir findCradle' dir = cabalCradle dir ||> sandboxCradle dir ||> plainCradle dir
newTempDir :: FilePath -> IO FilePath
newTempDir dir =
flip createTempDirectory uniqPathName =<< getTemporaryDirectory
where
uniqPathName = "ghc-mod" ++ map escapeSlash (snd $ splitDrive dir)
escapeSlash c | c `elem` pathSeparators = '-'
escapeSlash c = c
cleanupCradle :: Cradle -> IO () cleanupCradle :: Cradle -> IO ()
cleanupCradle crdl = removeDirectoryRecursive $ cradleTempDir crdl cleanupCradle crdl = removeDirectoryRecursive $ cradleTempDir crdl

23
Language/Haskell/GhcMod/Utils.hs
View File

@ -1,11 +1,16 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
module Language.Haskell.GhcMod.Utils where module Language.Haskell.GhcMod.Utils where
import Control.Arrow
import Data.Char
import Language.Haskell.GhcMod.Error import Language.Haskell.GhcMod.Error
import MonadUtils (MonadIO, liftIO) import MonadUtils (MonadIO, liftIO)
import System.Directory (getCurrentDirectory, setCurrentDirectory, doesFileExist) import System.Directory (getCurrentDirectory, setCurrentDirectory, doesFileExist)
import System.Exit (ExitCode(..)) import System.Exit (ExitCode(..))
import System.Process (readProcessWithExitCode) import System.Process (readProcessWithExitCode)
import System.Directory (getTemporaryDirectory)
import System.FilePath (splitDrive, joinDrive, pathSeparators)
import System.IO.Temp (createTempDirectory)
#ifndef SPEC #ifndef SPEC
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import System.Environment import System.Environment
@ -48,6 +53,24 @@ withDirectory_ dir action =
gbracket (liftIO getCurrentDirectory) (liftIO . setCurrentDirectory) gbracket (liftIO getCurrentDirectory) (liftIO . setCurrentDirectory)
(\_ -> liftIO (setCurrentDirectory dir) >> action) (\_ -> liftIO (setCurrentDirectory dir) >> action)
uniqTempDirName :: FilePath -> FilePath
uniqTempDirName dir =
uncurry (++)
$ map escapeDriveChar *** map escapePathChar
$ splitDrive dir
where
escapeDriveChar c
| isAlphaNum c = c
| otherwise = '-'
escapePathChar c
| c `elem` pathSeparators = '-'
| otherwise = c
newTempDir :: FilePath -> IO FilePath
newTempDir dir =
flip createTempDirectory (uniqTempDirName dir) =<< getTemporaryDirectory
mightExist :: FilePath -> IO (Maybe FilePath) mightExist :: FilePath -> IO (Maybe FilePath)
mightExist f = do mightExist f = do
exists <- doesFileExist f exists <- doesFileExist f