hlint 1.8.5 → 1.8.6

raw patch · 9 files changed

+47/−38 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• hlint.cabal +1/−1
• src/Apply.hs +5/−5
• src/HLint.hs +7/−2
• src/Hint/ListRec.hs +3/−3
• src/Hint/Match.hs +1/−1
• src/Idea.hs +5/−5
• src/Report.hs +3/−3
• src/Settings.hs +21/−17
• src/Test.hs +1/−1

@@ -1,7 +1,7 @@ cabal-version:      >= 1.6 build-type:         Simple name:               hlint-version:            1.8.5+version:            1.8.6 -- license is GPL v2 only license:            GPL license-file:       LICENSE

@@ -62,12 +62,12 @@   classify :: [Setting] -> Idea -> Idea-classify xs i = i{rank = foldl' (rerank i) (rank i) $ filter isClassify xs}+classify xs i = i{severity = foldl' (f i) (severity 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-                     | otherwise = r+        -- figure out if we need to change the severity+        f :: Idea -> Severity -> Setting -> Severity+        f i r c | matchHint (hintS c) (hint i) && matchFunc (funcS c) (func_ i) = severityS c+                | otherwise = r          func_ x = if isParseError x then ("","") else func x         matchHint = (~=)

@@ -1,6 +1,6 @@ {-# LANGUAGE RecordWildCards #-} -module HLint(hlint, Suggestion, suggestionLocation) where+module HLint(hlint, Suggestion, suggestionLocation, suggestionSeverity, Severity(..)) where  import Control.Monad import Data.List@@ -28,7 +28,12 @@ suggestionLocation = loc . fromSuggestion  +-- | From a suggestion, determine how severe it is.+suggestionSeverity :: Suggestion -> Severity+suggestionSeverity = severity . fromSuggestion ++ -- | This function takes a list of command line arguments, and returns the given suggestions. --   To see a list of arguments type @hlint --help@ at the console. --   This function writes to the stdout/stderr streams, unless @--quiet@ is specified.@@ -60,7 +65,7 @@     let settings = settings1 ++ settings2 ++ settings3      ideas <- fmap concat $ parallel [listM' =<< applyHint flags settings x | x <- cmdFiles]-    let (showideas,hideideas) = partition (\i -> cmdShowAll || rank i /= Ignore) ideas+    let (showideas,hideideas) = partition (\i -> cmdShowAll || severity i /= Ignore) ideas     showItem <- if cmdColor then showANSI else return show     mapM_ (outStrLn . showItem) showideas 

@@ -44,10 +44,10 @@         f o = maybeToList $ do             let x = o             (x, addCase) <- findCase x-            (use,rank,x) <- matchListRec x+            (use,severity,x) <- matchListRec x             let y = addCase x             guard $ recursiveStr `notElem` vars y-            return $ idea rank ("Use " ++ use) o y+            return $ idea severity ("Use " ++ use) o y   recursiveStr = "_recursive_"@@ -73,7 +73,7 @@ -- MATCH THE RECURSION  -matchListRec :: ListCase -> Maybe (String,Rank,Exp_)+matchListRec :: ListCase -> Maybe (String,Severity,Exp_) matchListRec o@(ListCase vs nil (x,xs,cons))          | [] <- vs, nil ~= "[]", InfixApp _ lhs c rhs <- cons, opExp c ~= ":"

@@ -77,7 +77,7 @@  findIdeas :: [Setting] -> Scope -> Module S -> Decl_ -> [Idea] findIdeas matches s _ decl =-  [ idea (rankS m) (hintS m) x y+  [ idea (severityS m) (hintS m) x y   | (parent,x) <- universeParentExp decl, not $ isParen x, let x2 = fmapAn x   , m <- matches, Just y <- [matchIdea s decl m parent x2]] 

@@ -1,6 +1,6 @@ {-# LANGUAGE RecordWildCards, NoMonomorphismRestriction #-} -module Idea(module Idea, Rank(..)) where+module Idea(module Idea, Severity(..)) where  import HSE.All import Settings@@ -10,8 +10,8 @@   data Idea-    = Idea {func :: FuncName, rank :: Rank, hint :: String, loc :: SrcLoc, from :: String, to :: String}-    | ParseError {rank :: Rank, hint :: String, loc :: SrcLoc, msg :: String, from :: String}+    = Idea {func :: FuncName, severity :: Severity, hint :: String, loc :: SrcLoc, from :: String, to :: String}+    | ParseError {severity :: Severity, hint :: String, loc :: SrcLoc, msg :: String, from :: String}       deriving (Eq,Ord)  @@ -29,7 +29,7 @@  showEx :: (String -> String) -> Idea -> String showEx tt Idea{..} = unlines $-    [showSrcLoc loc ++ " " ++ show rank ++ ": " ++ hint] ++ f "Found" from ++ f "Why not" to+    [showSrcLoc loc ++ " " ++ show severity ++ ": " ++ hint] ++ f "Found" from ++ f "Why not" to     where f msg x = (msg ++ ":") : map ("  "++) (lines $ tt x)  showEx tt ParseError{..} = unlines $@@ -37,7 +37,7 @@   rawIdea = Idea ("","")-idea rank hint from to = rawIdea rank hint (toSrcLoc $ ann from) (f from) (f to)+idea severity hint from to = rawIdea severity hint (toSrcLoc $ ann from) (f from) (f to)     where f = ltrim . prettyPrint warn = idea Warning err = idea Error

@@ -29,7 +29,7 @@         generateIds = map (head &&& length) . group . sort         files = generateIds $ map (srcFilename . loc) ideas         hints = generateIds $ map hintName ideas-        hintName x = show (rank x) ++ ": " ++ hint x+        hintName x = show (severity x) ++ ": " ++ hint x          inner = [("VERSION",['v' : showVersion version]),("CONTENT",content),                  ("HINTS",list "hint" hints),("FILES",list "file" files)]@@ -51,7 +51,7 @@ writeIdea :: String -> Idea -> [String] writeIdea cls Idea{..} =     ["<div class=" ++ show cls ++ ">"-    ,escapeHTML (showSrcLoc loc ++ " " ++ show rank ++ ": " ++ hint) ++ "<br/>"+    ,escapeHTML (showSrcLoc loc ++ " " ++ show severity ++ ": " ++ hint) ++ "<br/>"     ,"Found<br/>"     ,code from     ,"Why not<br/>"@@ -62,7 +62,7 @@  writeIdea cls ParseError{..} =     ["<div class=" ++ show cls ++ ">"-    ,escapeHTML (showSrcLoc loc ++ " " ++ show rank ++ ": " ++ hint) ++ "<br/>"+    ,escapeHTML (showSrcLoc loc ++ " " ++ show severity ++ ": " ++ hint) ++ "<br/>"     ,"Error message<br/>"     ,"<pre>" ++ escapeHTML msg ++ "</pre>"     ,"Code<br/>"

@@ -1,7 +1,7 @@ {-# LANGUAGE PatternGuards, ViewPatterns #-}  module Settings(-    Rank(..), FuncName, Setting(..), isClassify, isMatchExp,+    Severity(..), FuncName, Setting(..), isClassify, isMatchExp,     defaultHintName, isUnifyVar,     readSettings, readPragma, findSettings     ) where@@ -16,15 +16,19 @@ defaultHintName = "Use alternative"  -data Rank = Ignore | Warning | Error-            deriving (Eq,Ord,Show)+-- | How severe an error is.+data Severity+    = Ignore -- ^ Ignored errors are only returned when @--show@ is passed.+    | Warning -- ^ Warnings are things that some people may consider improvements, but some may not.+    | Error -- ^ Errors are suggestions that should nearly always be a good idea to apply.+      deriving (Eq,Ord,Show,Read,Bounded,Enum) -getRank :: String -> Maybe Rank-getRank "ignore" = Just Ignore-getRank "warn" = Just Warning-getRank "warning" = Just Warning-getRank "error"  = Just Error-getRank _ = Nothing+getSeverity :: String -> Maybe Severity+getSeverity "ignore" = Just Ignore+getSeverity "warn" = Just Warning+getSeverity "warning" = Just Warning+getSeverity "error"  = Just Error+getSeverity _ = Nothing   -- (modulename,functionname)@@ -45,8 +49,8 @@ -- TYPE  data Setting-    = Classify {rankS :: Rank, hintS :: String, funcS :: FuncName}-    | MatchExp {rankS :: Rank, hintS :: String, scope :: Scope, lhs :: Exp_, rhs :: Exp_, side :: Maybe Exp_}+    = Classify {severityS :: Severity, hintS :: String, funcS :: FuncName}+    | MatchExp {severityS :: Severity, hintS :: String, scope :: Scope, lhs :: Exp_, rhs :: Exp_, side :: Maybe Exp_}     | Builtin String -- use a builtin hint set     | Infix Fixity       deriving Show@@ -71,7 +75,7 @@ readHints :: FilePath -> FilePath -> IO [Either String Module_] readHints dataDir file = do     y <- parseResult $ parseFile (addInfix parseFlags) file-    ys <- concatM [f $ fromNamed $ importModule i | i <- moduleImports y, importPkg i == Just "hint"]+    ys <- concatM [f $ fromNamed $ importModule i | i <- moduleImports y, importPkg i `elem` [Just "hint", Just "hlint"]]     return $ Right y:ys     where         f x | "HLint.Builtin." `isPrefixOf` x = return [Left $ drop 14 x]@@ -80,10 +84,10 @@   readSetting :: Scope -> Decl_ -> [Setting]-readSetting s (FunBind _ [Match _ (Ident _ (getRank -> Just rank)) pats (UnGuardedRhs _ bod) bind])+readSetting s (FunBind _ [Match _ (Ident _ (getSeverity -> Just severity)) pats (UnGuardedRhs _ bod) bind])     | InfixApp _ lhs op rhs <- bod, opExp op ~= "==>" =-        [MatchExp rank (if null names then defaultHintName else head names) s (fromParen lhs) (fromParen rhs) (readSide $ childrenBi bind)]-    | otherwise = [Classify rank n func | n <- names2, func <- readFuncs bod]+        [MatchExp severity (if null names then defaultHintName else head names) s (fromParen lhs) (fromParen rhs) (readSide $ childrenBi bind)]+    | otherwise = [Classify severity n func | n <- names2, func <- readFuncs bod]     where         names = filter notNull $ getNames pats bod         names2 = ["" | null names] ++ names@@ -105,9 +109,9 @@         f (ModuleAnn _ x) = g "" x          g name (Lit _ (String _ s _)) | "hlint:" `isPrefixOf` map toLower s =-                case getRank a of+                case getSeverity a of                     Nothing -> errorOn o "bad classify pragma"-                    Just rank -> Just $ Classify rank (ltrim b) ("",name)+                    Just severity -> Just $ Classify severity (ltrim b) ("",name)             where (a,b) = break isSpace $ ltrim $ drop 6 s readPragma _ = Nothing 

@@ -154,7 +154,7 @@                 | not good]          match "???" _ = True-        match x y | "@" `isPrefixOf` x = a == show (rank y) && match (ltrim b) y+        match x y | "@" `isPrefixOf` x = a == show (severity y) && match (ltrim b) y             where (a,b) = break isSpace $ tail x         match x y = on (==) norm (to y) x