Add FileMapping support to HMG/preprocessFile
Post-rebase update
This commit is contained in:
parent
70d2a4704b
commit
654b172f5e
@ -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))
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user