@@ -58,6 +58,7 @@ import Development.IDE.Spans.Type
5858import System.FilePath
5959import System.Directory
6060import System.IO.Extra
61+import Data.Char
6162
6263
6364-- | Contains the typechecked module and the OrigNameCache entry for
@@ -91,7 +92,7 @@ parseModule
9192 :: IdeOptions
9293 -> HscEnv
9394 -> FilePath
94− -> SB.StringBuffer
95+ -> Maybe SB.StringBuffer
9596 -> IO ([FileDiagnostic], Maybe ParsedModule)
9697parseModule IdeOptions{..} env file =
9798 fmap (either (, Nothing) (second Just)) .
@@ -310,15 +311,55 @@ getModSummaryFromBuffer fp contents dflags parsed = do
310311 , ms_parsed_mod = Nothing
311312 }
312313
314+-- | Run CPP on a file
315+runCpp :: DynFlags -> FilePath -> Maybe SB.StringBuffer -> IO SB.StringBuffer
316+runCpp dflags filename contents = withTempDir $ \dir -> do
317+ let out = dir </> takeFileName filename <.> "out"
318+ case contents of
319+ Nothing -> do
320+ -- Happy case, file is not modified, so run CPP on it in-place
321+ -- which also makes things like relative #include files work
322+ -- and means location information is correct
323+ doCpp dflags True filename out
324+ liftIO $ SB.hGetStringBuffer out
325+
326+ Just contents -> do
327+ -- Sad path, we have to create a version of the path in a temp dir
328+ -- __FILE__ macro is wrong, ignoring that for now (likely not a real issue)
329+
330+ -- Relative includes aren't going to work, so we fix that by adding to the include path.
331+ let addSelf (IncludeSpecs quote global) = IncludeSpecs (takeDirectory filename : quote) global
332+ dflags <- return dflags{includePaths = addSelf $ includePaths dflags}
333+
334+ -- Location information is wrong, so we fix that by patching it afterwards.
335+ let inp = dir </> "___HIE_CORE_MAGIC___"
336+ withBinaryFile inp WriteMode $ \h ->
337+ hPutStringBuffer h contents
338+ doCpp dflags True inp out
339+
340+ -- Fix up the filename in lines like:
341+ -- # 1 "C:/Temp/extra-dir-914611385186/___HIE_CORE_MAGIC___"
342+ let tweak x
343+ | Just x <- stripPrefix "# " x
344+ , "___HIE_CORE_MAGIC___" `isInfixOf` x
345+ , let num = takeWhile (not . isSpace) x
346+ -- important to use /, and never \ for paths, even on Windows, since then C escapes them
347+ -- and GHC gets all confused
348+ = "# " <> num <> " \"" <> map (\x -> if isPathSeparator x then '/' else x) filename <> "\""
349+ | otherwise = x
350+ stringToStringBuffer . unlines . map tweak . lines <$> readFileUTF8' out
351+
352+
313353-- | Given a buffer, flags, file path and module summary, produce a
314354-- parsed module (or errors) and any parse warnings.
315355parseFileContents
316356 :: GhcMonad m
317357 => (GHC.ParsedSource -> ([(GHC.SrcSpan, String)], GHC.ParsedSource))
318358 -> FilePath -- ^ the filename (for source locations)
319− -> SB.StringBuffer -- ^ Haskell module source text (full Unicode is supported)
359+ -> Maybe SB.StringBuffer -- ^ Haskell module source text (full Unicode is supported)
320360 -> ExceptT [FileDiagnostic] m ([FileDiagnostic], ParsedModule)
321−parseFileContents preprocessor filename contents = do
361+parseFileContents preprocessor filename mbContents = do
362+ contents <- liftIO $ maybe (hGetStringBuffer filename) return mbContents
322363 let loc = mkRealSrcLoc (mkFastString filename) 1 1
323364 dflags <- ExceptT $ parsePragmasIntoDynFlags filename contents
324365
@@ -326,13 +367,7 @@ parseFileContents preprocessor filename contents = do
326367 if not $ xopt LangExt.Cpp dflags then
327368 return (contents, dflags)
328369 else do
329− contents <- liftIO $ withTempDir $ \dir -> do
330− let inp = dir </> takeFileName filename
331− let out = dir </> takeFileName filename <.> "out"
332− let f x = if SB.atEnd x then Nothing else Just $ SB.nextChar x
333− liftIO $ writeFileUTF8 inp (unfoldr f contents)
334− doCpp dflags True inp out
335− liftIO $ SB.hGetStringBuffer out
370+ contents <- liftIO $ runCpp dflags filename mbContents
336371 dflags <- ExceptT $ parsePragmasIntoDynFlags filename contents
337372 return (contents, dflags)
338373