git.iko.soy/ghcide
on master help sign in
Create a dedicated preprocessor function, to apply all the necessary preprocessors
commitae87135aa5543023c296d3ed0c0f3edf849ae6cb authorNeil Mitchell <ndmitchell@gmail.com> dateWed 11 Sep 2019, 22:40 (7 years ago) parentacc834c
2 files changed+49−39
compare with master
unifiedsplit
src/Development/IDE/Core/Compile.hs+2−34 src/Development/IDE/Core/Preprocessor.hs+47−5
src/Development/IDE/Core/Compile.hs+2−34
@@ -38,7 +38,6 @@ import qualified HeaderInfo as Hdr
3838import MkIface
3939import StringBuffer as SB
4040import TidyPgm
41−import qualified GHC.LanguageExtensions as LangExt
4241
4342import Control.Monad.Extra
4443import Control.Monad.Except
@@ -264,6 +263,7 @@ getModSummaryFromBuffer fp contents dflags parsed = do
264263 then (HsBootFile, \newExt -> stem <.> newExt ++ "-boot")
265264 else (HsSrcFile , \newExt -> stem <.> newExt)
266265
266+
267267-- | Given a buffer, flags, file path and module summary, produce a
268268-- parsed module (or errors) and any parse warnings.
269269parseFileContents
@@ -273,27 +273,8 @@ parseFileContents
273273 -> Maybe SB.StringBuffer -- ^ Haskell module source text (full Unicode is supported)
274274 -> ExceptT [FileDiagnostic] m ([FileDiagnostic], ParsedModule)
275275parseFileContents sourcePlugin filename mbContents = do
276+ (contents, dflags) <- preprocessor filename mbContents
276277 let loc = mkRealSrcLoc (mkFastString filename) 1 1
277− contents <- liftIO $ maybe (hGetStringBuffer filename) return mbContents
278− let isOnDisk = isNothing mbContents
279−
280− -- unlit content if literate Haskell ending
281− (isOnDisk, contents) <- if ".lhs" `isSuffixOf` filename
282− then do
283− dflags <- getDynFlags
284− newcontent <- liftIO $ runLhs dflags filename mbContents
285− return (False, newcontent)
286− else return (isOnDisk, contents)
287−
288− dflags <- ExceptT $ parsePragmasIntoDynFlags filename contents
289− (contents, dflags) <-
290− if not $ xopt LangExt.Cpp dflags then
291− return (contents, dflags)
292− else do
293− contents <- liftIO $ runCpp dflags filename $ if isOnDisk then Nothing else Just contents
294− dflags <- ExceptT $ parsePragmasIntoDynFlags filename contents
295− return (contents, dflags)
296−
297278 case unP Parser.parseModule (mkPState dflags contents loc) of
298279 PFailed _ locErr msgErr ->
299280 throwE $ diagFromErrMsg "parser" dflags $ mkPlainErrMsg dflags locErr msgErr
@@ -330,16 +311,3 @@ parseFileContents sourcePlugin filename mbContents = do
330311 }
331312 warnings = diagFromErrMsgs "parser" dflags warns
332313 pure (warnings, pm)
333−
334−
335−-- | This reads the pragma information directly from the provided buffer.
336−parsePragmasIntoDynFlags
337− :: GhcMonad m
338− => FilePath
339− -> SB.StringBuffer
340− -> m (Either [FileDiagnostic] DynFlags)
341−parsePragmasIntoDynFlags fp contents = catchSrcErrors "pragmas" $ do
342− dflags0 <- getSessionDynFlags
343− let opts = Hdr.getOptions dflags0 contents fp
344− (dflags, _, _) <- parseDynamicFilePragma dflags0 opts
345− return dflags
src/Development/IDE/Core/Preprocessor.hs+47−5
@@ -4,11 +4,8 @@
44{-# LANGUAGE RankNTypes #-}
55{-# LANGUAGE CPP #-}
66
7−-- | Based on https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/API.
8−-- Given a list of paths to find libraries, and a file to compile, produce a list of 'CoreModule' values.
97module Development.IDE.Core.Preprocessor
10− ( runLhs
11− , runCpp
8+ ( preprocessor
129 ) where
1310
1411import Development.IDE.GHC.CPP
@@ -22,8 +19,53 @@ import Data.List.Extra
2219import System.FilePath
2320import System.IO.Extra
2421import Data.Char
25−
22+import DynFlags
23+import qualified HeaderInfo as Hdr
24+import Development.IDE.Types.Diagnostics
25+import Development.IDE.GHC.Error
2626import SysTools (Option (..), runUnlit)
27+import Control.Monad.Trans.Except
28+import qualified GHC.LanguageExtensions as LangExt
29+import Data.Maybe
30+
31+
32+-- | Given a file and some contents, apply any necessary preprocessors,
33+-- e.g. unlit/cpp. Return the resulting buffer and the DynFlags it implies.
34+preprocessor :: GhcMonad m => FilePath -> Maybe StringBuffer -> ExceptT [FileDiagnostic] m (StringBuffer, DynFlags)
35+preprocessor filename mbContents = do
36+ contents <- liftIO $ maybe (hGetStringBuffer filename) return mbContents
37+ let isOnDisk = isNothing mbContents
38+
39+ -- unlit content if literate Haskell ending
40+ (isOnDisk, contents) <- if ".lhs" `isSuffixOf` filename
41+ then do
42+ dflags <- getDynFlags
43+ newcontent <- liftIO $ runLhs dflags filename mbContents
44+ return (False, newcontent)
45+ else return (isOnDisk, contents)
46+
47+ dflags <- ExceptT $ parsePragmasIntoDynFlags filename contents
48+ if not $ xopt LangExt.Cpp dflags then
49+ return (contents, dflags)
50+ else do
51+ contents <- liftIO $ runCpp dflags filename $ if isOnDisk then Nothing else Just contents
52+ dflags <- ExceptT $ parsePragmasIntoDynFlags filename contents
53+ return (contents, dflags)
54+
55+
56+-- | This reads the pragma information directly from the provided buffer.
57+parsePragmasIntoDynFlags
58+ :: GhcMonad m
59+ => FilePath
60+ -> SB.StringBuffer
61+ -> m (Either [FileDiagnostic] DynFlags)
62+parsePragmasIntoDynFlags fp contents = catchSrcErrors "pragmas" $ do
63+ dflags0 <- getSessionDynFlags
64+ let opts = Hdr.getOptions dflags0 contents fp
65+ (dflags, _, _) <- parseDynamicFilePragma dflags0 opts
66+ return dflags
67+
68+
2769
2870-- | Run (unlit) literate haskell preprocessor on a file, or buffer if set
2971runLhs :: DynFlags -> FilePath -> Maybe SB.StringBuffer -> IO SB.StringBuffer