Skip to content
This repository has been archived by the owner on Jan 2, 2021. It is now read-only.

#573, make haddock errors warnings with the word Haddock in front #608

Merged
merged 3 commits into from
Jun 9, 2020
Merged

#573, make haddock errors warnings with the word Haddock in front #608

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
64001e4
#573, make haddock errors warnings with the word Haddock in front
ndmitchell Jun 6, 2020
6b997c7
Update Rules.hs
ndmitchell Jun 6, 2020
9a278bb
Deal with Haddock failures in getModIfaceRule
ndmitchell Jun 6, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
22 changes: 18 additions & 4 deletions src/Development/IDE/Core/Rules.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,7 @@ module Development.IDE.Core.Rules(
import Fingerprint

import Data.Binary hiding (get, put)
import Data.Bifunctor (first, second)
import Data.Tuple.Extra
import Control.Monad.Extra
import Control.Monad.Trans.Class
import Control.Monad.Trans.Maybe
Expand All @@ -41,7 +41,7 @@ import Development.IDE.Import.DependencyInformation
import Development.IDE.Import.FindImports
import Development.IDE.Core.FileExists
import Development.IDE.Core.FileStore (getFileContents)
import Development.IDE.Types.Diagnostics
import Development.IDE.Types.Diagnostics as Diag
import Development.IDE.Types.Location
import Development.IDE.GHC.Compat hiding (parseModule, typecheckModule)
import Development.IDE.GHC.Util
Expand Down Expand Up @@ -212,15 +212,29 @@ getParsedModuleRule = defineEarlyCutoff $ \GetParsedModule file -> do
haddockParse = do
(_, (!diagsHaddock, _)) <-
getParsedModuleDefinition hscHaddock opt comp_pkgs file contents
return diagsHaddock
-- Haddock diagnostics are confusing because they don't say Haddock, and are errors.
-- Fix both those properties.
return $ map (\(a,b,c) -> (a,b,fixHaddockWarning c)) diagsHaddock

((fingerPrint, (diags, res)), diagsHaddock) <-
-- parse twice, with and without Haddocks, concurrently
-- we cannot ignore Haddock parse errors because files of
-- non-interest are always parsed with Haddocks
liftIO $ concurrently mainParse haddockParse

return (fingerPrint, (mergeDiagnostics diags diagsHaddock, res))
-- if you have a Haddock warning and a real warning at the same exact location, throw away the Haddock one
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

do we need this special logic? I would think that a comment can only have Haddock warnings

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

We run the parser twice. If you have ( as your source file, it will be a parse error with both Haddock and without, so you'll get the same error twice. This dedupe ensures you only get the warning once.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

so the comment is a bit misleading, it's only non Haddock warnings that need deduping, right?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Comment updated. Is that clearer?

let realLocations = Set.fromList $ map (Diag._range . thd3) diags
let diagsHaddockUnique = filter (\x -> Diag._range (thd3 x) `Set.notMember` realLocations) diagsHaddock

return (fingerPrint, (diags ++ diagsHaddockUnique, res))


-- Haddock diagnostics should be warnings and say Haddock somewhere
fixHaddockWarning :: Diagnostic -> Diagnostic
fixHaddockWarning x = x{_severity = Just DsWarning, _message = fixMessage $ _message x}
where fixMessage x | "parse error " `T.isPrefixOf` x = "Haddock " <> x
| otherwise = "Haddock: " <> x


getParsedModuleDefinition :: HscEnv -> IdeOptions -> [PackageName] -> NormalizedFilePath -> Maybe T.Text -> IO (Maybe ByteString, ([FileDiagnostic], Maybe ParsedModule))
getParsedModuleDefinition packageState opt comp_pkgs file contents = do
Expand Down
21 changes: 0 additions & 21 deletions src/Development/IDE/GHC/Error.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,6 @@ module Development.IDE.GHC.Error
, diagFromStrings
, diagFromGhcException
, catchSrcErrors
, mergeDiagnostics

-- * utilities working with spans
, srcSpanToLocation
Expand Down Expand Up @@ -64,26 +63,6 @@ diagFromErrMsg diagSource dflags e =
diagFromErrMsgs :: T.Text -> DynFlags -> Bag ErrMsg -> [FileDiagnostic]
diagFromErrMsgs diagSource dflags = concatMap (diagFromErrMsg diagSource dflags) . bagToList

-- | Merges two sorted lists of diagnostics, removing duplicates.
-- Assumes all the diagnostics are for the same file.
mergeDiagnostics :: [FileDiagnostic] -> [FileDiagnostic] -> [FileDiagnostic]
mergeDiagnostics aa [] = aa
mergeDiagnostics [] bb = bb
mergeDiagnostics (a@(_,_,ad@Diagnostic{_range = ar}):aa) (b@(_,_,bd@Diagnostic{_range=br}):bb)
| ar < br
= a : mergeDiagnostics aa (b:bb)
| br < ar
= b : mergeDiagnostics (a:aa) bb
| _severity ad == _severity bd
&& _source ad == _source bd
&& _message ad == _message bd
&& _code ad == _code bd
&& _relatedInformation ad == _relatedInformation bd
&& _tags ad == _tags bd
= a : mergeDiagnostics aa bb
| otherwise
= a : b : mergeDiagnostics aa bb

-- | Convert a GHC SrcSpan to a DAML compiler Range
srcSpanToRange :: SrcSpan -> Range
srcSpanToRange (UnhelpfulSpan _) = noRange
Expand Down
2 changes: 1 addition & 1 deletion test/exe/Main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -433,7 +433,7 @@ diagnosticTests = testGroup "diagnostics"
_ <- createDoc "Foo.hs" "haskell" fooContent
expectDiagnostics
[ ( "Foo.hs"
, [(DsError, (2, 8), "Parse error on input")
, [(DsWarning, (2, 8), "Haddock parse error on input")
]
)
]
Expand Down