getCanonicalFileNameSafe is now best-effort canonicalizatoin

Canonicalizes longest init of path possible, and appends rest verbatim
This commit is contained in:
Nikolay Yakimov
2015-08-17 08:43:34 +03:00
parent f4aea2c08a
commit 0d78ee4096
2 changed files with 11 additions and 9 deletions

View File

@@ -27,6 +27,9 @@ import Control.Applicative
import Data.Char
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Either (rights)
import Data.List (inits)
import System.FilePath (joinPath, splitPath)
import Exception
import Language.Haskell.GhcMod.Error
import Language.Haskell.GhcMod.Types
@@ -170,12 +173,11 @@ withMappedFile file action = getCanonicalFileNameSafe file >>= lookupMMappedFile
getCanonicalFileNameSafe :: (IOish m, GmEnv m) => FilePath -> m FilePath
getCanonicalFileNameSafe fn = do
crdl <- cradle
let ccfn = cradleRootDir crdl </> fn
fex <- liftIO $ doesFileExist ccfn
if fex
then liftIO $ canonicalizePath ccfn
else return ccfn
pl <- liftIO $ rights <$> (mapM ((try :: IO FilePath -> IO (Either SomeException FilePath)) . canonicalizePath . joinPath) $ reverse $ inits $ splitPath fn)
return $
if (length pl > 0)
then joinPath $ (head pl):(drop (length pl - 1) (splitPath fn))
else error "Current dir doesn't seem to exist?"
mkRevRedirMapFunc :: (Functor m, GmState m, GmEnv m) => m (FilePath -> FilePath)
mkRevRedirMapFunc = do