getCanonicalFileNameSafe is now best-effort canonicalizatoin
Canonicalizes longest init of path possible, and appends rest verbatim
This commit is contained in:
parent
f4aea2c08a
commit
0d78ee4096
@ -27,6 +27,9 @@ import Control.Applicative
|
|||||||
import Data.Char
|
import Data.Char
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
|
import Data.Either (rights)
|
||||||
|
import Data.List (inits)
|
||||||
|
import System.FilePath (joinPath, splitPath)
|
||||||
import Exception
|
import Exception
|
||||||
import Language.Haskell.GhcMod.Error
|
import Language.Haskell.GhcMod.Error
|
||||||
import Language.Haskell.GhcMod.Types
|
import Language.Haskell.GhcMod.Types
|
||||||
@ -170,12 +173,11 @@ 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
|
||||||
crdl <- cradle
|
pl <- liftIO $ rights <$> (mapM ((try :: IO FilePath -> IO (Either SomeException FilePath)) . canonicalizePath . joinPath) $ reverse $ inits $ splitPath fn)
|
||||||
let ccfn = cradleRootDir crdl </> fn
|
return $
|
||||||
fex <- liftIO $ doesFileExist ccfn
|
if (length pl > 0)
|
||||||
if fex
|
then joinPath $ (head pl):(drop (length pl - 1) (splitPath fn))
|
||||||
then liftIO $ canonicalizePath ccfn
|
else error "Current dir doesn't seem to exist?"
|
||||||
else return ccfn
|
|
||||||
|
|
||||||
mkRevRedirMapFunc :: (Functor m, GmState m, GmEnv m) => m (FilePath -> FilePath)
|
mkRevRedirMapFunc :: (Functor m, GmState m, GmEnv m) => m (FilePath -> FilePath)
|
||||||
mkRevRedirMapFunc = do
|
mkRevRedirMapFunc = do
|
||||||
|
@ -277,20 +277,20 @@ File map docs:
|
|||||||
CLI options:
|
CLI options:
|
||||||
* `--map-file "file1.hs=file2.hs"` can be used to tell
|
* `--map-file "file1.hs=file2.hs"` can be used to tell
|
||||||
ghc-mod that it should take source code for `file1.hs` from `file2.hs`.
|
ghc-mod that it should take source code for `file1.hs` from `file2.hs`.
|
||||||
`file1.hs` can be either full path, or path relative to project root.
|
`file1.hs` can be either full path, or path relative to current directory.
|
||||||
`file2.hs` has to be either relative to current directory,
|
`file2.hs` has to be either relative to current directory,
|
||||||
or full path (preferred).
|
or full path (preferred).
|
||||||
* `--map-file "file.hs"` can be used to tell ghc-mod that it should take
|
* `--map-file "file.hs"` can be used to tell ghc-mod that it should take
|
||||||
source code for `file.hs` from stdin. File end marker is `\EOT\n`,
|
source code for `file.hs` from stdin. File end marker is `\EOT\n`,
|
||||||
i.e. `\x04\x0A`. `file.hs` may or may not exist, and should be
|
i.e. `\x04\x0A`. `file.hs` may or may not exist, and should be
|
||||||
either full path, or relative to project root.
|
either full path, or relative to current directory.
|
||||||
|
|
||||||
Interactive commands:
|
Interactive commands:
|
||||||
* `map-file file.hs` -- tells ghc-modi to read `file.hs` source from stdin.
|
* `map-file file.hs` -- tells ghc-modi to read `file.hs` source from stdin.
|
||||||
Works the same as second form of `--map-file` CLI option.
|
Works the same as second form of `--map-file` CLI option.
|
||||||
* `unmap-file file.hs` -- unloads previously mapped file, so that it's
|
* `unmap-file file.hs` -- unloads previously mapped file, so that it's
|
||||||
no longer mapped. `file.hs` can be full path or relative to
|
no longer mapped. `file.hs` can be full path or relative to
|
||||||
project root, either will work.
|
current directory, either will work.
|
||||||
|
|
||||||
Exposed functions:
|
Exposed functions:
|
||||||
* `loadMappedFile :: FilePath -> FilePath -> GhcModT m ()` -- maps `FilePath`,
|
* `loadMappedFile :: FilePath -> FilePath -> GhcModT m ()` -- maps `FilePath`,
|
||||||
|
Loading…
Reference in New Issue
Block a user