diff --git a/CHANGES.txt b/CHANGES.txt --- a/CHANGES.txt +++ b/CHANGES.txt @@ -1,6 +1,9 @@ Changelog for HLint (* = breaking change) +2.1.19, released 2019-05-14 +* Revert PVP breakage 2.1.18, released 2019-05-13 +* Change parseModuleEx/ParseError by accident #633, don't suggest changes inside RULES #631, suggest typeOf ==> typeRep Add matching on type variables diff --git a/hlint.cabal b/hlint.cabal --- a/hlint.cabal +++ b/hlint.cabal @@ -1,7 +1,7 @@ cabal-version: >= 1.18 build-type: Simple name: hlint -version: 2.1.18 +version: 2.1.19 license: BSD3 license-file: LICENSE category: Development diff --git a/src/Apply.hs b/src/Apply.hs --- a/src/Apply.hs +++ b/src/Apply.hs @@ -77,10 +77,10 @@ -- | Return either an idea (a parse error) or the module. In IO because might call the C pre processor. parseModuleApply :: ParseFlags -> [Setting] -> FilePath -> Maybe String -> IO (Either Idea (Module_, [Comment])) parseModuleApply flags s file src = do - res <- parseModuleEx (parseFlagsAddFixities [x | Infix x <- s] flags) file src + res <- parseModuleExInternal (parseFlagsAddFixities [x | Infix x <- s] flags) file src case res of Right (ParsedModuleResults (m, c) _) -> return $ Right (m,c) - Left (ParseError sl msg ctxt _) -> + Left (ParseError sl msg ctxt) -> return $ Left $ classify [x | SettingClassify x <- s] $ rawIdeaN Error "Parse error" (mkSrcSpan sl sl) ctxt Nothing [] diff --git a/src/Config/Compute.hs b/src/Config/Compute.hs --- a/src/Config/Compute.hs +++ b/src/Config/Compute.hs @@ -14,9 +14,9 @@ -- Returns the text of the hints (if you want to save it down) along with the settings to be used. computeSettings :: ParseFlags -> FilePath -> IO (String, [Setting]) computeSettings flags file = do - x <- parseModuleEx flags file Nothing + x <- parseModuleExInternal flags file Nothing case x of - Left (ParseError sl msg _ _) -> + Left (ParseError sl msg _) -> return ("# Parse error " ++ showSrcLoc sl ++ ": " ++ msg, []) Right (ParsedModuleResults (m, _) _) -> do let xs = concatMap (findSetting $ UnQual an) (moduleDecls m) diff --git a/src/Config/Haskell.hs b/src/Config/Haskell.hs --- a/src/Config/Haskell.hs +++ b/src/Config/Haskell.hs @@ -27,9 +27,9 @@ readFileConfigHaskell :: FilePath -> Maybe String -> IO [Setting] readFileConfigHaskell file contents = do let flags = addInfix defaultParseFlags - res <- parseModuleEx flags file contents + res <- parseModuleExInternal flags file contents case res of - Left (ParseError sl msg err _) -> + Left (ParseError sl msg err) -> error $ "Config parse failure at " ++ showSrcLoc sl ++ ": " ++ msg ++ "\n" ++ err Right (ParsedModuleResults (m, cs) _) -> return $ readSettings m ++ map SettingClassify (concatMap readComment cs) diff --git a/src/Grep.hs b/src/Grep.hs --- a/src/Grep.hs +++ b/src/Grep.hs @@ -22,9 +22,9 @@ let scope = scopeCreate $ Module an Nothing [] [] [] let rule = hintRules [HintRule Suggestion "grep" scope exp (Tuple an Boxed []) Nothing []] forM_ files $ \file -> do - res <- parseModuleEx flags file Nothing + res <- parseModuleExInternal flags file Nothing case res of - Left (ParseError sl msg ctxt _) -> + Left (ParseError sl msg ctxt) -> print $ rawIdeaN Error (if "Parse error" `isPrefixOf` msg then msg else "Parse error: " ++ msg) (mkSrcSpan sl sl) ctxt Nothing [] Right (ParsedModuleResults (m, c) _) -> forM_ (applyHints [] rule [(m, c)]) $ \i -> diff --git a/src/HSE/All.hs b/src/HSE/All.hs --- a/src/HSE/All.hs +++ b/src/HSE/All.hs @@ -7,6 +7,7 @@ CppFlags(..), ParseFlags(..), defaultParseFlags, parseFlagsAddFixities, parseFlagsSetLanguage, parseModuleEx, ParseError(..), ParsedModuleResults(..), + parseModuleExInternal, freeVars, vars, varss, pvars ) where @@ -33,6 +34,9 @@ import GHC.Util import qualified "ghc-lib-parser" Lexer import qualified "ghc-lib-parser" HsSyn +import qualified "ghc-lib-parser" FastString +import qualified "ghc-lib-parser" SrcLoc as GHC +import qualified "ghc-lib-parser" Outputable vars :: FreeVars a => a -> [String] freeVars :: FreeVars a => a -> Set String @@ -151,8 +155,10 @@ data ParseError = ParseError {parseErrorLocation :: SrcLoc -- ^ Location of the error. ,parseErrorMessage :: String -- ^ Message about the cause of the error. + -- Testing seems to indicate that this field doesn't participate + -- in user error messages [SF 2019-05-14]? + ,parseErrorContents :: String -- ^ Snippet of several lines (typically 5) including a @>@ character pointing at the faulty line. - ,parseErrorSDocs :: [SDoc] -- ^ Parse error messages as reported by ghc-lib. } -- | Combined 'hs-src-ext' and 'ghc-lib-parser' parse trees. @@ -174,25 +180,39 @@ -> String -> Maybe Lexer.PState -> IO (Either ParseError ParsedModuleResults) -failOpParseModuleEx ppstr flags file str sl msg maybePFailed = do +failOpParseModuleEx ppstr flags file str sl msg Nothing = do + -- Error handling when there is no GHC parse state provided. This + -- is the traditional approach to handling errors flags <- return $ parseFlagsNoLocations flags ppstr2 <- runCpp (cppFlags flags) file str let pe = case parseFileContentsWithMode (mkMode flags file) ppstr2 of ParseFailed sl2 _ -> context (srcLine sl2) ppstr2 _ -> context (srcLine sl) ppstr return $ Left $ ParseError sl msg pe - (case maybePFailed of - Just ps -> - pprErrMsgBagWithLoc $ snd $ getMessages ps dynFlags - Nothing -> [] - ) +failOpParseModuleEx ppstr _ file str _ _ (Just ps) = do + -- Error handling when a GHC parse state is available (assumed to + -- have come from a 'PFailed s'). We prefer to construct a + -- 'ParseError' value using that. + let s = Lexer.last_loc ps + sl = SrcLoc { srcFilename = FastString.unpackFS (GHC.srcSpanFile s) + , srcLine = GHC.srcSpanStartLine s + , srcColumn = GHC.srcSpanStartCol s } + pe = context (srcLine sl) ppstr + msg = head [Outputable.showSDoc dynFlags msg + | msg <- pprErrMsgBagWithLoc $ + snd (Lexer.getMessages ps dynFlags)] + return $ Left $ ParseError sl msg pe + -- | Parse a Haskell module. Applies the C pre processor, and uses best-guess fixity resolution if there are ambiguities. -- The filename @-@ is treated as @stdin@. Requires some flags (often 'defaultParseFlags'), the filename, and optionally the contents of that file. -- This version uses both hs-src-exts AND ghc-lib. It's considered to be an unrecoverable error if one -- parsing method succeeds whilst the other fails. -parseModuleEx :: ParseFlags -> FilePath -> Maybe String -> IO (Either ParseError ParsedModuleResults) -parseModuleEx flags file str = timedIO "Parse" file $ do +parseModuleEx :: ParseFlags -> FilePath -> Maybe String -> IO (Either ParseError (Module SrcSpanInfo, [Comment])) +parseModuleEx flags file str = fmap undefined <$> parseModuleExInternal flags file str + +parseModuleExInternal :: ParseFlags -> FilePath -> Maybe String -> IO (Either ParseError ParsedModuleResults) +parseModuleExInternal flags file str = timedIO "Parse" file $ do str <- case str of Just x -> return x Nothing | file == "-" -> getContentsUTF8 diff --git a/src/Language/Haskell/HLint3.hs b/src/Language/Haskell/HLint3.hs --- a/src/Language/Haskell/HLint3.hs +++ b/src/Language/Haskell/HLint3.hs @@ -120,5 +120,5 @@ _docs :: IO () _docs = do (flags, classify, hint) <- autoSettings - Right (ParsedModuleResults (m, c) _) <- parseModuleEx flags "MyFile.hs" Nothing + Right (m, c) <- parseModuleEx flags "MyFile.hs" Nothing print $ applyHints classify hint [(m, c)]