diff --git a/CHANGES.txt b/CHANGES.txt --- a/CHANGES.txt +++ b/CHANGES.txt @@ -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 diff --git a/data/hlint.1 b/data/hlint.1 --- a/data/hlint.1 +++ b/data/hlint.1 @@ -44,4 +44,3 @@ .SH AUTHOR This manual page was written by Joachim Breitner for the Debian system (but may be used by others). - diff --git a/data/hlint.yaml b/data/hlint.yaml --- a/data/hlint.yaml +++ b/data/hlint.yaml @@ -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} + # # 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 \ diff --git a/data/report_template.html b/data/report_template.html --- a/data/report_template.html +++ b/data/report_template.html @@ -1,4 +1,4 @@ - + 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.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 diff --git a/src/Config/Yaml.hs b/src/Config/Yaml.hs --- a/src/Config/Yaml.hs +++ b/src/Config/Yaml.hs @@ -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 diff --git a/src/GHC/Util.hs b/src/GHC/Util.hs --- a/src/GHC/Util.hs +++ b/src/GHC/Util.hs @@ -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 diff --git a/src/HSE/All.hs b/src/HSE/All.hs --- a/src/HSE/All.hs +++ b/src/HSE/All.hs @@ -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 diff --git a/src/Hint/Bracket.hs b/src/Hint/Bracket.hs --- a/src/Hint/Bracket.hs +++ b/src/Hint/Bracket.hs @@ -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 diff --git a/src/Hint/Extensions.hs b/src/Hint/Extensions.hs --- a/src/Hint/Extensions.hs +++ b/src/Hint/Extensions.hs @@ -6,10 +6,10 @@ {-# 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 diff --git a/src/Hint/Pragma.hs b/src/Hint/Pragma.hs --- a/src/Hint/Pragma.hs +++ b/src/Hint/Pragma.hs @@ -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 #-} -} diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -12,4 +12,3 @@ errs <- hlint args unless (null errs) $ exitWith $ ExitFailure 1 -