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

Fix getCanonicalFileNameSafe to work on all relevant ghc versions

Browse Source
This commit is contained in:
Nikolay Yakimov 2015-08-17 10:39:49 +03:00
parent 0d78ee4096
commit 3dea19b270
1 changed files with 10 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -29,7 +29,7 @@ import qualified Data.Map as M
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Either (rights) import Data.Either (rights)
import Data.List (inits) import Data.List (inits)
import System.FilePath (joinPath, splitPath) import System.FilePath (joinPath, splitPath, normalise)
import Exception import Exception
import Language.Haskell.GhcMod.Error import Language.Haskell.GhcMod.Error
import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Types
@ -173,11 +173,18 @@ withMappedFile file action = getCanonicalFileNameSafe file >>= lookupMMappedFile
getCanonicalFileNameSafe :: (IOish m, GmEnv m) => FilePath -> m FilePath getCanonicalFileNameSafe :: (IOish m, GmEnv m) => FilePath -> m FilePath
getCanonicalFileNameSafe fn = do getCanonicalFileNameSafe fn = do
pl <- liftIO $ rights <$> (mapM ((try :: IO FilePath -> IO (Either SomeException FilePath)) . canonicalizePath . joinPath) $ reverse $ inits $ splitPath fn) let fn' = normalise fn
pl <- liftIO $ rights <$> (mapM ((try :: IO FilePath -> IO (Either SomeException FilePath)) . canonicalizePath . joinPath) $ reverse $ inits $ splitPath' fn')
return $ return $
if (length pl > 0) if (length pl > 0)
then joinPath $ (head pl):(drop (length pl - 1) (splitPath fn)) then joinPath $ (head pl):(drop (length pl - 1) (splitPath fn'))
else error "Current dir doesn't seem to exist?" else error "Current dir doesn't seem to exist?"
where
#if __GLASGOW_HASKELL__ < 710
splitPath' = (".":) . splitPath
#else
splitPath' = splitPath
#endif
mkRevRedirMapFunc :: (Functor m, GmState m, GmEnv m) => m (FilePath -> FilePath) mkRevRedirMapFunc :: (Functor m, GmState m, GmEnv m) => m (FilePath -> FilePath)
mkRevRedirMapFunc = do mkRevRedirMapFunc = do