Add FileMapping support to HMG/preprocessFile

Post-rebase update
This commit is contained in:
Nikolay Yakimov 2015-08-16 18:22:27 +03:00
parent 70d2a4704b
commit 654b172f5e
2 changed files with 24 additions and 1 deletions

View File

@ -54,12 +54,15 @@ import Data.Set (Set)
import qualified Data.Set as Set
import System.FilePath
import System.Directory
import System.IO
import System.IO.Temp
import Prelude
import Language.Haskell.GhcMod.Logging
import Language.Haskell.GhcMod.Logger
import Language.Haskell.GhcMod.Monad.Types
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Utils (getMappedFileSource)
import Language.Haskell.GhcMod.Gap (parseModuleHeader)
-- | Turn module graph into a graphviz dot file
@ -244,8 +247,19 @@ preprocessFile :: (IOish m, GmEnv m, GmState m) =>
HscEnv -> FilePath -> m (Either [String] ([String], (DynFlags, FilePath)))
preprocessFile env file =
withLogger' env $ \setDf -> do
src <- runMaybeT $ getMappedFileSource file
let env' = env { hsc_dflags = setDf (hsc_dflags env) }
liftIO $ preprocess env' (file, Nothing)
maybe
(liftIO $ preprocess env' (file, Nothing))
(preprocessWithTemp env' file)
src
where
preprocessWithTemp env' fn src = do
tmpdir <- cradleTempDir <$> cradle
liftIO $ withTempFile tmpdir fn $ \fn' hndl -> do
hPutStr hndl src
hClose hndl
preprocess env' (fn', Nothing)
fileModuleName :: (IOish m, GmEnv m, GmState m) =>
HscEnv -> FilePath -> m (Either [String] (Maybe ModuleName))

View File

@ -44,6 +44,7 @@ import Text.Printf
import Paths_ghc_mod (getLibexecDir)
import Utils
import Prelude
import Control.Monad.Trans.Maybe
-- dropWhileEnd is not provided prior to base 4.5.0.0.
dropWhileEnd :: (a -> Bool) -> [a] -> [a]
@ -186,6 +187,14 @@ getCanonicalFileNameSafe fn = do
then liftIO $ canonicalizePath ccfn
else return ccfn
getMappedFileSource :: (IOish m, GmEnv m, GmState m) => FilePath -> MaybeT m String
getMappedFileSource fn = do
mf <- MaybeT $ getCanonicalFileNameSafe fn >>= lookupMMappedFile
case mf of
RedirectedMapping fn' -> liftIO $ readFile fn'
MemoryMapping (Just src) -> return src
_ -> mzero
mkRevRedirMapFunc :: (Functor m, GmState m, GmEnv m) => m (FilePath -> FilePath)
mkRevRedirMapFunc = do
rm <- M.fromList <$> mapMaybe (uncurry mf) <$> M.toList <$> getMMappedFiles