18ee98f · ghcide · git.iko.soy

git.iko.soy/ghcide

on master help sign in

Pull the preprocessor functions into a separate module

18ee98fNeil Mitchell7 years ago

ghcide.cabal+1

compare with master

unifiedsplit

@@ -99,6 +99,7 @@ library

99 other-modules:

100 Development.IDE.Core.Debouncer

101 Development.IDE.Core.Compile

102+ Development.IDE.Core.Preprocessor

102 Development.IDE.GHC.Compat

103 Development.IDE.GHC.Compat

103 Development.IDE.GHC.CPP

104 Development.IDE.GHC.CPP

104 Development.IDE.GHC.Error

105 Development.IDE.GHC.Error

src/Development/IDE/Core/Compile.hs+1−70

@@ -16,13 +16,12 @@ module Development.IDE.Core.Compile

16 ) where

18import Development.IDE.Core.RuleTypes

19−import Development.IDE.GHC.CPP

19+import Development.IDE.Core.Preprocessor

20import Development.IDE.GHC.Error

21import Development.IDE.GHC.Warnings

22import Development.IDE.Types.Diagnostics

23import Development.IDE.GHC.Orphans()

24import Development.IDE.GHC.Util

25−import Development.IDE.GHC.Compat

26import qualified GHC.LanguageExtensions.Type as GHC

25import qualified GHC.LanguageExtensions.Type as GHC

27import Development.IDE.Types.Options

26import Development.IDE.Types.Options

28import Development.IDE.Types.Location

27import Development.IDE.Types.Location

@@ -54,10 +53,6 @@ import Data.Maybe

54import Data.Tuple.Extra

53import Data.Tuple.Extra

55import qualified Data.Map.Strict as Map

54import qualified Data.Map.Strict as Map

56import System.FilePath

55import System.FilePath

57−import System.IO.Extra

58−import Data.Char

59−

60−import SysTools (Option (..), runUnlit)

63-- | Given a string buffer, return a pre-processed @ParsedModule@.

58-- | Given a string buffer, return a pre-processed @ParsedModule@.

@@ -270,70 +265,6 @@ getModSummaryFromBuffer fp contents dflags parsed = do

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

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

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

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

272

267

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

274−runLhs :: DynFlags -> FilePath -> Maybe SB.StringBuffer -> IO SB.StringBuffer

275−runLhs dflags filename contents = withTempDir $ \dir -> do

276− let fout = dir </> takeFileName filename <.> "unlit"

277− filesrc <- case contents of

278− Nothing -> return filename

279− Just cnts -> do

280− let fsrc = dir </> takeFileName filename <.> "literate"

281− withBinaryFile fsrc WriteMode $ \h ->

282− hPutStringBuffer h cnts

283− return fsrc

284− unlit filesrc fout

285− SB.hGetStringBuffer fout

286− where

287− unlit filein fileout = SysTools.runUnlit dflags (args filein fileout)

288− args filein fileout = [

289− SysTools.Option "-h"

290− , SysTools.Option (escape filename) -- name this file

291− , SysTools.FileOption "" filein -- input file

292− , SysTools.FileOption "" fileout ] -- output file

293− -- taken from ghc's DriverPipeline.hs

294− escape ('\\':cs) = '\\':'\\': escape cs

295− escape ('\"':cs) = '\\':'\"': escape cs

296− escape ('\'':cs) = '\\':'\'': escape cs

297− escape (c:cs) = c : escape cs

298− escape [] = []

299−

300−-- | Run CPP on a file

301−runCpp :: DynFlags -> FilePath -> Maybe SB.StringBuffer -> IO SB.StringBuffer

302−runCpp dflags filename contents = withTempDir $ \dir -> do

303− let out = dir </> takeFileName filename <.> "out"

304− case contents of

305− Nothing -> do

306− -- Happy case, file is not modified, so run CPP on it in-place

307− -- which also makes things like relative #include files work

308− -- and means location information is correct

309− doCpp dflags True filename out

310− liftIO $ SB.hGetStringBuffer out

311−

312− Just contents -> do

313− -- Sad path, we have to create a version of the path in a temp dir

314− -- __FILE__ macro is wrong, ignoring that for now (likely not a real issue)

315−

316− -- Relative includes aren't going to work, so we fix that by adding to the include path.

317− dflags <- return $ addIncludePathsQuote (takeDirectory filename) dflags

318−

319− -- Location information is wrong, so we fix that by patching it afterwards.

320− let inp = dir </> "___GHCIDE_MAGIC___"

321− withBinaryFile inp WriteMode $ \h ->

322− hPutStringBuffer h contents

323− doCpp dflags True inp out

324−

325− -- Fix up the filename in lines like:

326− -- # 1 "C:/Temp/extra-dir-914611385186/___GHCIDE_MAGIC___"

327− let tweak x

328− | Just x <- stripPrefix "# " x

329− , "___GHCIDE_MAGIC___" `isInfixOf` x

330− , let num = takeWhile (not . isSpace) x

331− -- important to use /, and never \ for paths, even on Windows, since then C escapes them

332− -- and GHC gets all confused

333− = "# " <> num <> " \"" <> map (\x -> if isPathSeparator x then '/' else x) filename <> "\""

334− | otherwise = x

335− stringToStringBuffer . unlines . map tweak . lines <$> readFileUTF8' out

336−

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

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

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

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

339parseFileContents

270parseFileContents

src/Development/IDE/Core/Preprocessor.hsnew file+90

@@ -0,0 +1,90 @@

2+-- SPDX-License-Identifier: Apache-2.0

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.

9+module Development.IDE.Core.Preprocessor

10+ ( runLhs

11+ , runCpp

12+ ) where

13+

14+import Development.IDE.GHC.CPP

15+import Development.IDE.GHC.Orphans()

16+import Development.IDE.GHC.Compat

17+import GHC

18+import GhcMonad

19+import StringBuffer as SB

20+

21+import Data.List.Extra

22+import System.FilePath

23+import System.IO.Extra

24+import Data.Char

25+

26+import SysTools (Option (..), runUnlit)

27+

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

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

30+runLhs dflags filename contents = withTempDir $ \dir -> do

31+ let fout = dir </> takeFileName filename <.> "unlit"

32+ filesrc <- case contents of

33+ Nothing -> return filename

34+ Just cnts -> do

35+ let fsrc = dir </> takeFileName filename <.> "literate"

36+ withBinaryFile fsrc WriteMode $ \h ->

37+ hPutStringBuffer h cnts

38+ return fsrc

39+ unlit filesrc fout

40+ SB.hGetStringBuffer fout

41+ where

42+ unlit filein fileout = SysTools.runUnlit dflags (args filein fileout)

43+ args filein fileout = [

44+ SysTools.Option "-h"

45+ , SysTools.Option (escape filename) -- name this file

46+ , SysTools.FileOption "" filein -- input file

47+ , SysTools.FileOption "" fileout ] -- output file

48+ -- taken from ghc's DriverPipeline.hs

49+ escape ('\\':cs) = '\\':'\\': escape cs

50+ escape ('\"':cs) = '\\':'\"': escape cs

51+ escape ('\'':cs) = '\\':'\'': escape cs

52+ escape (c:cs) = c : escape cs

53+ escape [] = []

54+

55+-- | Run CPP on a file

56+runCpp :: DynFlags -> FilePath -> Maybe SB.StringBuffer -> IO SB.StringBuffer

57+runCpp dflags filename contents = withTempDir $ \dir -> do

58+ let out = dir </> takeFileName filename <.> "out"

59+ case contents of

60+ Nothing -> do

61+ -- Happy case, file is not modified, so run CPP on it in-place

62+ -- which also makes things like relative #include files work

63+ -- and means location information is correct

64+ doCpp dflags True filename out

65+ liftIO $ SB.hGetStringBuffer out

66+

67+ Just contents -> do

68+ -- Sad path, we have to create a version of the path in a temp dir

69+ -- __FILE__ macro is wrong, ignoring that for now (likely not a real issue)

70+

71+ -- Relative includes aren't going to work, so we fix that by adding to the include path.

72+ dflags <- return $ addIncludePathsQuote (takeDirectory filename) dflags

73+

74+ -- Location information is wrong, so we fix that by patching it afterwards.

75+ let inp = dir </> "___GHCIDE_MAGIC___"

76+ withBinaryFile inp WriteMode $ \h ->

77+ hPutStringBuffer h contents

78+ doCpp dflags True inp out

79+

80+ -- Fix up the filename in lines like:

81+ -- # 1 "C:/Temp/extra-dir-914611385186/___GHCIDE_MAGIC___"

82+ let tweak x

83+ | Just x <- stripPrefix "# " x

84+ , "___GHCIDE_MAGIC___" `isInfixOf` x

85+ , let num = takeWhile (not . isSpace) x

86+ -- important to use /, and never \ for paths, even on Windows, since then C escapes them

87+ -- and GHC gets all confused

88+ = "# " <> num <> " \"" <> map (\x -> if isPathSeparator x then '/' else x) filename <> "\""

89+ | otherwise = x

90+ stringToStringBuffer . unlines . map tweak . lines <$> readFileUTF8' out