hlint 2.1 → 2.1.1

raw patch · 17 files changed

+108/−20 lines, 17 filesdep ~data-defaultdep ~yamlPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: data-default, yaml

API changes (from Hackage documentation)

Files

• CHANGES.txt +10/−0
• data/hlint.yaml +29/−0
• hlint.cabal +6/−4
• src/Apply.hs +9/−1
• src/CmdLine.hs +2/−0
• src/Config/Haskell.hs +1/−0
• src/Config/Type.hs +2/−0
• src/Config/Yaml.hs +1/−0
• src/HLint.hs +12/−1
• src/HSE/All.hs +11/−2
• src/HSE/Util.hs +7/−0
• src/Hint/Export.hs +1/−1
• src/Hint/Extensions.hs +5/−2
• src/Hint/Lambda.hs +1/−1
• src/Hint/ListRec.hs +2/−1
• src/Hint/Monad.hs +4/−3
• src/Test/Annotations.hs +5/−4

@@ -1,5 +1,15 @@ Changelog for HLint (* = breaking change) +2.1.1, released 2018-03-24+    #457, suggest turning on LambdaCase if necessary+    #457, add RequiresExtension note+    #454, add fixities for the HSpec `should*` functions+    #455, add some more sequence hints+    #453, allow pure in a few Monad hints as well as return+    #451, add --with-group command line option+    #424, suggest Foldable.forM_ in a few more places+    #445, add suggestions for reader/state monad+    #443, suggest join (x <$> y) ==> x =<< y 2.1, released 2018-02-07 *   #433, make ideas span multiple modules/declarations     #433, allow ignoring statement-level duplication hint

@@ -338,6 +338,10 @@     - warn: {lhs: when (not x), rhs: unless x}     - warn: {lhs: x >>= id, rhs: Control.Monad.join x}     - warn: {lhs: id =<< x, rhs: Control.Monad.join x}+    - warn: {lhs: id =<< x, rhs: Control.Monad.join x}+    - warn: {lhs: id =<< x, rhs: Control.Monad.join x}+    - hint: {lhs: join (f <$> x), rhs: f =<< x}+    - hint: {lhs: join (fmap f x), rhs: f =<< x}     - hint: {lhs: a >> return (), rhs: Control.Monad.void a, side: isAtom a || isApp a}     - warn: {lhs: fmap (const ()), rhs: Control.Monad.void}     - warn: {lhs: const () <$> x, rhs: Control.Monad.void x}@@ -375,6 +379,7 @@     - warn: {lhs: mapM_ f (map g x), rhs: mapM_ (f . g) x}     - warn: {lhs: mapM id, rhs: sequence}     - warn: {lhs: mapM_ id, rhs: sequence_}+    - warn: {lhs: sequence (return a), rhs: return <$> a}      # APPLICATIVE / TRAVERSABLE @@ -388,6 +393,7 @@     - warn: {lhs: Just <$> a <|> pure Nothing, rhs: optional a}     - hint: {lhs: m >>= pure . f, rhs: f <$> m}     - hint: {lhs: pure . f =<< m, rhs: f <$> m}+    - warn: {lhs: sequenceA (pure a), rhs: pure <$> a}       # LIST COMP@@ -513,8 +519,18 @@     # FOLDABLE      - warn: {lhs: case m of Nothing -> return (); Just x -> f x, rhs: Data.Foldable.forM_ m f}+    - warn: {lhs: case m of Just x -> f x; Nothing -> return (), rhs: Data.Foldable.forM_ m f}+    - warn: {lhs: case m of Just x -> f x; _ -> return (), rhs: Data.Foldable.forM_ m f}     - warn: {lhs: when (isJust m) (f (fromJust m)), rhs: Data.Foldable.forM_ m f} +    # STATE MONAD+    - warn: {lhs: f <$> Control.Monad.State.get, rhs: gets f}+    - warn: {lhs: fmap f  Control.Monad.State.get, rhs: gets f}+    - warn: {lhs: f <$> Control.Monad.Reader.ask, rhs: asks f}+    - warn: {lhs: fmap f Control.Monad.Reader.ask, rhs: asks f}+    - warn: {lhs: fst (runState m s), rhs: evalState m s}+    - warn: {lhs: snd (runState m s), rhs: execState m s}+     # EVALUATE      - warn: {lhs: True && x, rhs: x, name: Evaluate}@@ -624,8 +640,20 @@     rules:     - warn: {lhs: map, rhs: fmap}     - warn: {lhs: a ++ b, rhs: a <> b}+    - warn: {lhs: "sequence [a]", rhs: "pure <$> a"}  - group:+    name: generalise-for-conciseness+    enabled: false+    imports:+    - package base+    rules:+    - warn: {lhs: maybe mempty, rhs: foldMap}+    - warn: {lhs: either (const mempty), rhs: foldMap}+    - warn: {lhs: Data.Maybe.fromMaybe mempty, rhs: Data.Foldable.fold}+    - warn: {lhs: Data.Either.fromRight mempty, rhs: Data.Foldable.fold}++- group:     name: dollar     enabled: false     imports:@@ -803,4 +831,5 @@ # main = P.length xs == 0 -- P.null xs # main = hello .~ Just 12 -- hello ?~ 12 # foo = liftIO $ window `on` deleteEvent $ do a; b+# no = sort <$> f input `shouldBe` sort <$> x # </TEST>

@@ -1,7 +1,7 @@ cabal-version:      >= 1.18 build-type:         Simple name:               hlint-version:            2.1+version:            2.1.1 license:            BSD3 license-file:       LICENSE category:           Development@@ -27,7 +27,7 @@ extra-doc-files:     README.md     CHANGES.txt-tested-with:        GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2+tested-with:        GHC==8.4.1, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2  source-repository head     type:     git@@ -47,10 +47,12 @@     default-language:   Haskell2010     build-depends:         base == 4.*, process, filepath, directory, containers,-        unordered-containers, yaml, vector, text, bytestring,-        transformers, data-default,+        unordered-containers, vector, text, bytestring,+        transformers,+        data-default >= 0.3,         cpphs >= 1.20.1,         cmdargs >= 0.10,+        yaml >= 0.5.0,         haskell-src-exts >= 1.20 && < 1.21,         haskell-src-exts-util >= 0.2.1.2,         uniplate >= 1.5,

@@ -13,6 +13,7 @@ import Data.Ord import Config.Type import Config.Haskell+import qualified Data.HashSet as Set import Prelude  @@ -44,7 +45,7 @@  applyHintsReal :: [Setting] -> Hint -> [(Module_, [Comment])] -> [Idea] applyHintsReal settings hints_ ms = concat $-    [ map (classify $ cls ++ mapMaybe readPragma (universeBi m)) $+    [ map (classify (cls ++ mapMaybe readPragma (universeBi m)) . removeRequiresExtensionNotes m) $         order [] (hintModule hints settings nm m) `merge`         concat [order [fromNamed d] $ decHints d | d <- moduleDecls m] `merge`         concat [order [] $ hintComment hints settings c | c <- cs]@@ -60,6 +61,13 @@         hints = (if length ms <= 1 then noModules else id) hints_         noModules h = h{hintModules = \_ _ -> []} `mappend` mempty{hintModule = \s a b -> hintModules h s [(a,b)]} +-- If the hint has said you RequiresExtension Foo, but Foo is enabled, drop the note+removeRequiresExtensionNotes :: Module_ -> Idea -> Idea+removeRequiresExtensionNotes m = \x -> x{ideaNote = filter keep $ ideaNote x}+    where+        exts = Set.fromList $ map fromNamed $ moduleExtensions m+        keep (RequiresExtension x) = not $ x `Set.member` exts+        keep _ = True  -- | Given a list of settings (a way to classify) and a list of hints, run them over a list of modules. executeHints :: [Setting] -> [(Module_, [Comment])] -> [Idea]

@@ -90,6 +90,7 @@         ,cmdReports :: [FilePath]        -- ^ where to generate reports         ,cmdGivenHints :: [FilePath]     -- ^ which settignsfiles were explicitly given         ,cmdWithHints :: [String]        -- ^ hints that are given on the command line+        ,cmdWithGroups :: [String]       -- ^ groups that are given on the command line         ,cmdGit :: Bool                  -- ^ use git ls-files to find files         ,cmdColor :: ColorMode           -- ^ color the result         ,cmdThreads :: Int              -- ^ Numbmer of threads to use, 0 = whatever GHC has@@ -151,6 +152,7 @@         ,cmdReports = nam "report" &= opt "report.html" &= typFile &= help "Generate a report in HTML"         ,cmdGivenHints = nam "hint" &= typFile &= help "Hint/ignore file to use"         ,cmdWithHints = nam "with" &= typ "HINT" &= help "Extra hints to use"+        ,cmdWithGroups = nam_ "with-group" &= typ "GROUP" &= help "Extra hint groups to use"         ,cmdGit = nam "git" &= help "Run on files tracked by git"         ,cmdColor = nam "colour" &= name "color" &= opt Always &= typ "always/never/auto" &= help "Color output (requires ANSI terminal; auto means on when $TERM is supported; by itself, selects always)"         ,cmdThreads = 1 &= name "threads" &= name "j" &= opt (0 :: Int) &= help "Number of threads to use (-j for all)"

@@ -88,6 +88,7 @@               [con -> Just "DecreasesLaziness"] -> [DecreasesLaziness]               [con -> Just "RemovesError",fromString -> Just a] -> [RemovesError a]               [con -> Just "ValidInstance",fromString -> Just a,var -> Just b] -> [ValidInstance a b]+              [con -> Just "RequiresExtension",con -> Just a] -> [RequiresExtension a]               _ -> errorOn x "bad note"            con :: Exp_ -> Maybe String

@@ -57,6 +57,7 @@     | RemovesError String -- ^ The replacement removes errors, for example replacing @foldr1 (+)@ with @sum@ removes an error on @[]@, and might contain the text @\"on []\"@.     | ValidInstance String String -- ^ The replacement assumes standard type class lemmas, a hint with the note @ValidInstance \"Eq\" \"x\"@ might only be valid if                                   --   the @x@ variable has a reflexive @Eq@ instance.+    | RequiresExtension String -- ^ The replacement requires this extension to be available.     | Note String -- ^ An arbitrary note.       deriving (Eq,Ord) @@ -65,6 +66,7 @@     show DecreasesLaziness = "decreases laziness"     show (RemovesError x) = "removes error " ++ x     show (ValidInstance x y) = "requires a valid `" ++ x ++ "` instance for `" ++ y ++ "`"+    show (RequiresExtension x) = "may require `{-# LANGUAGE " ++ x ++ " #-}` adding to the top of the file"     show (Note x) = x  

@@ -262,6 +262,7 @@ asNote "DecreasesLaziness" = DecreasesLaziness asNote (word1 -> ("RemovesError",x)) = RemovesError x asNote (word1 -> ("ValidInstance",x)) = uncurry ValidInstance $ word1 x+asNote (word1 -> ("RequiresExtension",x)) = RequiresExtension x asNote x = Note x  

@@ -144,12 +144,23 @@ readAllSettings :: [String] -> Cmd -> IO (Cmd, [Setting]) readAllSettings args1 cmd@CmdMain{..} = do     files <- cmdHintFiles cmd-    settings1 <- readFilesConfig $ map (,Nothing) files ++ [("CommandLine.hs",Just x) | x <- cmdWithHints]+    settings1 <-+        readFilesConfig $+        map (,Nothing) files+        ++ [("CommandLine.hs",Just x) | x <- cmdWithHints]+        ++ [("CommandLine.yaml",Just (enableGroup x)) | x <- cmdWithGroups]     let args2 = [x | SettingArgument x <- settings1]     cmd@CmdMain{..} <- if null args2 then return cmd else getCmd $ args1 ++ args2     settings2 <- concatMapM (fmap snd . computeSettings (cmdParseFlags cmd)) cmdFindHints     settings3 <- return [SettingClassify $ Classify Ignore x "" "" | x <- cmdIgnore]     return (cmd, settings1 ++ settings2 ++ settings3)+    where+        enableGroup groupName =+            unlines+            ["- group:"+            ,"    name: " ++ groupName+            ,"    enabled: true"+            ]  runHints :: [String] -> [Setting] -> Cmd -> IO [Idea] runHints args settings cmd@CmdMain{..} = do

@@ -75,6 +75,12 @@     ,infix_ 4 [".|.=",".&.=","<.|.=","<.&.="]     ] +hspecFixities :: [Fixity]+hspecFixities =+    infix_ 1 ["`shouldBe`","`shouldSatisfy`","`shouldStartWith`","`shouldEndWith`","`shouldContain`","`shouldMatchList`"+             ,"`shouldReturn`","`shouldNotBe`","`shouldNotSatisfy`","`shouldNotContain`","`shouldNotReturn`","`shouldThrow`"]++ -- Fixites from the `base` package which are currently -- missing from `haskell-src-exts`'s baseFixities. -- see https://github.com/haskell-suite/haskell-src-exts/pull/400@@ -95,8 +101,11 @@  -- | Default value for 'ParseFlags'. defaultParseFlags :: ParseFlags-defaultParseFlags = ParseFlags NoCpp-    defaultParseMode{fixities=Just $ customFixities ++ baseFixities ++ baseNotYetInHSE ++ lensFixities, ignoreLinePragmas=False, ignoreFunctionArity=True, extensions=defaultExtensions}+defaultParseFlags = ParseFlags NoCpp defaultParseMode+    {fixities = Just $ customFixities ++ baseFixities ++ baseNotYetInHSE ++ lensFixities ++ hspecFixities+    ,ignoreLinePragmas = False+    ,ignoreFunctionArity = True+    ,extensions = defaultExtensions}  parseFlagsNoLocations :: ParseFlags -> ParseFlags parseFlagsNoLocations x = x{cppFlags = case cppFlags x of Cpphs y -> Cpphs $ f y; y -> y}

@@ -47,6 +47,9 @@ modulePragmas (Module _ _ x _ _) = x modulePragmas _ = [] -- XmlPage/XmlHybrid +moduleExtensions :: Module_ -> [Name S]+moduleExtensions x = concat [y | LanguagePragma _ y <- modulePragmas x]+ fromModuleName :: ModuleName S -> String fromModuleName (ModuleName _ x) = x @@ -168,6 +171,10 @@ dotApps [x] = x dotApps (x:xs) = dotApp x (dotApps xs) +isReturn :: Exp_ -> Bool+-- Allow both pure and return, as they have the same semantics+isReturn (Var _ (UnQual _ (Ident _ x))) = x == "return" || x == "pure"+isReturn _ = False  isLexeme Var{} = True isLexeme Con{} = True

@@ -19,7 +19,7 @@ exportHint _ (Module _ (Just o@(ModuleHead a name warning exports)) _ _ _)     | Nothing <- exports =         let o2 = ModuleHead a name warning $ Just $ ExportSpecList a [EModuleContents a name]-        in [(ignore "Use module export list" o o2 []){ideaNote = [Note "An explicit list is usually better"]}]+        in [(ignore "Use module export list" o o2 []){ideaNote = [Note "an explicit list is usually better"]}]     | Just (ExportSpecList _ xs) <- exports, EModuleContents a name `elem_` xs =         let o2 = ModuleHead a name warning $ Just $ ExportSpecList a $ EVar a ellipses : delete_ (EModuleContents a name) xs         in [ignore "Use explicit module export list" o o2 []]

@@ -31,7 +31,10 @@ {-# LANGUAGE RecordWildCards #-} \ record field = Record{..} {-# LANGUAGE RecordWildCards #-} \-record = 1 --+record = 1 -- @Note may require `{-# LANGUAGE DisambiguateRecordFields #-}` adding to the top of the file+{-# LANGUAGE RecordWildCards #-} \+{-# LANGUAGE DisambiguateRecordFields #-} \+record = 1 -- @NoNote {-# LANGUAGE UnboxedTuples #-} \ record = 1 -- {-# LANGUAGE TemplateHaskell #-} \@@ -146,7 +149,7 @@   -- RecordWildCards implies DisambiguateRecordFields, but most people probably don't want it-warnings old new | wildcards `elem` old && wildcards `notElem` new = [Note "you may need to add DisambiguateRecordFields"]+warnings old new | wildcards `elem` old && wildcards `notElem` new = [RequiresExtension "DisambiguateRecordFields"]     where wildcards = EnableExtension RecordWildCards warnings _ _ = [] 

@@ -148,7 +148,7 @@       munge ident p = PVar (ann p) (Ident (ann p) [ident])       subts = ("body", toSS body) : zipWith (\x y -> ([x],y)) ['a'..'z'] (map toSS pats) lambdaExp p o@(Lambda _ [view -> PVar_ u] (Case _ (view -> Var_ v) alts))-    | u == v, u `notElem` vars alts = [suggestN "Use lambda-case" o $ LCase an alts]+    | u == v, u `notElem` vars alts = [(suggestN "Use lambda-case" o $ LCase an alts){ideaNote=[RequiresExtension "LambdaCase"]}] lambdaExp _ _ = []  

@@ -18,6 +18,7 @@ f z (x:xs) = f (z*x) xs ; f z [] = z -- f z xs = foldl (*) z xs f a (x:xs) b = x + a + b : f a xs b ; f a [] b = [] -- f a xs b = map (\ x -> x + a + b) xs f [] a = return a ; f (x:xs) a = a + x >>= \fax -> f xs fax -- f xs a = foldM (+) a xs+f (x:xs) a = a + x >>= \fax -> f xs fax ; f [] a = pure a -- f xs a = foldM (+) a xs foos [] x = x; foos (y:ys) x = foo y $ foos ys x -- foos ys x = foldr foo x ys f [] y = y; f (x:xs) y = f xs $ g x y -- f xs y = foldl (flip g) y xs f [] y = y; f (x : xs) y = let z = g x y in f xs z -- f xs y = foldl (flip g) y xs@@ -93,7 +94,7 @@     = Just $ (,,) "foldl" Suggestion $ appsBracket         [toNamed "foldl", niceLambda [v,x] lhs, toNamed v, toNamed xs] -    | [v] <- vs, App _ ret res <- nil, ret ~= "return", res ~= "()" || view res == Var_ v+    | [v] <- vs, App _ ret res <- nil, isReturn ret, res ~= "()" || view res == Var_ v     , [Generator _ (view -> PVar_ b1) e, Qualifier _ (fromParen -> App _ r (view -> Var_ b2))] <- asDo cons     , b1 == b2, r == recursive, xs `notElem` vars e     , name <- "foldM" ++ ['_' | res ~= "()"]

@@ -22,6 +22,7 @@ no = do x <- bar; x; x yes = do x <- bar; return (f x) -- do f <$> bar yes = do x <- bar; return $ f x -- do f <$> bar+yes = do x <- bar; pure $ f x -- do f <$> bar yes = do x <- bar; return $ f (g x) -- do f . g <$> bar yes = do x <- bar; return (f $ g x) -- do f . g <$> bar yes = do x <- bar $ baz; return (f $ g x)@@ -107,7 +108,7 @@                                           go (InfixApp _ f (isDol -> True) x) = first (f:) $ go x                                           go x = ([], x)                                       in go -> (ret:f:fs, view -> Var_ v))):g@(Generator _ (view -> PVar_ u) x):rest)-    | ret ~= "return", notDol x, u == v, null rest, v `notElem` vars (f:fs)+    | isReturn ret, notDol x, u == v, null rest, v `notElem` vars (f:fs)     = Just (reverse (Qualifier an (InfixApp an (foldl' (flip (InfixApp an) (toNamed ".")) f fs) (toNamed "<$>") x):rest),             [Replace Stmt (toSS g) (("x", toSS x):zip vs (toSS <$> f:fs)) (intercalate " . " (take (length fs + 1) vs) ++ " <$> x"), Delete Stmt (toSS q)])   where vs = ('f':) . show <$> [0..]@@ -117,7 +118,7 @@  monadReturn :: [Stmt S] -> Maybe ([Stmt S], [Refactoring R.SrcSpan]) monadReturn (reverse -> q@(Qualifier _ (App _ ret (Var _ v))):g@(Generator _ (PVar _ p) x):rest)-    | ret ~= "return", fromNamed v == fromNamed p+    | isReturn ret, fromNamed v == fromNamed p     = Just (reverse (Qualifier an x : rest),             [Replace Stmt (toSS g) [("x", toSS x)] "x", Delete Stmt (toSS q)]) monadReturn _ = Nothing@@ -152,5 +153,5 @@  fromRet (Paren _ x) = fromRet x fromRet (InfixApp _ x y z) | opExp y ~= "$" = fromRet $ App an x z-fromRet (App _ x y) | x ~= "return" = Just y+fromRet (App _ x y) | isReturn x = Just y fromRet _ = Nothing

@@ -1,4 +1,4 @@-{-# LANGUAGE PatternGuards, RecordWildCards #-}+{-# LANGUAGE PatternGuards, RecordWildCards, ViewPatterns #-}  -- | Check the <TEST> annotations within source and hint files. module Test.Annotations(testAnnotations) where@@ -56,9 +56,10 @@             if null bad then passed else sequence_ bad          match "???" _ = True-        match x y | "@" `isPrefixOf` x = a == show (ideaSeverity y) && match (trimStart b) y-            where (a,b) = break isSpace $ tail x-        match x y = on (==) norm (fromMaybe "" $ ideaTo y) x+        match (word1 -> ("@Note",note)) i = map show (ideaNote i) == [note]+        match "@NoNote" i = null (ideaNote i)+        match (word1 -> ('@':sev, msg)) i = sev == show (ideaSeverity i) && match msg i+        match msg i = on (==) norm (fromMaybe "" $ ideaTo i) msg          -- FIXME: Should use a better check for expected results         norm = filter $ \x -> not (isSpace x) && x /= ';'