packages feed

hlint 1.8 → 1.8.1

raw patch · 15 files changed

+102/−61 lines, 15 filesdep ~haskell-src-extsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: haskell-src-exts

API changes (from Hackage documentation)

Files

data/Default.hs view
@@ -5,7 +5,7 @@ import Control.Monad import Data.Function import Data.Int-import Data.List+import Data.List as X import Data.Maybe import Data.Monoid import Data.Ord@@ -62,8 +62,6 @@ error "Use map once" = map f (map g x) ==> map (f . g) x warn  = x !! 0 ==> head x error = take n (repeat x) ==> replicate n x-error = x ++ concatMap (' ':) y ==> unwords (x:y)-error = concat (intersperse " " x) ==> unwords x error = head (reverse x) ==> last x error = head (drop n x) ==> x !! n error = reverse (tail (reverse x)) ==> init x@@ -82,6 +80,10 @@ error = map (uncurry f) (zip x y) ==> zipWith f x y error = not (elem x y) ==> notElem x y warn  = foldr f z (map g x) ==> foldr (f . g) z x+error = x ++ concatMap (' ':) y ==> unwords (x:y)+error = intercalate " " ==> unwords+warn  = concat (intersperse x y) ==> intercalate x y where _ = notEq x " "+warn  = concat (intersperse " " x) ==> unwords x  -- FOLDS @@ -190,13 +192,13 @@  -- INFIX -warn "Use infix" = elem x y ==> x `elem` y where _ = not (isInfixApp original) && not (isParen result)-warn "Use infix" = notElem x y ==> x `notElem` y where _ = not (isInfixApp original) && not (isParen result)-warn "Use infix" = isInfixOf x y ==> x `isInfixOf` y where _ = not (isInfixApp original) && not (isParen result)-warn "Use infix" = isSuffixOf x y ==> x `isSuffixOf` y where _ = not (isInfixApp original) && not (isParen result)-warn "Use infix" = isPrefixOf x y ==> x `isPrefixOf` y where _ = not (isInfixApp original) && not (isParen result)-warn "Use infix" = union x y ==> x `union` y where _ = not (isInfixApp original) && not (isParen result)-warn "Use infix" = intersect x y ==> x `intersect` y where _ = not (isInfixApp original) && not (isParen result)+warn "Use infix" = X.elem x y ==> x `X.elem` y where _ = not (isInfixApp original) && not (isParen result)+warn "Use infix" = X.notElem x y ==> x `X.notElem` y where _ = not (isInfixApp original) && not (isParen result)+warn "Use infix" = X.isInfixOf x y ==> x `X.isInfixOf` y where _ = not (isInfixApp original) && not (isParen result)+warn "Use infix" = X.isSuffixOf x y ==> x `X.isSuffixOf` y where _ = not (isInfixApp original) && not (isParen result)+warn "Use infix" = X.isPrefixOf x y ==> x `X.isPrefixOf` y where _ = not (isInfixApp original) && not (isParen result)+warn "Use infix" = X.union x y ==> x `X.union` y where _ = not (isInfixApp original) && not (isParen result)+warn "Use infix" = X.intersect x y ==> x `X.intersect` y where _ = not (isInfixApp original) && not (isParen result)  -- MATHS @@ -321,7 +323,8 @@ error = a $$$$ b $$$$ c ==> a . b $$$$$ c yes = when (not . null $ asdf) -- unless (null asdf) yes = id 1 -- 1-+yes = case concat (map f x) of [] -> [] -- concatMap f x+yes = Map.union a b -- a `Map.union` b  import Prelude \ yes = flip mapM -- Control.Monad.forM
hlint.cabal view
@@ -1,7 +1,7 @@ cabal-version:      >= 1.6 build-type:         Simple name:               hlint-version:            1.8+version:            1.8.1 -- license is GPL v2 only license:            GPL license-file:       LICENSE@@ -37,10 +37,8 @@         base == 4.*, process, filepath, directory, mtl, containers,         hscolour == 1.17.*,         cpphs == 1.11.*,-        haskell-src-exts == 1.9.*,+        haskell-src-exts == 1.9.* && >= 1.9.4,         uniplate == 1.5.*--    ghc-options:        -fno-warn-overlapping-patterns      hs-source-dirs:     src     exposed-modules:
hlint.htm view
@@ -74,7 +74,7 @@ <h3>Acknowledgements</h3>  <p>-	This program has only been made possible by the presence of the <a href="http://www.cs.chalmers.se/~d00nibro/haskell-src-exts/">haskell-src-exts</a> package, and many improvements have been made by <a href="http://www.cs.chalmers.se/~d00nibro/">Niklas Broberg</a> in response to feature requests. Additionally, many people have provided help and patches, including Lennart Augustsson, Malcolm Wallace, Henk-Jan van Tuyl, Gwern Branwen, Alex Ott, Andy Stewart and others.+	This program has only been made possible by the presence of the <a href="http://www.cs.chalmers.se/~d00nibro/haskell-src-exts/">haskell-src-exts</a> package, and many improvements have been made by <a href="http://www.cs.chalmers.se/~d00nibro/">Niklas Broberg</a> in response to feature requests. Additionally, many people have provided help and patches, including Lennart Augustsson, Malcolm Wallace, Henk-Jan van Tuyl, Gwern Branwen, Alex Ott, Andy Stewart, Roman Leshchinskiy and others. </p>  <h3 id="limitations">Bugs and limitations</h3>@@ -254,19 +254,19 @@ </p> <ul> 	<li><tt>{-# ANN module "HLint: ignore Eta reduce" #-}</tt> - ignore all eta reduction suggestions in this module.</li>-	<li><tt>{-# ANN map "HLint: ignore" #-}</tt> - don't give any hints in the function map.</li>-	<li><tt>{-# ANN map "HLint: error" #-}</tt> - any hint in the function is an error.</li>+	<li><tt>{-# ANN myFunction "HLint: ignore" #-}</tt> - don't give any hints in the function <tt>myFunction</tt>.</li>+	<li><tt>{-# ANN myFunction "HLint: error" #-}</tt> - any hint in the function <tt>myFunction</tt> is an error.</li> 	<li><tt>{-# ANN module "HLint: error Use concatMap" #-}</tt> - the hint to use concatMap is an error.</li>-	<li><tt>{-# ANN warn "HLint: Use concatMap" #-}</tt> - the hint to use concatMap is a warning.</li>+	<li><tt>{-# ANN module "HLint: warn Use concatMap" #-}</tt> - the hint to use concatMap is a warning.</li> </ul> <p> 	Ignore directives can also be written in the hint files: </p> <ul> 	<li><tt>ignore "Eta reduce"</tt> - supress all eta reduction suggestions.</li>-	<li><tt>ignore "Eta reduce" = Data.List Prelude</tt> - supress eta reduction hints in the Prelude and Data.List modules.</li>-	<li><tt>ignore = Data.List.map</tt> - don't give any hints in the function Data.List.map.</li>-	<li><tt>error = Data.List.map</tt> - any hint in the function is an error.</li>+	<li><tt>ignore "Eta reduce" = MyModule1 MyModule2</tt> - supress eta reduction hints in the <tt>MyModule1</tt> and <tt>MyModule2</tt> modules.</li>+	<li><tt>ignore = MyModule.myFunction</tt> - don't give any hints in the function <tt>MyModule.myFunction</tt>.</li>+	<li><tt>error = MyModule.myFunction</tt> - any hint in the function <tt>MyModule.myFunction</tt> is an error.</li> 	<li><tt>error "Use concatMap"</tt> - the hint to use concatMap is an error.</li> 	<li><tt>warn "Use concatMap"</tt> - the hint to use concatMap is a warning.</li> </ul>
src/Apply.hs view
@@ -48,8 +48,9 @@ parseOk :: [Hint] -> Module_ -> [Idea] parseOk h m =         order "" [i | ModuHint h <- h, i <- h nm m] ++-        concat [order (fromNamed d) [i | DeclHint h <- h, i <- h nm m d] | d <- moduleDecls m]+        concat [order (fromNamed d) [i | h <- decHints, i <- h d] | d <- moduleDecls m]     where+        decHints = [h nm m | DeclHint h <- h] -- partially apply         order n = map (\i -> i{func = (moduleName m,n)}) . sortBy (comparing loc)         nm = moduleScope m @@ -61,13 +62,14 @@   classify :: [Setting] -> Idea -> Idea-classify xs i = if isParseError i then i else i{rank = foldl' (rerank i) (rank i) $ filter isClassify xs}+classify xs i = i{rank = foldl' (rerank i) (rank i) $ filter isClassify xs}     where         -- figure out if we need to change the rank         rerank :: Idea -> Rank -> Setting -> Rank-        rerank i r c | matchHint (hintS c) (hint i) && matchFunc (funcS c) (func i) = rankS c+        rerank i r c | matchHint (hintS c) (hint i) && matchFunc (funcS c) (func_ i) = rankS c                      | otherwise = r +        func_ x = if isParseError x then ("","") else func x         matchHint = (~=)         matchFunc (x1,x2) (y1,y2) = (x1~=y1) && (x2~=y2)         x ~= y = null x || x == y
src/CmdLine.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE PatternGuards #-} -module CmdLine(Cmd(..), getCmd, exitWithHelp) where+module CmdLine(Cmd(..), CppFlags(..), getCmd, exitWithHelp) where  import Control.Monad import Data.List@@ -17,6 +17,12 @@ import Data.Version  +data CppFlags+    = NoCpp+    | CppSimple+    | Cpphs CpphsOptions++ -- FIXME: Hints vs GivenHints is horrible data Cmd = Cmd     {cmdTest :: Bool                 -- ^ run in test mode?@@ -27,7 +33,7 @@     ,cmdIgnore :: [String]           -- ^ the hints to ignore     ,cmdShowAll :: Bool              -- ^ display all skipped items     ,cmdColor :: Bool                -- ^ color the result-    ,cmdCpphs :: Maybe CpphsOptions  -- ^ options for cpphs+    ,cmdCpp :: CppFlags              -- ^ options for CPP     ,cmdDataDir :: FilePath          -- ^ the data directory     ,cmdEncoding :: String           -- ^ the text encoding     ,cmdFindHints :: [FilePath]      -- ^ source files to look for hints in@@ -46,6 +52,7 @@           | Color           | Define String           | Include String+          | SimpleCpp           | Ext String           | DataDir String           | Encoding String@@ -72,6 +79,7 @@        ,Option "q" ["quiet"] (NoArg Quiet) "Supress most console output"        ,Option ""  ["cpp-define"] (ReqArg Define "name[=value]") "CPP #define"        ,Option ""  ["cpp-include"] (ReqArg Include "dir") "CPP include path"+       ,Option ""  ["cpp-simple"] (NoArg SimpleCpp) "Use a simple CPP (strip # lines)"        ]  @@ -101,17 +109,20 @@     hints <- mapM (getHintFile dataDir) $ hintFiles ++ ["HLint" | null hintFiles]     let givenHints = if null hintFiles then [] else hints +    let languages = getExtensions [x | Language x <- opt]+     let cpphs = defaultCpphsOptions             {boolopts=defaultBoolOptions{hashline=False}             ,includes = [x | Include x <- opt]             ,defines = [(a,drop 1 b) | Define x <- opt, let (a,b) = break (== '=') x]             }+    let cpp | SimpleCpp `elem` opt = CppSimple -- must be first, so can disable CPP+            | CPP `elem` languages = Cpphs cpphs+            | otherwise = NoCpp      let encoding = last $ "" : [x | Encoding x <- opt]     when (encoding /= "") $ warnEncoding encoding -    let languages = getExtensions [x | Language x <- opt]-     return Cmd         {cmdTest = test         ,cmdFiles = files@@ -121,7 +132,7 @@         ,cmdIgnore = [x | Skip x <- opt]         ,cmdShowAll = ShowAll `elem` opt         ,cmdColor = Color `elem` opt-        ,cmdCpphs = if CPP `elem` languages then Just cpphs else Nothing+        ,cmdCpp = cpp         ,cmdDataDir = dataDir         ,cmdEncoding = encoding         ,cmdFindHints = findHints
src/HLint.hs view
@@ -40,7 +40,7 @@ hlint :: [String] -> IO [Suggestion] hlint args = do     cmd@Cmd{..} <- getCmd args-    let flags = parseFlags{cpphs=cmdCpphs, encoding=cmdEncoding, language=cmdLanguage}+    let flags = parseFlags{cppFlags=cmdCpp, encoding=cmdEncoding, language=cmdLanguage}     if cmdTest then         test (\x -> hlint x >> return ()) cmdDataDir cmdGivenHints >> return []      else if null cmdFiles && notNull cmdFindHints then
src/HSE/All.hs view
@@ -9,6 +9,8 @@     ) where  import Util+import CmdLine+import Data.List import Data.Maybe import HSE.Util import HSE.Evaluate@@ -20,24 +22,30 @@   data ParseFlags = ParseFlags-    {cpphs :: Maybe CpphsOptions+    {cppFlags :: CppFlags     ,language :: [Extension]     ,encoding :: String     ,infixes :: [Fixity]     }  parseFlags :: ParseFlags-parseFlags = ParseFlags Nothing defaultExtensions "" []+parseFlags = ParseFlags NoCpp defaultExtensions "" []  parseFlagsNoLocations :: ParseFlags -> ParseFlags-parseFlagsNoLocations x = x{cpphs = fmap f $ cpphs x}+parseFlagsNoLocations x = x{cppFlags = case cppFlags x of Cpphs y -> Cpphs $ f y; y -> y}     where f x = x{boolopts = (boolopts x){locations=False}}  +runCpp :: CppFlags -> FilePath -> String -> IO String+runCpp NoCpp _ x = return x+runCpp CppSimple _ x = return $ unlines [if "#" `isPrefixOf` ltrim x then "" else x | x <- lines x]+runCpp (Cpphs o) file x = runCpphs o file x++ -- | Parse a Haskell module parseString :: ParseFlags -> FilePath -> String -> IO (String, ParseResult Module_) parseString flags file str = do-        ppstr <- maybe return (`runCpphs` file) (cpphs flags) str+        ppstr <- runCpp (cppFlags flags) file str         return (ppstr, fmap (applyFixity fixity) $ parseFileContentsWithMode mode ppstr)     where         fixity = infixes flags ++ baseFixities
src/HSE/Bracket.hs view
@@ -54,6 +54,7 @@         | isDotApp parent, isDotApp child, i == 1 = False         | RecConstr{} <- parent = False         | RecUpdate{} <- parent, i /= 0 = False+        | Case{} <- parent, i /= 0 || isAnyApp child = False         | Lambda{} <- parent, i == length (universeBi parent :: [Pat_]) - 1 = False -- watch out for PViewPat         | otherwise = True
src/HSE/Util.hs view
@@ -77,7 +77,6 @@ isMDo MDo{} = True; isMDo _ = False isBoxed Boxed{} = True; isBoxed _ = False isDerivDecl DerivDecl{} = True; isDerivDecl _ = False-isFunDep FunDep{} = True; isFunDep _ = False isPBangPat PBangPat{} = True; isPBangPat _ = False isPExplTypeArg PExplTypeArg{} = True; isPExplTypeArg _ = False isPFieldPun PFieldPun{} = True; isPFieldPun _ = False
src/Hint/Extensions.hs view
@@ -48,7 +48,7 @@ used :: Extension -> Module_ -> Bool used RecursiveDo = hasS isMDo used ParallelListComp = hasS isParComp-used FunctionalDependencies = hasS isFunDep+used FunctionalDependencies = hasT (un :: FunDep S) used ImplicitParams = hasT (un :: IPName S) used EmptyDataDecls = hasS f     where f (DataDecl _ _ _ _ [] _) = True
src/Hint/Match.hs view
@@ -38,7 +38,6 @@ import Data.Data import Unsafe.Coerce import Settings-import HSE.NameMatch import Hint.Type import Control.Monad import Control.Arrow@@ -88,7 +87,7 @@     let nm = nameMatch scope s     u <- unifyExp nm lhs x     u <- check u-    let res = addBracket parent $ unqualify scope s $ performEval $ subst u rhs+    let res = addBracket parent $ unqualify scope s u $ performEval $ subst u rhs     guard $ checkSide side $ ("original",x) : ("result",res) : u     guard $ checkDefine decl parent res     return res@@ -112,6 +111,9 @@ unifyExp :: NameMatch -> Exp_ -> Exp_ -> Maybe [(String,Exp_)] unifyExp nm x y | isParen x || isParen y = unifyExp nm (fromParen x) (fromParen y) unifyExp nm (Var _ (fromNamed -> v)) y | isUnifyVar v = Just [(v,y)]+unifyExp nm (Var _ (Qual _ (ModuleName _ [m]) x)) (Var _ y)+    | Qual _ (ModuleName _ m2) y <- y, y == x = Just [([m], Var an $ UnQual an $ Ident an m2)]+    | UnQual _ y <- y, y == x = Just [([m], Var an $ UnQual an $ Ident an "")] unifyExp nm (Var _ x) (Var _ y) | nm x y = Just [] unifyExp nm x@(App _ x1 x2) (App _ y1 y2) =     liftM2 (++) (unifyExp nm x1 y1) (unifyExp nm x2 y2) `mplus`@@ -205,8 +207,13 @@   -- contract Data.List.foo ==> foo, if Data.List is loaded-unqualify :: Scope -> Scope -> Exp_ -> Exp_-unqualify from to = transformBi (nameQualify from to)+-- change X.foo => Module.foo, where X is looked up in the subst+unqualify :: Scope -> Scope -> [(String,Exp_)] -> Exp_ -> Exp_+unqualify from to subs = transformBi f+    where+        f (Qual _ (ModuleName _ [m]) x) | Just y <- fmap fromNamed $ lookup [m] subs+            = if null y then UnQual an x else Qual an (ModuleName an y) x+        f x = nameQualify from to x   addBracket :: Maybe (Int,Exp_) -> Exp_ -> Exp_
src/Hint/Naming.hs view
@@ -20,6 +20,7 @@ a -== b = 1 myTest = 1; my_test = 1 semiring'laws = 1 -- semiringLaws = ...+data Yes = FOO_A | Foo_B -- data Yes = FOO_A | FooB </TEST> -} @@ -74,7 +75,7 @@   suggestName :: String -> Maybe String-suggestName x = listToMaybe [f x | not $ isSym x || good || "prop_" `isPrefixOf` x]+suggestName x = listToMaybe [f x | not $ isSym x || good || not (any isLower x) || "prop_" `isPrefixOf` x]     where         good = all isAlphaNum $ drp '_' $ drp '\'' $ reverse $ dropWhile (== '_') x         drp x ys = if [x] `isPrefixOf` ys then tail ys else ys
src/Hint/Structure.hs view
@@ -16,7 +16,7 @@       | c <- f b = c foo x = yes x x where yes x y = if a then b else if c then d else e -- yes x y ; | a = b ; | c = d ; | otherwise = e foo x | otherwise = y -- foo x = y-foo x = x + x where -- foo x = x + x+-- FIXME: #358 foo x = x + x where -- foo x = x + x foo x | a = b | True = d -- foo x | a = b ; | otherwise = d </TEST> -}@@ -51,7 +51,7 @@     | prettyPrint test `elem` ["otherwise","True"]     = [gen "Redundant guard" $ Pattern pats (UnGuardedRhs an bod) bind] -hints gen (Pattern pats bod (Just bind)) | f bind+hints gen (Pattern pats bod (Just bind)) | f bind && False -- disabled due to bug 358     = [gen "Redundant where" $ Pattern pats bod Nothing]     where         f (BDecls _ x) = null x
src/Test.hs view
@@ -195,22 +195,27 @@         reader x = readFile' $ "tests" </> pre <.> x      flags <--        if has "flags" then fmap (takeWhile (/= '\n')) $ reader "flags"-        else if has "hs" then return $ "tests/" ++ pre <.> "hs"-        else if has "lhs" then return $ "tests/" ++ pre <.> "lhs"+        if has "flags" then fmap lines $ reader "flags"+        else if has "hs" then return ["tests/" ++ pre <.> "hs"]+        else if has "lhs" then return ["tests/" ++ pre <.> "lhs"]         else error "checkInputOutput, couldn't find or figure out flags" -    -- Note: if main crashes (argument error etc) then it won't trap the ExitCode-    got <- captureOutput $ handle (\(e::ExitCode) -> return ()) $ main $ words flags+    got <- captureOutput $+        handle (\(e::SomeException) -> print $ e) $+        handle (\(e::ExitCode) -> return ()) $+        main flags     want <- reader "output" -    if got == want then return pass else do-        (got,want) <- return (lines got, lines want)-        let trail = replicate (max (length got) (length want)) "<EOF>"-        let (i,g,w):_ = [(i,g,w) | (i,g,w) <- zip3 [1..] (got++trail) (want++trail), g /= w]-        putStrLn $ unlines-            ["TEST FAILURE IN tests/" ++ pre-            ,"DIFFER ON LINE: " ++ show i-            ,"GOT : " ++ g-            ,"WANT: " ++ w]-        return failure+    case got of+        Nothing -> putStrLn "Warning: failed to capture output (GHC too old?)" >> return pass+        Just got | got == want -> return pass+                 | otherwise -> do+            (got,want) <- return (lines got, lines want)+            let trail = replicate (max (length got) (length want)) "<EOF>"+            let (i,g,w):_ = [(i,g,w) | (i,g,w) <- zip3 [1..] (got++trail) (want++trail), g /= w]+            putStrLn $ unlines+                ["TEST FAILURE IN tests/" ++ pre+                ,"DIFFER ON LINE: " ++ show i+                ,"GOT : " ++ g+                ,"WANT: " ++ w]+            return failure
src/Util.hs view
@@ -18,7 +18,9 @@ import Data.Generics.Uniplate.Operations import Language.Haskell.Exts.Extension +#if __GLASGOW_HASKELL__ >= 612 import GHC.IO.Handle(hDuplicate,hDuplicateTo)+#endif   ---------------------------------------------------------------------@@ -141,7 +143,10 @@   -- FIXME: This could use a lot more bracket calls!-captureOutput :: IO () -> IO String+captureOutput :: IO () -> IO (Maybe String)+#if __GLASGOW_HASKELL__ < 612+captureOutput act = return Nothing+#else captureOutput act = do     tmp <- getTemporaryDirectory     (f,h) <- openTempFile tmp "hlint"@@ -155,7 +160,8 @@     hDuplicateTo ste stderr     res <- readFile' f     removeFile f-    return res+    return $ Just res+#endif   -- FIXME: Should use strict ByteString