address review feedback

.hlint.yaml

@@ -95,8 +95,7 @@
 - flags:
   - default: false
   - {name: [-Wno-missing-signatures, -Wno-orphans, -Wno-overlapping-patterns, -Wno-incomplete-patterns, -Wno-missing-fields, -Wno-unused-matches]}
-  - {name: [-Wno-dodgy-imports], within: Main}
-  - {name: [-Wno-dodgy-imports], within: Development.IDE.GHC.Compat}
+  - {name: [-Wno-dodgy-imports], within: [Main, Development.IDE.GHC.Compat]}
 # - modules:
 #   - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'
 #   - {name: Control.Arrow, within: []} # Certain modules are banned entirely

src/Development/IDE/Core/Compile.hs

@@ -490,7 +490,7 @@ parseHeader
        => DynFlags -- ^ flags to use
        -> FilePath  -- ^ the filename (for source locations)
        -> SB.StringBuffer -- ^ Haskell module source text (full Unicode is supported)
-       -> ExceptT [FileDiagnostic] m (Located(HsModule GhcPs))
+       -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule GhcPs))
 parseHeader dflags filename contents = do
    let loc  = mkRealSrcLoc (mkFastString filename) 1 1
    case unP Parser.parseHeader (mkPState dflags contents loc) of
@@ -501,7 +501,22 @@ parseHeader dflags filename contents = do
      PFailed _ locErr msgErr ->
         throwE $ diagFromErrMsg "parser" dflags $ mkPlainErrMsg dflags locErr msgErr
 #endif
-     POk _ rdr_module -> return rdr_module
+     POk pst rdr_module -> do
+        let (warns, errs) = getMessages pst dflags
+        -- Just because we got a `POk`, it doesn't mean there
+        -- weren't errors! To clarify, the GHC parser
+        -- distinguishes between fatal and non-fatal
+        -- errors. Non-fatal errors are the sort that don't
+        -- prevent parsing from continuing (that is, a parse
+        -- tree can still be produced despite the error so that
+        -- further errors/warnings can be collected). Fatal
+        -- errors are those from which a parse tree just can't
+        -- be produced.
+        unless (null errs) $
+            throwE $ diagFromErrMsgs "parser" dflags errs
+
+        let warnings = diagFromErrMsgs "parser" dflags warns
+        return (warnings, rdr_module)
 
 -- | Given a buffer, flags, and file path, produce a
 -- parsed module (or errors) and any parse warnings. Does not run any preprocessors
@@ -540,7 +555,7 @@ parseFileContents customPreprocessor dflags comp_pkgs filename contents = do
                -- errors are those from which a parse tree just can't
                -- be produced.
                unless (null errs) $
-                 throwE $ diagFromErrMsgs "parser" dflags $ snd $ getMessages pst dflags
+                 throwE $ diagFromErrMsgs "parser" dflags errs
 
                -- Ok, we got here. It's safe to continue.
                let IdePreprocessedSource preproc_warns errs parsed = customPreprocessor rdr_module

src/Development/IDE/Plugin/Completions.hs

@@ -83,7 +83,7 @@ produceCompletions = do
                     dflags = hsc_dflags env
                 pm <- liftIO $ evalGhcEnv env $ runExceptT $ parseHeader dflags f buf
                 case pm of
-                    Right hsMod -> do
+                    Right (_diags, hsMod) -> do
                         let hsModNoExports = hsMod <&> \x -> x{hsmodExports = Nothing}
                             pm = ParsedModule
                                     { pm_mod_summary = ms
@@ -95,6 +95,8 @@ produceCompletions = do
                         case tm of
                             (_, Just (_,TcModuleResult{..})) -> do
                                 cdata <- liftIO $ cacheDataProducer env tmrModule parsedDeps
+                                -- Do not return diags from parsing as they would duplicate
+                                -- the diagnostics from typechecking
                                 return ([], Just cdata)
                             (_diag, _) ->
                                 return ([], Nothing)

src/Development/IDE/Plugin/Completions/Logic.hs

@@ -310,7 +310,7 @@ cacheDataProducer packageState tm deps = do
 
 -- | Produces completions from the top level declarations of a module.
 localCompletionsForParsedModule :: ParsedModule -> CachedCompletions
-localCompletionsForParsedModule pm@ParsedModule{pm_parsed_source = L _ HsModule{hsmodDecls}} =
+localCompletionsForParsedModule pm@ParsedModule{pm_parsed_source = L _ HsModule{hsmodDecls, hsmodName}} =
     CC { allModNamesAsNS = mempty
        , unqualCompls = compls
        , qualCompls = mempty
@@ -353,11 +353,13 @@ localCompletionsForParsedModule pm@ParsedModule{pm_parsed_source = L _ HsModule{
         ]
 
     mkComp n ctyp ty =
-        CI ctyp pn "this module" ty pn Nothing doc (ctyp `elem` [CiStruct, CiClass])
+        CI ctyp pn thisModName ty pn Nothing doc (ctyp `elem` [CiStruct, CiClass])
       where
         pn = ppr n
         doc = SpanDocText $ getDocumentation [pm] n
 
+    thisModName = ppr hsmodName
+
     ppr :: Outputable a => a -> T.Text
     ppr = T.pack . prettyPrint