Merge branch 'file-redirection-2' of https://github.com/atom-haskell/ghc-mod
This commit is contained in:
commit
91f0c50b20
@ -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, 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
|
||||||
@ -170,12 +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
|
||||||
crdl <- cradle
|
let fn' = normalise fn
|
||||||
let ccfn = cradleRootDir crdl </> fn
|
pl <- liftIO $ rights <$> (mapM ((try :: IO FilePath -> IO (Either SomeException FilePath)) . canonicalizePath . joinPath) $ reverse $ inits $ splitPath' fn')
|
||||||
fex <- liftIO $ doesFileExist ccfn
|
return $
|
||||||
if fex
|
if (length pl > 0)
|
||||||
then liftIO $ canonicalizePath ccfn
|
then joinPath $ (head pl):(drop (length pl - 1) (splitPath fn'))
|
||||||
else return ccfn
|
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
|
||||||
|
@ -277,7 +277,7 @@ 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 project root.
|
||||||
`file2.hs` has to be either relative to current directory,
|
`file2.hs` has to be either relative to project root,
|
||||||
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`,
|
||||||
|
Loading…
Reference in New Issue
Block a user