ae87135 · ghcide · git.iko.soy

git.iko.soy/ghcide

on master help sign in

Create a dedicated preprocessor function, to apply all the necessary preprocessors

ae87135Neil Mitchell7 years ago

src/Development/IDE/Core/Compile.hs+2−34

compare with master

unifiedsplit

@@ -38,7 +38,6 @@ import qualified HeaderInfo as Hdr

38import MkIface

39import StringBuffer as SB

40import TidyPgm

41−import qualified GHC.LanguageExtensions as LangExt

43import Control.Monad.Extra

42import Control.Monad.Extra

44import Control.Monad.Except

43import Control.Monad.Except

@@ -264,6 +263,7 @@ getModSummaryFromBuffer fp contents dflags parsed = do

264 then (HsBootFile, \newExt -> stem <.> newExt ++ "-boot")

263 then (HsBootFile, \newExt -> stem <.> newExt ++ "-boot")

265 else (HsSrcFile , \newExt -> stem <.> newExt)

264 else (HsSrcFile , \newExt -> stem <.> newExt)

266

265

266+

267-- | Given a buffer, flags, file path and module summary, produce a

268-- parsed module (or errors) and any parse warnings.

269parseFileContents

@@ -273,27 +273,8 @@ parseFileContents

273 -> Maybe SB.StringBuffer -- ^ Haskell module source text (full Unicode is supported)

274 -> ExceptT [FileDiagnostic] m ([FileDiagnostic], ParsedModule)

275parseFileContents sourcePlugin filename mbContents = do

276+ (contents, dflags) <- preprocessor filename mbContents

276 let loc = mkRealSrcLoc (mkFastString filename) 1 1

277 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−

297 case unP Parser.parseModule (mkPState dflags contents loc) of

278 case unP Parser.parseModule (mkPState dflags contents loc) of

298 PFailed _ locErr msgErr ->

279 PFailed _ locErr msgErr ->

299 throwE $ diagFromErrMsg "parser" dflags $ mkPlainErrMsg dflags locErr msgErr

280 throwE $ diagFromErrMsg "parser" dflags $ mkPlainErrMsg dflags locErr msgErr

@@ -330,16 +311,3 @@ parseFileContents sourcePlugin filename mbContents = do

330 }

311 }

331 warnings = diagFromErrMsgs "parser" dflags warns

312 warnings = diagFromErrMsgs "parser" dflags warns

332 pure (warnings, pm)

313 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 @@

4{-# LANGUAGE RankNTypes #-}

5{-# LANGUAGE CPP #-}

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.

9module Development.IDE.Core.Preprocessor

7module Development.IDE.Core.Preprocessor

10− ( runLhs

8+ ( preprocessor

11− , runCpp

12 ) where

9 ) where

14import Development.IDE.GHC.CPP

11import Development.IDE.GHC.CPP

@@ -22,8 +19,53 @@ import Data.List.Extra

22import System.FilePath

19import System.FilePath

23import System.IO.Extra

20import System.IO.Extra

24import Data.Char

21import Data.Char

25−

22+import DynFlags

23+import qualified HeaderInfo as Hdr

24+import Development.IDE.Types.Diagnostics

25+import Development.IDE.GHC.Error

26import 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+

28-- | Run (unlit) literate haskell preprocessor on a file, or buffer if set

70-- | Run (unlit) literate haskell preprocessor on a file, or buffer if set

29runLhs :: DynFlags -> FilePath -> Maybe SB.StringBuffer -> IO SB.StringBuffer

71runLhs :: DynFlags -> FilePath -> Maybe SB.StringBuffer -> IO SB.StringBuffer