hlint 1.9.7 → 1.9.8
raw patch · 15 files changed
+83/−47 lines, 15 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGES.txt +4/−0
- README.md +2/−2
- data/Default.hs +3/−1
- hlint.cabal +11/−2
- src/CmdLine.hs +1/−1
- src/HLint.hs +1/−0
- src/HSE/Util.hs +19/−20
- src/Hint/List.hs +2/−4
- src/Hint/Pragma.hs +1/−1
- src/HsColour.hs +27/−0
- src/Idea.hs +3/−4
- src/Report.hs +3/−6
- src/Settings.hs +3/−4
- src/Test/All.hs +1/−0
- src/Util.hs +2/−2
CHANGES.txt view
@@ -1,5 +1,9 @@ Changelog for HLint +1.9.8+ #82, don't crash on XmlHybrid modules+ #88, allow avoiding HsColour, as it is GPL licensed+ #87, don't push if down, since it can be type incorrect 1.9.7 #86, don't use color unless $TERM claims to support it 1.9.6
README.md view
@@ -1,6 +1,6 @@ # HLint [](http://hackage.haskell.org/package/hlint) [](https://travis-ci.org/ndmitchell/hlint) -HLint is a tool for suggesting possible improvements to Haskell code. These suggestions include ideas such as using alternative functions, simplifying code and spotting redundancies. This document is structured as follows:+HLint is a tool for suggesting possible improvements to Haskell code. These suggestions include ideas such as using alternative functions, simplifying code and spotting redundancies. You can try HLint online at [lpaste.net](http://lpaste.net/) - suggestions are shown at the bottom. This document is structured as follows: * [Installing and running HLint](#installing-and-running-hlint) * [FAQ](#faq)@@ -65,7 +65,7 @@ ### Emacs Integration -Emacs integration has been provided by [Alex Ott](http://xtalk.msk.su/~ott/). The integration is similar to compilation-mode, allowing navigation between errors. The script is at [hs-lint.el](http://community.haskell.org/~ndm/darcs/hlint/data/hs-lint.el), and a copy is installed locally in the data directory. To use, add the following code to the Emacs init file:+Emacs integration has been provided by [Alex Ott](http://xtalk.msk.su/~ott/). The integration is similar to compilation-mode, allowing navigation between errors. The script is at [hs-lint.el](https://github.com/ndmitchell/hlint/blob/master/data/hs-lint.el), and a copy is installed locally in the data directory. To use, add the following code to the Emacs init file: (require 'hs-lint) (defun my-haskell-mode-hook ()
data/Default.hs view
@@ -262,7 +262,8 @@ error "Redundant if" = (if x then False else y) ==> not x && y where _ = notEq y True error "Redundant if" = (if x then y else True) ==> not x || y where _ = notEq y False error "Redundant not" = not (not x) ==> x-error "Too strict if" = (if c then f x else f y) ==> f (if c then x else y) where note = IncreasesLaziness+-- error "Too strict if" = (if c then f x else f y) ==> f (if c then x else y) where note = IncreasesLaziness+-- also breaks types, see #87 -- ARROW @@ -629,6 +630,7 @@ foo = (\f -> h f >>= f) foo = bar $ \x -> [x,y] foo = bar $ \x -> [z,y] -- const [z,y]+f condition tChar tBool = if condition then _monoField tChar else _monoField tBool 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.9.7+version: 1.9.8 license: BSD3 license-file: LICENSE category: Development@@ -39,16 +39,24 @@ default: True description: Build with support for multithreaded execution +flag gpl+ default: True+ description: Use GPL libraries, specifically hscolour+ library build-depends: base == 4.*, process, filepath, directory, containers, transformers >= 0.0,- hscolour >= 1.17, cpphs >= 1.18.1, cmdargs >= 0.10, haskell-src-exts >= 1.16 && < 1.17, uniplate >= 1.5 + if flag(gpl)+ build-depends: hscolour >= 1.17+ else+ cpp-options: -DGPL_SCARES_ME+ hs-source-dirs: src exposed-modules: Language.Haskell.HLint@@ -59,6 +67,7 @@ CmdLine Grep HLint+ HsColour Idea Settings Report
src/CmdLine.hs view
@@ -165,7 +165,7 @@ ] &= program "hlint" &= verbosity &= summary ("HLint v" ++ showVersion version ++ ", (C) Neil Mitchell 2006-2014") where- nam xs@(x:_) = nam_ xs &= name [x]+ nam xs = nam_ xs &= name [head xs] nam_ xs = def &= explicit &= name xs cmdHintFiles :: Cmd -> IO [FilePath]
src/HLint.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} module HLint(hlint, Suggestion, suggestionLocation, suggestionSeverity, Severity(..)) where
src/HSE/Util.hs view
@@ -25,43 +25,39 @@ moduleDecls :: Module_ -> [Decl_] moduleDecls (Module _ _ _ _ xs) = xs+moduleDecls _ = [] -- XmlPage/XmlHybrid moduleName :: Module_ -> String moduleName (Module _ Nothing _ _ _) = "Main" moduleName (Module _ (Just (ModuleHead _ (ModuleName _ x) _ _)) _ _ _) = x+moduleName _ = "" -- XmlPage/XmlHybrid moduleImports :: Module_ -> [ImportDecl S] moduleImports (Module _ _ _ x _) = x+moduleImports _ = [] -- XmlPage/XmlHybrid modulePragmas :: Module_ -> [ModulePragma S] modulePragmas (Module _ _ x _ _) = x+modulePragmas _ = [] -- XmlPage/XmlHybrid fromModuleName :: ModuleName S -> String fromModuleName (ModuleName _ x) = x -isChar :: Exp_ -> Bool-isChar (Lit _ Char{}) = True-isChar _ = False--fromChar :: Exp_ -> Char-fromChar (Lit _ (Char _ x _)) = x--isPChar :: Pat_ -> Bool-isPChar (PLit _ _ Char{}) = True-isPChar _ = False--fromPChar :: Pat_ -> Char-fromPChar (PLit _ _ (Char _ x _)) = x+fromChar :: Exp_ -> Maybe Char+fromChar (Lit _ (Char _ x _)) = Just x+fromChar _ = Nothing -isString :: Exp_ -> Bool-isString (Lit _ String{}) = True-isString _ = False+fromPChar :: Pat_ -> Maybe Char+fromPChar (PLit _ _ (Char _ x _)) = Just x+fromPChar _ = Nothing -fromString :: Exp_ -> String-fromString (Lit _ (String _ x _)) = x+fromString :: Exp_ -> Maybe String+fromString (Lit _ (String _ x _)) = Just x+fromString _ = Nothing -isPString (PLit _ _ String{}) = True; isPString _ = False-fromPString (PLit _ _ (String _ x _)) = x+fromPString :: Pat_ -> Maybe String+fromPString (PLit _ _ (String _ x _)) = Just x+fromPString _ = Nothing fromParen :: Exp_ -> Exp_ fromParen (Paren _ x) = fromParen x@@ -121,6 +117,7 @@ fromQual :: QName S -> Name S fromQual (Qual _ _ x) = x fromQual (UnQual _ x) = x+fromQual x = error $ "HSE.Util.fromQual, not a name: " ++ prettyPrint x isSpecial :: QName S -> Bool isSpecial Special{} = True; isSpecial _ = False@@ -141,6 +138,7 @@ dotApp x = InfixApp an x (QVarOp an $ UnQual an $ Symbol an ".") dotApps :: [Exp_] -> Exp_+dotApps [] = error "HSE.Util.dotApps, does not work on an empty list" dotApps [x] = x dotApps (x:xs) = dotApp x (dotApps xs) @@ -191,6 +189,7 @@ Alt s1 a (GuardedRhss s2 [GuardedRhs a b x | (GuardedRhs a b _,x) <- zip ns as]) b : g rest bs where (as,bs) = splitAt (length ns) xs g [] [] = []+ g _ _ = error "HSE.Util.replaceBranches: internal invariant failed, lists are of differing lengths" replaceBranches x = ([], \[] -> x)
src/Hint/List.hs view
@@ -64,8 +64,7 @@ ] -usePString (PList _ xs) | xs /= [] && all isPChar xs = Just $ PLit an (Signless an) $ String an s (show s)- where s = map fromPChar xs+usePString (PList _ xs) | xs /= [], Just s <- mapM fromPChar xs = Just $ PLit an (Signless an) $ String an s (show s) usePString _ = Nothing usePList = fmap (PList an) . f True@@ -74,8 +73,7 @@ f first (view -> PApp_ ":" [a,b]) = (a:) <$> f False b f first _ = Nothing -useString b (List _ xs) | xs /= [] && all isChar xs = Just $ Lit an $ String an s (show s)- where s = map fromChar xs+useString b (List _ xs) | xs /= [], Just s <- mapM fromChar xs = Just $ Lit an $ String an s (show s) useString b _ = Nothing useList b = fmap (List an) . f True
src/Hint/Pragma.hs view
@@ -46,12 +46,12 @@ languageDupes :: [ModulePragma S] -> [Idea]-languageDupes [] = [] languageDupes (a@(LanguagePragma _ x):xs) = (if nub_ x `neqList` x then [pragmaIdea [a] [LanguagePragma an $ nub_ x]] else [pragmaIdea [a,b] [LanguagePragma an (nub_ $ x ++ y)] | b@(LanguagePragma _ y) <- xs, notNull $ intersect_ x y]) ++ languageDupes xs+languageDupes _ = [] -- Given a pragma, can you extract some language features out
+ src/HsColour.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE CPP #-}+module HsColour(hsColourHTML, hsColourConsole) where++#ifdef GPL_SCARES_ME++hsColourConsole :: IO (String -> String)+hsColourConsole = return id++hsColourHTML :: String -> String+hsColourHTML = id++#else++import Language.Haskell.HsColour.TTY as TTY+import Language.Haskell.HsColour.Colourise+import Language.Haskell.HsColour.CSS as CSS+++hsColourConsole :: IO (String -> String)+hsColourConsole = do+ prefs <- readColourPrefs+ return $ TTY.hscolour prefs++hsColourHTML :: String -> String+hsColourHTML = CSS.hscolour False++#endif
src/Idea.hs view
@@ -5,8 +5,7 @@ import Data.List import HSE.All import Settings-import Language.Haskell.HsColour.TTY-import Language.Haskell.HsColour.Colourise+import HsColour import Util @@ -51,8 +50,8 @@ showANSI :: IO (Idea -> String) showANSI = do- prefs <- readColourPrefs- return $ showEx (hscolour prefs)+ f <- hsColourConsole+ return $ showEx f showEx :: (String -> String) -> Idea -> String showEx tt Idea{..} = unlines $
src/Report.hs view
@@ -10,7 +10,7 @@ import System.FilePath import HSE.All import Paths_hlint-import Language.Haskell.HsColour.CSS+import HsColour writeTemplate :: FilePath -> [(String,[String])] -> FilePath -> IO ()@@ -45,20 +45,17 @@ where id = mode ++ show i -code = hscolour False-- writeIdea :: String -> Idea -> [String] writeIdea cls Idea{..} = ["<div class=" ++ show cls ++ ">" ,escapeHTML (showSrcLoc (getPointLoc ideaSpan) ++ ": " ++ show ideaSeverity ++ ": " ++ ideaHint) ++ "<br/>" ,"Found<br/>"- ,code ideaFrom] +++ ,hsColourHTML ideaFrom] ++ (case ideaTo of Nothing -> [] Just to -> ["Why not" ++ (if to == "" then " remove it." else "") ++ "<br/>"- ,code to]) +++ ,hsColourHTML to]) ++ [let n = showNotes ideaNote in if n /= "" then "<span class='note'>Note: " ++ n ++ "</span>" else "" ,"</div>" ,""]
src/Settings.hs view
@@ -199,14 +199,13 @@ g x = case fromApps x of [con -> Just "IncreasesLaziness"] -> [IncreasesLaziness] [con -> Just "DecreasesLaziness"] -> [DecreasesLaziness]- [con -> Just "RemovesError",str -> Just a] -> [RemovesError a]- [con -> Just "ValidInstance",str -> Just a,var -> Just b] -> [ValidInstance a b]+ [con -> Just "RemovesError",fromString -> Just a] -> [RemovesError a]+ [con -> Just "ValidInstance",fromString -> Just a,var -> Just b] -> [ValidInstance a b] _ -> errorOn x "bad note" con :: Exp_ -> Maybe String con c@Con{} = Just $ prettyPrint c; con _ = Nothing var c@Var{} = Just $ prettyPrint c; var _ = Nothing- str c = if isString c then Just $ fromString c else Nothing -- Note: Foo may be ("","Foo") or ("Foo",""), return both@@ -221,7 +220,7 @@ getNames :: [Pat_] -> Exp_ -> [String]-getNames ps _ | ps /= [] && all isPString ps = map fromPString ps+getNames ps _ | ps /= [], Just ps <- mapM fromPString ps = ps getNames [] (InfixApp _ lhs op rhs) | opExp op ~= "==>" = map ("Use "++) names where lnames = map f $ childrenS lhs
src/Test/All.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE PatternGuards, ScopedTypeVariables, RecordWildCards, ViewPatterns #-}+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} module Test.All(test) where
src/Util.hs view
@@ -229,8 +229,8 @@ \(file,h) -> hClose h >> act file withTemporaryFiles :: String -> Int -> ([FilePath] -> IO a) -> IO a-withTemporaryFiles pat 0 act = act []-withTemporaryFiles pat i act | i > 0 =+withTemporaryFiles pat i act | i <= 0 = act []+withTemporaryFiles pat i act = withTemporaryFile pat $ \file -> withTemporaryFiles pat (i-1) $ \files -> act $ file : files