hlint 2.1.22 → 2.1.23
raw patch · 12 files changed
+290/−73 lines, 12 filesdep ~ghc-lib-parserPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: ghc-lib-parser
API changes (from Hackage documentation)
Files
- CHANGES.txt +9/−0
- data/hlint.1 +0/−1
- data/hlint.yaml +32/−2
- data/report_template.html +1/−1
- hlint.cabal +2/−2
- src/Config/Yaml.hs +1/−1
- src/GHC/Util.hs +141/−10
- src/HSE/All.hs +83/−45
- src/Hint/Bracket.hs +11/−1
- src/Hint/Extensions.hs +4/−3
- src/Hint/Pragma.hs +6/−6
- src/Main.hs +0/−1
CHANGES.txt view
@@ -1,5 +1,14 @@ Changelog for HLint (* = breaking change) +2.1.23, released 2019-06-09+ Make it an error if your code does not parse with GHC+ #662, don't warn on ($x), since it might not really be TH+ #660, suggest tuple sections for \y -> (x,y) and similar+ #667, warn on return x >> m and similar+ #653, add symmetric versions of some == hints+ #650, add a group of teaching hints+ #651, warn on unused NamedFieldPuns+ #646, switch to an HTML doctype 2.1.22, released 2019-05-25 #634, suggest modifyIORef ==> writeIORef when applicable #642, suggest null in more places
data/hlint.1 view
@@ -44,4 +44,3 @@ .SH AUTHOR This manual page was written by Joachim Breitner <nomeata@debian.org> for the Debian system (but may be used by others).-
data/hlint.yaml view
@@ -155,10 +155,15 @@ - warn: {lhs: "zipWith (,)", rhs: zip} - warn: {lhs: "zipWith3 (,,)", rhs: zip3} - hint: {lhs: length x == 0, rhs: null x, note: IncreasesLaziness}+ - hint: {lhs: 0 == length x, rhs: null x, note: IncreasesLaziness} - hint: {lhs: length x < 1, rhs: null x, note: IncreasesLaziness}+ - hint: {lhs: 1 > length x, rhs: null x, note: IncreasesLaziness} - hint: {lhs: length x <= 0, rhs: null x, note: IncreasesLaziness}+ - hint: {lhs: 0 >= length x, rhs: null x, note: IncreasesLaziness} - hint: {lhs: "x == []", rhs: null x}+ - hint: {lhs: "[] == x", rhs: null x} - hint: {lhs: length x /= 0, rhs: not (null x), note: IncreasesLaziness, name: Use null}+ - hint: {lhs: 0 /= length x, rhs: not (null x), note: IncreasesLaziness, name: Use null} - hint: {lhs: "\\x -> [x]", rhs: "(:[])", name: "Use :"} - warn: {lhs: map (uncurry f) (zip x y), rhs: zipWith f x y} - hint: {lhs: map f (zip x y), rhs: zipWith (curry f) x y, side: isVar f}@@ -191,8 +196,11 @@ - hint: {lhs: "elem x [y]", rhs: x == y, note: ValidInstance Eq a} - hint: {lhs: "notElem x [y]", rhs: x /= y, note: ValidInstance Eq a} - hint: {lhs: length x >= 0, rhs: "True", name: Length always non-negative}+ - hint: {lhs: 0 <= length x, rhs: "True", name: Length always non-negative} - hint: {lhs: length x > 0, rhs: not (null x), note: IncreasesLaziness, name: Use null}+ - hint: {lhs: 0 < length x, rhs: not (null x), note: IncreasesLaziness, name: Use null} - hint: {lhs: length x >= 1, rhs: not (null x), note: IncreasesLaziness, name: Use null}+ - hint: {lhs: 1 <= length x, rhs: not (null x), note: IncreasesLaziness, name: Use null} - warn: {lhs: take i x, rhs: "[]", side: isNegZero i, name: Take on a non-positive} - warn: {lhs: drop i x, rhs: x, side: isNegZero i, name: Drop on a non-positive} - warn: {lhs: last (scanl f z x), rhs: foldl f z x}@@ -266,6 +274,8 @@ - warn: {lhs: x . id, rhs: x, name: Redundant id} - warn: {lhs: "((,) x)", rhs: "(_noParen_ x,)", name: Use tuple-section, note: RequiresExtension TupleSections} - warn: {lhs: "flip (,) x", rhs: "(,_noParen_ x)", name: Use tuple-section, note: RequiresExtension TupleSections}+ - warn: {lhs: "\\y -> (x,y)", rhs: "(x,)", name: Use tuple-section, note: RequiresExtension TupleSections}+ - warn: {lhs: "\\y -> (y,x)", rhs: "(,x)", name: Use tuple-section, note: RequiresExtension TupleSections} # CHAR @@ -344,6 +354,8 @@ - hint: {lhs: return x <*> y, rhs: x <$> y} - hint: {lhs: pure x <*> y, rhs: x <$> y}+ - warn: {lhs: x <* pure y, rhs: x}+ - warn: {lhs: pure x *> y, rhs: "y"} # MONAD @@ -389,6 +401,10 @@ - warn: {lhs: mapM_ (void . f), rhs: mapM_ f} - warn: {lhs: forM_ x (void . f), rhs: forM_ x f} - warn: {lhs: a >>= \_ -> b, rhs: a >> b}+ - warn: {lhs: m <* return x, rhs: m}+ - warn: {lhs: return x *> m, rhs: m}+ - warn: {lhs: pure x >> m, rhs: m}+ - warn: {lhs: return x >> m, rhs: m} # STATE MONAD @@ -509,7 +525,9 @@ - hint: {lhs: log y / log x, rhs: logBase x y} - hint: {lhs: sin x / cos x, rhs: tan x} - hint: {lhs: rem n 2 == 0, rhs: even n}+ - hint: {lhs: 0 == rem n 2, rhs: even n} - hint: {lhs: rem n 2 /= 0, rhs: odd n}+ - hint: {lhs: 0 /= rem n 2, rhs: odd n} - hint: {lhs: not (even x), rhs: odd x} - hint: {lhs: not (odd x), rhs: even x} - hint: {lhs: x ** 0.5, rhs: sqrt x}@@ -723,6 +741,9 @@ - warn: {lhs: Data.Maybe.fromMaybe mempty, rhs: Data.Foldable.fold} - warn: {lhs: Data.Either.fromRight mempty, rhs: Data.Foldable.fold} - warn: {lhs: if f x then Just x else Nothing, rhs: mfilter f (Just x)}+ - hint: {lhs: maybe (pure ()), rhs: traverse_, note: IncreasesLaziness}+ - hint: {lhs: fromMaybe (pure ()), rhs: sequenceA_, note: IncreasesLaziness}+ - hint: {lhs: fromRight (pure ()), rhs: sequenceA_, note: IncreasesLaziness} - group: name: dollar@@ -732,7 +753,16 @@ rules: - warn: {lhs: a $ b $ c, rhs: a . b $ c} +- group:+ name: teaching+ enabled: false+ imports:+ - package base+ rules:+ - hint: {lhs: "x /= []", rhs: not (null x), name: Use null}+ - hint: {lhs: "[] /= x", rhs: not (null x), name: Use null} + # <TEST> # yes = concat . map f -- concatMap f # yes = foo . bar . concat . map f . baz . bar -- concatMap f . baz . bar@@ -839,7 +869,7 @@ # main = take 4 x # main = let (first, rest) = (takeWhile p l, dropWhile p l) in rest -- span p l # main = map $ \ d -> ([| $d |], [| $d |])-# pairs (x:xs) = map (\y -> (x,y)) xs ++ pairs xs+# pairs (x:xs) = map (x,) xs ++ pairs xs # {-# ANN foo "HLint: ignore" #-};foo = map f (map g x) -- @Ignore ??? # {-# HLINT ignore foo #-};foo = map f (map g x) -- @Ignore ??? # yes = fmap lines $ abc 123 -- lines Control.Applicative.<$> abc 123@@ -883,7 +913,7 @@ # no = sequence (return x) # no = sequenceA (pure a) # {-# LANGUAGE QuasiQuotes #-}; no = f (\url -> [hamlet|foo @{url}|])-#+ # import Prelude \ # yes = flip mapM -- Control.Monad.forM # import Control.Monad \
data/report_template.html view
@@ -1,4 +1,4 @@-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">+<!DOCTYPE HTML> <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en"> <head> <meta http-equiv="Content-Type" content="application/xhtml+xml; charset=UTF-8" />
hlint.cabal view
@@ -1,7 +1,7 @@ cabal-version: >= 1.18 build-type: Simple name: hlint-version: 2.1.22+version: 2.1.23 license: BSD3 license-file: LICENSE category: Development@@ -60,7 +60,7 @@ extra >= 1.6.6, refact >= 0.3, aeson >= 1.1.2.0,- ghc-lib-parser >= 0.20190523+ ghc-lib-parser == 8.8.0.20190424 if flag(gpl) build-depends: hscolour >= 1.21
src/Config/Yaml.hs view
@@ -194,7 +194,7 @@ where require :: Val -> String -> Maybe a -> Parser a require _ _ (Just a) = return a- require val err Nothing = parseFail val err + require val err Nothing = parseFail val err parseGroup :: Val -> Parser Group parseGroup v = do
src/GHC/Util.hs view
@@ -1,17 +1,24 @@ {-# LANGUAGE PackageImports #-}+{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-missing-fields #-} module GHC.Util (- dynFlags+ baseDynFlags+ , parsePragmasIntoDynFlags , parseFileGhcLib , ParseResult (..) , pprErrMsgBagWithLoc , getMessages , SDoc , Located+ -- Temporary : Export these so GHC doesn't consider them unused and+ -- tell weeder to ignore them.+ , isAtom, addParen, paren, isApp, isOpApp, isAnyApp, isDot, isSection, isDotApp ) where import "ghc-lib-parser" HsSyn+import "ghc-lib-parser" BasicTypes+import "ghc-lib-parser" RdrName import "ghc-lib-parser" DynFlags import "ghc-lib-parser" Platform import "ghc-lib-parser" Fingerprint@@ -24,19 +31,21 @@ import "ghc-lib-parser" ErrUtils import "ghc-lib-parser" Outputable import "ghc-lib-parser" GHC.LanguageExtensions.Type+import "ghc-lib-parser" Panic+import "ghc-lib-parser" HscTypes+import "ghc-lib-parser" HeaderInfo import Data.List import System.FilePath import Language.Preprocessor.Unlit - fakeSettings :: Settings fakeSettings = Settings { sTargetPlatform=platform , sPlatformConstants=platformConstants- , sProjectVersion=Config.cProjectVersion+ , sProjectVersion=cProjectVersion , sProgramName="ghc"- , sOpt_P_fingerprint=Fingerprint.fingerprint0+ , sOpt_P_fingerprint=fingerprint0 } where platform =@@ -49,18 +58,140 @@ fakeLlvmConfig :: (LlvmTargets, LlvmPasses) fakeLlvmConfig = ([], []) +badExtensions :: [Extension]+badExtensions =+ [+ AlternativeLayoutRule+ , AlternativeLayoutRuleTransitional+ , Arrows+ , TransformListComp+ , UnboxedTuples+ , UnboxedSums+ , QuasiQuotes+ , RecursiveDo+ ]+ enabledExtensions :: [Extension]-enabledExtensions = [Cpp .. StarIsType] -- First and last extension in ghc-boot-th/GHC/LanguageExtensions/Type.hs 'data Extension'.+enabledExtensions = [x | x <- [Cpp .. StarIsType], x `notElem` badExtensions]+-- 'Cpp' are the first and last cases of type 'Extension' in+-- 'libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs'. When we are+-- on a version of GHC that has MR+-- https://gitlab.haskell.org/ghc/ghc/merge_requests/826, we can+-- replace them with 'minBound' and 'maxBound' respectively. -dynFlags :: DynFlags-dynFlags = foldl' xopt_set+baseDynFlags :: DynFlags+baseDynFlags = foldl' xopt_set (defaultDynFlags fakeSettings fakeLlvmConfig) enabledExtensions -parseFileGhcLib :: FilePath -> String -> ParseResult (Located (HsModule GhcPs))-parseFileGhcLib filename str =+parsePragmasIntoDynFlags ::+ DynFlags -> FilePath -> String -> IO (Either String DynFlags)+parsePragmasIntoDynFlags flags filepath str =+ catchErrors $ do+ let opts = getOptions flags (stringToStringBuffer str) filepath+ (flags, _, _) <- parseDynamicFilePragma flags opts+ return $ Right flags+ where+ catchErrors :: IO (Either String DynFlags) -> IO (Either String DynFlags)+ catchErrors act = handleGhcException reportErr+ (handleSourceError reportErr act)+ reportErr e = return $ Left (show e)++parseFileGhcLib ::+ FilePath -> String -> DynFlags -> ParseResult (Located (HsModule GhcPs))+parseFileGhcLib filename str flags = Lexer.unP Parser.parseModule parseState where location = mkRealSrcLoc (mkFastString filename) 1 1 buffer = stringToStringBuffer $ if takeExtension filename /= ".lhs" then str else unlit filename str- parseState = mkPState dynFlags buffer location+ parseState = mkPState flags buffer location++---------------------------------------------------------------------+-- The following functions are from+-- https://github.com/pepeiborra/haskell-src-exts-util ("Utility code+-- for working with haskell-src-exts") rewritten for GHC parse trees+-- (of which at least one of them came from this project originally).++-- | 'isAtom e' if 'e' requires no bracketing ever.+isAtom :: (p ~ GhcPass pass) => HsExpr p -> Bool+isAtom x = case x of+ HsVar {} -> True+ HsUnboundVar {} -> True+ HsRecFld {} -> True+ HsOverLabel {} -> True+ HsIPVar {} -> True+ HsPar {} -> True+ SectionL {} -> True+ SectionR {} -> True+ ExplicitTuple {} -> True+ ExplicitSum {} -> True+ ExplicitList {} -> True+ RecordCon {} -> True+ RecordUpd {} -> True+ ArithSeq {} -> True+ HsBracket {} -> True+ HsRnBracketOut {} -> True+ HsTcBracketOut {} -> True+ HsSpliceE {} -> True+ HsLit _ x | not $ isNegativeLit x -> True+ HsOverLit _ x | not $ isNegativeOverLit x -> True+ _ -> False+ where+ isNegativeLit (HsInt _ i) = il_neg i+ isNegativeLit (HsRat _ f _) = fl_neg f+ isNegativeLit (HsFloatPrim _ f) = fl_neg f+ isNegativeLit (HsDoublePrim _ f) = fl_neg f+ isNegativeLit (HsIntPrim _ x) = x < 0+ isNegativeLit (HsInt64Prim _ x) = x < 0+ isNegativeLit (HsInteger _ x _) = x < 0+ isNegativeLit _ = False++ isNegativeOverLit OverLit {ol_val=HsIntegral i} = il_neg i+ isNegativeOverLit OverLit {ol_val=HsFractional f} = fl_neg f+ isNegativeOverLit _ = False++-- | 'addParen e' wraps 'e' in parens.+addParen :: (p ~ GhcPass pass) => HsExpr p -> HsExpr p+addParen e = HsPar noExt (noLoc e)++-- | 'paren e' wraps 'e' in parens if 'e' is non-atomic.+paren :: (p ~ GhcPass pass) => HsExpr GhcPs -> HsExpr GhcPs+paren x+ | isAtom x = x+ | otherwise = addParen x++-- | 'isApp e' if 'e' is a (regular) application.+isApp :: (p ~ GhcPass pass) => HsExpr p -> Bool+isApp x = case x of+ HsApp {} -> True+ _ -> False++-- | 'isOpApp e' if 'e' is an operator application.+isOpApp :: (p ~ GhcPass pass) => HsExpr p -> Bool+isOpApp x = case x of+ OpApp {} -> True+ _ -> False++-- | 'isAnyApp e' if 'e' is either an application or operator+-- application.+isAnyApp :: (p ~ GhcPass pass) => HsExpr p -> Bool+isAnyApp x = isApp x || isOpApp x++-- | 'isDot e' if 'e' is the unqualifed variable '.'.+isDot :: HsExpr GhcPs -> Bool+isDot x+ | HsVar _ (L _ ident) <- x+ , ident == mkVarUnqual (fsLit ".") = True+ | otherwise = False++-- | 'isSection e' if 'e' is a section.+isSection :: (p ~ GhcPass pass) => HsExpr p -> Bool+isSection x = case x of+ SectionL {} -> True+ SectionR {} -> True+ _ -> False++-- | 'isDotApp e' if 'e' is dot application.+isDotApp :: HsExpr GhcPs -> Bool+isDotApp (OpApp _ _ (L _ op) _) = isDot op+isDotApp _ = False
src/HSE/All.hs view
@@ -32,10 +32,10 @@ import Prelude 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" ErrUtils import qualified "ghc-lib-parser" Outputable vars :: FreeVars a => a -> [String]@@ -153,36 +153,52 @@ -- | A parse error. 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.+ { parseErrorLocation :: SrcLoc -- ^ Location of the error.+ , parseErrorMessage :: String -- ^ Message about the cause of the error.+ , parseErrorContents :: String -- ^ Snippet of several lines (typically 5) including a @>@ character pointing at the faulty line. } -- | Combined 'hs-src-ext' and 'ghc-lib-parser' parse trees. data ParsedModuleResults = ParsedModuleResults {- pm_hsext :: (Module SrcSpanInfo, [Comment]) -- hs-src-ext result.- , pm_ghclib :: Maybe (Located (HsSyn.HsModule HsSyn.GhcPs)) -- ghc-lib-parser result.+ pm_hsext :: (Module SrcSpanInfo, [Comment]) -- hs-src-ext result+ , pm_ghclib :: Located (HsSyn.HsModule HsSyn.GhcPs) -- ghc-lib-parser result } --- | Utility called from 'parseModuleEx' and 'failOpModuleEx'.+-- | Utility called from 'parseModuleEx' and 'hseFailOpParseModuleEx'. mkMode :: ParseFlags -> String -> ParseMode mkMode flags file = (hseFlags flags){parseFilename = file,fixities = Nothing } --- | Error handler called on HSE parse failure.+-- | Error handler dispatcher. Invoked when HSE parsing has failed. failOpParseModuleEx :: String- -> ParseFlags- -> FilePath- -> String- -> SrcLoc- -> String- -> Maybe Lexer.PState- -> IO (Either ParseError ParsedModuleResults)-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+ -> ParseFlags+ -> FilePath+ -> String+ -> SrcLoc+ -> String+ -> Maybe (GHC.SrcSpan, ErrUtils.MsgDoc)+ -> IO (Either ParseError ParsedModuleResults)+failOpParseModuleEx ppstr flags file str sl msg ghc =+ case ghc of+ Just err ->+ -- GHC error info is available (assumed to have come from a+ -- 'PFailed'). We prefer to construct a 'ParseError' value+ -- using that.+ ghcFailOpParseModuleEx ppstr file str err+ Nothing ->+ -- No GHC error info provided. This is the traditional approach+ -- to handling errors.+ hseFailOpParseModuleEx ppstr flags file str sl msg++-- | An error handler of last resort. This is invoked when HSE parsing+-- has failed but apparently GHC has not!+hseFailOpParseModuleEx :: String+ -> ParseFlags+ -> FilePath+ -> String+ -> SrcLoc+ -> String+ -> IO (Either ParseError ParsedModuleResults)+hseFailOpParseModuleEx ppstr flags file str sl msg = do flags <- return $ parseFlagsNoLocations flags ppstr2 <- runCpp (cppFlags flags) file str let pe = case parseFileContentsWithMode (mkMode flags file) ppstr2 of@@ -190,24 +206,33 @@ _ -> context (srcLine sl) ppstr return $ Left $ ParseError sl msg pe -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 }+-- | The error handler invoked when GHC parsing has failed.+ghcFailOpParseModuleEx :: String+ -> FilePath+ -> String+ -> (GHC.SrcSpan, ErrUtils.MsgDoc)+ -> IO (Either ParseError ParsedModuleResults)+ghcFailOpParseModuleEx ppstr file str (loc, err) = do+ let sl =+ case loc of+ GHC.RealSrcSpan r ->+ SrcLoc { srcFilename = FastString.unpackFS (GHC.srcSpanFile r)+ , srcLine = GHC.srcSpanStartLine r+ , srcColumn = GHC.srcSpanStartCol r }+ GHC.UnhelpfulSpan _ ->+ SrcLoc { srcFilename = file+ , srcLine = 1 :: Int+ , srcColumn = 1 :: Int } pe = context (srcLine sl) ppstr- msg = head [Outputable.showSDoc dynFlags msg- | msg <- pprErrMsgBagWithLoc $- snd (Lexer.getMessages ps dynFlags)]+ msg = Outputable.showSDoc baseDynFlags $+ ErrUtils.pprLocErrMsg (ErrUtils.mkPlainErrMsg baseDynFlags loc err) 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.+-- | 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. parseModuleEx :: ParseFlags -> FilePath -> Maybe String -> IO (Either ParseError (Module SrcSpanInfo, [Comment])) parseModuleEx flags file str = fmap pm_hsext <$> parseModuleExInternal flags file str @@ -219,17 +244,30 @@ | otherwise -> readFileUTF8' file str <- return $ fromMaybe str $ stripPrefix "\65279" str -- remove the BOM if it exists, see #130 ppstr <- runCpp (cppFlags flags) file str- case (parseFileContentsWithComments (mkMode flags file) ppstr, parseFileGhcLib file ppstr) of- (ParseOk (x, cs), ghc) ->- return $ Right (ParsedModuleResults (applyFixity fixity x, cs) $ fromPOk ghc)- (ParseFailed sl msg, pfailed) ->- failOpParseModuleEx ppstr flags file str sl msg $ fromPFailed pfailed+ dynFlags <- parsePragmasIntoDynFlags baseDynFlags file ppstr+ case dynFlags of+ Right ghcFlags ->+ case (parseFileContentsWithComments (mkMode flags file) ppstr, parseFileGhcLib file ppstr ghcFlags) of+ (ParseOk (x, cs), POk _ a) ->+ return $ Right (ParsedModuleResults (applyFixity fixity x, cs) a)+ -- Parse error if GHC parsing fails (see+ -- https://github.com/ndmitchell/hlint/issues/645).+ (ParseOk _, PFailed _ loc err) ->+ ghcFailOpParseModuleEx ppstr file str (loc, err)+ (ParseFailed sl msg, pfailed) ->+ failOpParseModuleEx ppstr flags file str sl msg $ fromPFailed pfailed+ Left msg -> do+ -- Parsing GHC flags from dynamic pragmas in the source+ -- has failed. When this happens, it's reported by+ -- exception. It's impossible or at least fiddly getting a+ -- location so we skip that for now. Synthesize a parse+ -- error.+ let loc = SrcLoc file (1 :: Int) (1 :: Int)+ return $ Left (ParseError loc msg (context (srcLine loc) ppstr))+ where- fromPFailed (PFailed x) = Just x+ fromPFailed (PFailed _ loc err) = Just (loc, err) fromPFailed _ = Nothing-- fromPOk (POk _ x) = Just x- fromPOk _ = Nothing fixity = fromMaybe [] $ fixities $ hseFlags flags
src/Hint/Bracket.hs view
@@ -22,6 +22,15 @@ yes = (`foo` (bar baz)) -- @Suggestion (`foo` bar baz) yes = f ((x)) -- @Warning x main = do f; (print x) -- @Suggestion do f print x+yes = f (x) y -- @Warning x+no = f (+x) y+no = f ($x) y+no = ($x)+yes = (($x))+no = ($1)+yes = (($1)) -- @Warning ($1)+no = (+5)+yes = ((+5)) -- @Warning (+5) -- type bracket reduction foo :: (Int -> Int) -> Int@@ -95,6 +104,7 @@ x -> x isPartialAtom :: Exp_ -> Bool+isPartialAtom (SpliceExp _ IdSplice{}) = True -- might be $x, which was really $ x, but TH enabled misparsed it isPartialAtom x = isRecConstr x || isRecUpdate x -- Dirty, should add to Brackets type class I think@@ -122,7 +132,7 @@ -- f (Maybe (index, parent, gen)) child f :: (Data (a S), ExactP a, Pretty (a S), Brackets (a S)) => Maybe (Int,a S,a S -> a S) -> a S -> [Idea] f Just{} o@(remParens -> Just x) | isAtom x, not $ isPartialAtom x = bracketError msg o x : g x- f Nothing o@(remParens -> Just x) | root || isAtom x = (if isAtom x then bracketError else bracketWarning) msg o x : g x+ f Nothing o@(remParens -> Just x) | root || isAtom x, not $ isPartialAtom x = (if isAtom x then bracketError else bracketWarning) msg o x : g x f (Just (i,o,gen)) v@(remParens -> Just x) | not $ needBracket i o x, not $ isPartialAtom x = suggest msg o (gen x) [r] : g x where
src/Hint/Extensions.hs view
@@ -6,10 +6,10 @@ <TEST> {-# LANGUAGE Arrows #-} \ f = id ---{-# LANGUAGE TotallyUnknown #-} \+{-# LANGUAGE RebindableSyntax #-} \ f = id-{-# LANGUAGE Foo, ParallelListComp, ImplicitParams #-} \-f = [(a,c) | a <- b | c <- d] -- {-# LANGUAGE Foo, ParallelListComp #-}+{-# LANGUAGE RebindableSyntax, ParallelListComp, ImplicitParams #-} \+f = [(a,c) | a <- b | c <- d] -- {-# LANGUAGE RebindableSyntax, ParallelListComp #-} {-# LANGUAGE EmptyDataDecls #-} \ data Foo {-# LANGUAGE TemplateHaskell #-} \@@ -251,6 +251,7 @@ used PatternSignatures = hasS isPatTypeSig used RecordWildCards = hasS isPFieldWildcard ||^ hasS isFieldWildcard used RecordPuns = hasS isPFieldPun ||^ hasS isFieldPun+used NamedFieldPuns = hasS isPFieldPun ||^ hasS isFieldPun used UnboxedTuples = has (not . isBoxed) used PackageImports = hasS (isJust . importPkg) used QuasiQuotes = hasS isQuasiQuote ||^ hasS isTyQuasiQuote
src/Hint/Pragma.hs view
@@ -13,15 +13,15 @@ {-# OPTIONS_YHC -cpp #-} {-# OPTIONS_GHC -XFoo #-} -- {-# LANGUAGE Foo #-} {-# OPTIONS_GHC -fglasgow-exts #-} -- ???-{-# LANGUAGE A, B, C, A #-} -- {-# LANGUAGE A, B, C #-}-{-# LANGUAGE A #-}+{-# LANGUAGE RebindableSyntax, EmptyCase, DuplicateRecordFields, RebindableSyntax #-} -- {-# LANGUAGE RebindableSyntax, EmptyCase, DuplicateRecordFields #-}+{-# LANGUAGE RebindableSyntax #-} {-# OPTIONS_GHC -cpp -foo #-} -- {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -foo #-} {-# OPTIONS_GHC -cpp #-} \ {-# LANGUAGE CPP, Text #-} ---{-# LANGUAGE A #-} \-{-# LANGUAGE B #-}-{-# LANGUAGE A #-} \-{-# LANGUAGE B, A #-} -- {-# LANGUAGE A, B #-}+{-# LANGUAGE RebindableSyntax #-} \+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE RebindableSyntax #-} \+{-# LANGUAGE EmptyCase, RebindableSyntax #-} -- {-# LANGUAGE RebindableSyntax, EmptyCase #-} </TEST> -}
src/Main.hs view
@@ -12,4 +12,3 @@ errs <- hlint args unless (null errs) $ exitWith $ ExitFailure 1-