Pull the preprocessor functions into a separate module

Author: ndmitchell

ghcide.cabal

@@ -99,6 +99,7 @@ library
     other-modules:
         Development.IDE.Core.Debouncer
         Development.IDE.Core.Compile
+        Development.IDE.Core.Preprocessor
         Development.IDE.GHC.Compat
         Development.IDE.GHC.CPP
         Development.IDE.GHC.Error

src/Development/IDE/Core/Compile.hs

@@ -16,13 +16,12 @@ module Development.IDE.Core.Compile
   ) where
 
 import Development.IDE.Core.RuleTypes
-import Development.IDE.GHC.CPP
+import Development.IDE.Core.Preprocessor
 import Development.IDE.GHC.Error
 import Development.IDE.GHC.Warnings
 import Development.IDE.Types.Diagnostics
 import Development.IDE.GHC.Orphans()
 import Development.IDE.GHC.Util
-import Development.IDE.GHC.Compat
 import qualified GHC.LanguageExtensions.Type as GHC
 import Development.IDE.Types.Options
 import Development.IDE.Types.Location
@@ -54,10 +53,6 @@ import           Data.Maybe
 import           Data.Tuple.Extra
 import qualified Data.Map.Strict                          as Map
 import           System.FilePath
-import System.IO.Extra
-import Data.Char
-
-import SysTools (Option (..), runUnlit)
 
 
 -- | Given a string buffer, return a pre-processed @ParsedModule@.
@@ -270,70 +265,6 @@ getModSummaryFromBuffer fp contents dflags parsed = do
           then (HsBootFile, \newExt -> stem <.> newExt ++ "-boot")
           else (HsSrcFile , \newExt -> stem <.> newExt)
 
--- | Run (unlit) literate haskell preprocessor on a file, or buffer if set
-runLhs :: DynFlags -> FilePath -> Maybe SB.StringBuffer -> IO SB.StringBuffer
-runLhs dflags filename contents = withTempDir $ \dir -> do
-    let fout = dir </> takeFileName filename <.> "unlit"
-    filesrc <- case contents of
-        Nothing   -> return filename
-        Just cnts -> do
-            let fsrc = dir </> takeFileName filename <.> "literate"
-            withBinaryFile fsrc WriteMode $ \h ->
-                hPutStringBuffer h cnts
-            return fsrc
-    unlit filesrc fout
-    SB.hGetStringBuffer fout
-  where
-    unlit filein fileout = SysTools.runUnlit dflags (args filein fileout)
-    args filein fileout = [
-                      SysTools.Option     "-h"
-                    , SysTools.Option     (escape filename) -- name this file
-                    , SysTools.FileOption "" filein       -- input file
-                    , SysTools.FileOption "" fileout ]    -- output file
-    -- taken from ghc's DriverPipeline.hs
-    escape ('\\':cs) = '\\':'\\': escape cs
-    escape ('\"':cs) = '\\':'\"': escape cs
-    escape ('\'':cs) = '\\':'\'': escape cs
-    escape (c:cs)    = c : escape cs
-    escape []        = []
-
--- | Run CPP on a file
-runCpp :: DynFlags -> FilePath -> Maybe SB.StringBuffer -> IO SB.StringBuffer
-runCpp dflags filename contents = withTempDir $ \dir -> do
-    let out = dir </> takeFileName filename <.> "out"
-    case contents of
-        Nothing -> do
-            -- Happy case, file is not modified, so run CPP on it in-place
-            -- which also makes things like relative #include files work
-            -- and means location information is correct
-            doCpp dflags True filename out
-            liftIO $ SB.hGetStringBuffer out
-
-        Just contents -> do
-            -- Sad path, we have to create a version of the path in a temp dir
-            -- __FILE__ macro is wrong, ignoring that for now (likely not a real issue)
-
-            -- Relative includes aren't going to work, so we fix that by adding to the include path.
-            dflags <- return $ addIncludePathsQuote (takeDirectory filename) dflags
-
-            -- Location information is wrong, so we fix that by patching it afterwards.
-            let inp = dir </> "___GHCIDE_MAGIC___"
-            withBinaryFile inp WriteMode $ \h ->
-                hPutStringBuffer h contents
-            doCpp dflags True inp out
-
-            -- Fix up the filename in lines like:
-            -- # 1 "C:/Temp/extra-dir-914611385186/___GHCIDE_MAGIC___"
-            let tweak x
-                    | Just x <- stripPrefix "# " x
-                    , "___GHCIDE_MAGIC___" `isInfixOf` x
-                    , let num = takeWhile (not . isSpace) x
-                    -- important to use /, and never \ for paths, even on Windows, since then C escapes them
-                    -- and GHC gets all confused
-                        = "# " <> num <> " \"" <> map (\x -> if isPathSeparator x then '/' else x) filename <> "\""
-                    | otherwise = x
-            stringToStringBuffer . unlines . map tweak . lines <$> readFileUTF8' out
-
 -- | Given a buffer, flags, file path and module summary, produce a
 -- parsed module (or errors) and any parse warnings.
 parseFileContents

src/Development/IDE/Core/Preprocessor.hs

@@ -0,0 +1,90 @@
+-- Copyright (c) 2019 The DAML Authors. All rights reserved.
+-- SPDX-License-Identifier: Apache-2.0
+
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE CPP #-}
+
+-- | Based on https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/API.
+--   Given a list of paths to find libraries, and a file to compile, produce a list of 'CoreModule' values.
+module Development.IDE.Core.Preprocessor
+  ( runLhs
+  , runCpp
+  ) where
+
+import Development.IDE.GHC.CPP
+import Development.IDE.GHC.Orphans()
+import Development.IDE.GHC.Compat
+import GHC
+import           GhcMonad
+import           StringBuffer                   as SB
+
+import           Data.List.Extra
+import           System.FilePath
+import System.IO.Extra
+import Data.Char
+
+import SysTools (Option (..), runUnlit)
+
+-- | Run (unlit) literate haskell preprocessor on a file, or buffer if set
+runLhs :: DynFlags -> FilePath -> Maybe SB.StringBuffer -> IO SB.StringBuffer
+runLhs dflags filename contents = withTempDir $ \dir -> do
+    let fout = dir </> takeFileName filename <.> "unlit"
+    filesrc <- case contents of
+        Nothing   -> return filename
+        Just cnts -> do
+            let fsrc = dir </> takeFileName filename <.> "literate"
+            withBinaryFile fsrc WriteMode $ \h ->
+                hPutStringBuffer h cnts
+            return fsrc
+    unlit filesrc fout
+    SB.hGetStringBuffer fout
+  where
+    unlit filein fileout = SysTools.runUnlit dflags (args filein fileout)
+    args filein fileout = [
+                      SysTools.Option     "-h"
+                    , SysTools.Option     (escape filename) -- name this file
+                    , SysTools.FileOption "" filein       -- input file
+                    , SysTools.FileOption "" fileout ]    -- output file
+    -- taken from ghc's DriverPipeline.hs
+    escape ('\\':cs) = '\\':'\\': escape cs
+    escape ('\"':cs) = '\\':'\"': escape cs
+    escape ('\'':cs) = '\\':'\'': escape cs
+    escape (c:cs)    = c : escape cs
+    escape []        = []
+
+-- | Run CPP on a file
+runCpp :: DynFlags -> FilePath -> Maybe SB.StringBuffer -> IO SB.StringBuffer
+runCpp dflags filename contents = withTempDir $ \dir -> do
+    let out = dir </> takeFileName filename <.> "out"
+    case contents of
+        Nothing -> do
+            -- Happy case, file is not modified, so run CPP on it in-place
+            -- which also makes things like relative #include files work
+            -- and means location information is correct
+            doCpp dflags True filename out
+            liftIO $ SB.hGetStringBuffer out
+
+        Just contents -> do
+            -- Sad path, we have to create a version of the path in a temp dir
+            -- __FILE__ macro is wrong, ignoring that for now (likely not a real issue)
+
+            -- Relative includes aren't going to work, so we fix that by adding to the include path.
+            dflags <- return $ addIncludePathsQuote (takeDirectory filename) dflags
+
+            -- Location information is wrong, so we fix that by patching it afterwards.
+            let inp = dir </> "___GHCIDE_MAGIC___"
+            withBinaryFile inp WriteMode $ \h ->
+                hPutStringBuffer h contents
+            doCpp dflags True inp out
+
+            -- Fix up the filename in lines like:
+            -- # 1 "C:/Temp/extra-dir-914611385186/___GHCIDE_MAGIC___"
+            let tweak x
+                    | Just x <- stripPrefix "# " x
+                    , "___GHCIDE_MAGIC___" `isInfixOf` x
+                    , let num = takeWhile (not . isSpace) x
+                    -- important to use /, and never \ for paths, even on Windows, since then C escapes them
+                    -- and GHC gets all confused
+                        = "# " <> num <> " \"" <> map (\x -> if isPathSeparator x then '/' else x) filename <> "\""
+                    | otherwise = x
+            stringToStringBuffer . unlines . map tweak . lines <$> readFileUTF8' out