Create shake getParsedModuleWithCommentsRule

Author: jneira

ghcide/src/Development/IDE/Core/RuleTypes.hs

@@ -54,6 +54,10 @@ data LinkableType = ObjectLinkable | BCOLinkable
 -- | The parse tree for the file using GetFileContents
 type instance RuleResult GetParsedModule = ParsedModule
 
+-- | The parse tree for the file using GetFileContents,
+-- all comments included using Opt_KeepRawTokenStream
+type instance RuleResult GetParsedModuleWithComments = ParsedModule
+
 -- | The dependency information produced by following the imports recursively.
 -- This rule will succeed even if there is an error, e.g., a module could not be located,
 -- a module could not be parsed or an import cycle.
@@ -302,6 +306,12 @@ instance Hashable GetParsedModule
 instance NFData   GetParsedModule
 instance Binary   GetParsedModule
 
+data GetParsedModuleWithComments = GetParsedModuleWithComments
+    deriving (Eq, Show, Typeable, Generic)
+instance Hashable GetParsedModuleWithComments
+instance NFData   GetParsedModuleWithComments
+instance Binary   GetParsedModuleWithComments
+
 data GetLocatedImports = GetLocatedImports
     deriving (Eq, Show, Typeable, Generic)
 instance Hashable GetLocatedImports

ghcide/src/Development/IDE/Core/Rules.hs

@@ -28,6 +28,7 @@ module Development.IDE.Core.Rules(
     getDependencies,
     getParsedModule,
     getClientConfigAction,
+    getParsedModuleWithComments
     ) where
 
 import Fingerprint
@@ -242,9 +243,14 @@ getPackageHieFile ide mod file = do
                 _ -> MaybeT $ return Nothing
         _ -> MaybeT $ return Nothing
 
--- | Parse the contents of a daml file.
+-- | Parse the contents of a haskell file.
 getParsedModule :: NormalizedFilePath -> Action (Maybe ParsedModule)
-getParsedModule file = use GetParsedModule file
+getParsedModule = use GetParsedModule
+
+-- | Parse the contents of a haskell file,
+-- ensuring comments are preserved in annotations
+getParsedModuleWithComments :: NormalizedFilePath -> Action (Maybe ParsedModule)
+getParsedModuleWithComments = use GetParsedModule
 
 ------------------------------------------------------------
 -- Rules
@@ -307,8 +313,10 @@ getParsedModuleRule = defineEarlyCutoff $ \GetParsedModule file -> do
     pure res
 
 withOptHaddock :: ModSummary -> ModSummary
-withOptHaddock ms = ms{ms_hspp_opts= gopt_set (ms_hspp_opts ms) Opt_Haddock}
+withOptHaddock = withOption Opt_Haddock
 
+withOption :: GeneralFlag -> ModSummary -> ModSummary
+withOption opt ms = ms{ms_hspp_opts= gopt_set (ms_hspp_opts ms) opt}
 
 -- | Given some normal parse errors (first) and some from Haddock (second), merge them.
 --   Ignore Haddock errors that are in both. Demote Haddock-only errors to warnings.
@@ -322,6 +330,16 @@ mergeParseErrorsHaddock normal haddock = normal ++
     fixMessage x | "parse error " `T.isPrefixOf` x = "Haddock " <> x
                  | otherwise = "Haddock: " <> x
 
+getParsedModuleWithCommentsRule :: Rules ()
+getParsedModuleWithCommentsRule = defineEarlyCutoff $ \GetParsedModuleWithComments file -> do
+    (ms, _) <- use_ GetModSummary file
+    sess <- use_ GhcSession file
+    opt <- getIdeOptions
+
+    let ms' = withOption Opt_KeepRawTokenStream ms
+
+    liftIO $ getParsedModuleDefinition (hscEnv sess) opt file ms'
+
 getParsedModuleDefinition :: HscEnv -> IdeOptions -> NormalizedFilePath -> ModSummary -> IO (Maybe ByteString, ([FileDiagnostic], Maybe ParsedModule))
 getParsedModuleDefinition packageState opt file ms = do
     let fp = fromNormalizedFilePath file
@@ -948,6 +966,7 @@ mainRule = do
     linkables <- liftIO $ newVar emptyModuleEnv
     addIdeGlobal $ CompiledLinkables linkables
     getParsedModuleRule
+    getParsedModuleWithCommentsRule
     getLocatedImportsRule
     getDependencyInformationRule
     reportImportCyclesRule