diff --git a/Language/Haskell/GhcMod/Cradle.hs b/Language/Haskell/GhcMod/Cradle.hs index aa919c8..b5606b4 100644 --- a/Language/Haskell/GhcMod/Cradle.hs +++ b/Language/Haskell/GhcMod/Cradle.hs @@ -8,12 +8,11 @@ module Language.Haskell.GhcMod.Cradle ( import Language.Haskell.GhcMod.GhcPkg import Language.Haskell.GhcMod.PathsAndFiles import Language.Haskell.GhcMod.Types +import Language.Haskell.GhcMod.Utils import Control.Exception.IOChoice ((||>)) -import System.Directory (getCurrentDirectory, removeDirectoryRecursive, - getTemporaryDirectory) -import System.FilePath (takeDirectory,pathSeparators,splitDrive) -import System.IO.Temp +import System.Directory (getCurrentDirectory, removeDirectoryRecursive) +import System.FilePath (takeDirectory) ---------------------------------------------------------------- @@ -28,15 +27,6 @@ findCradle = findCradle' =<< getCurrentDirectory findCradle' :: FilePath -> IO Cradle 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 crdl = removeDirectoryRecursive $ cradleTempDir crdl diff --git a/Language/Haskell/GhcMod/Utils.hs b/Language/Haskell/GhcMod/Utils.hs index 58e45ee..ccabaee 100644 --- a/Language/Haskell/GhcMod/Utils.hs +++ b/Language/Haskell/GhcMod/Utils.hs @@ -1,11 +1,16 @@ {-# LANGUAGE CPP #-} module Language.Haskell.GhcMod.Utils where +import Control.Arrow +import Data.Char import Language.Haskell.GhcMod.Error import MonadUtils (MonadIO, liftIO) import System.Directory (getCurrentDirectory, setCurrentDirectory, doesFileExist) import System.Exit (ExitCode(..)) import System.Process (readProcessWithExitCode) +import System.Directory (getTemporaryDirectory) +import System.FilePath (splitDrive, joinDrive, pathSeparators) +import System.IO.Temp (createTempDirectory) #ifndef SPEC import Control.Applicative ((<$>)) import System.Environment @@ -48,6 +53,24 @@ withDirectory_ dir action = gbracket (liftIO getCurrentDirectory) (liftIO . setCurrentDirectory) (\_ -> 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 f = do exists <- doesFileExist f