hlint 1.9.12 → 1.9.13

raw patch · 13 files changed

+206/−65 lines, 13 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGES.txt +5/−0
• README.md +1/−1
• data/HLint_QuickCheck.hs +12/−11
• hlint.cabal +2/−1
• src/CmdLine.hs +3/−1
• src/HSE/All.hs +4/−3
• src/Hint/All.hs +47/−24
• src/Language/Haskell/HLint.hs +4/−3
• src/Language/Haskell/HLint2.hs +6/−8
• src/Language/Haskell/HLint3.hs +108/−0
• src/Settings.hs +4/−4
• src/Test/All.hs +2/−2
• src/Test/Translate.hs +8/−7

@@ -1,5 +1,10 @@ Changelog for HLint +1.9.13+    #97, remove the encoding bits of the API+    #98, add an HLint3 prototype API+    #93, make the --quickcheck tests work on GHC 7.8+    Add --tempdir flag to the test mode 1.9.12     #96, fix the --utf8 flag     Make Encoding an alias for TextEncoding

@@ -1,4 +1,4 @@-# HLint [![Hackage version](https://img.shields.io/hackage/v/hlint.svg?style=flat)](http://hackage.haskell.org/package/hlint) [![Build Status](http://img.shields.io/travis/ndmitchell/hlint.svg?style=flat)](https://travis-ci.org/ndmitchell/hlint)+# HLint [![Hackage version](https://img.shields.io/hackage/v/hlint.svg?style=flat)](https://hackage.haskell.org/package/hlint) [![Build Status](https://img.shields.io/travis/ndmitchell/hlint.svg?style=flat)](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. You can try HLint online at [lpaste.net](http://lpaste.net/) - suggestions are shown at the bottom. This document is structured as follows: 

@@ -116,14 +116,15 @@  main :: IO () main = withMain $ do-    test "data\\Default.hs" 144 "findIndex ((==) a) ==> elemIndex a" $-        \ a -> (findIndex ((==) a)) ==> (elemIndex a)-    test "data\\Default.hs" 179 "foldr1 (&&) ==> and" $-        ((foldr1 (&&)) ?==> (and))-    test "data\\Default.hs" 407 "sinh x / cosh x ==> tanh x" $-        \ x -> (sqrt x) ==> (x ** 0.5)-    test "data\\Default.hs" 154 "take i x ==> []" $-        \ (NegZero i) x -> (take i x) ==> ([])-    test "data\\Default.hs" 70 "head (sortBy f x) ==> minimumBy f x" $-        \ (Compare f) x -> (head (sortBy f x)) ==> (minimumBy f x)-    test "data\\Default.hs" 218 "(f $) ==> f" $ \ f -> ((f $)) ==> (f)+    let t = \ a -> (findIndex ((==) a)) ==> (elemIndex a)+        in test "data\\Default.hs" 144 "findIndex ((==) a) ==> elemIndex a" t+    let t = ((foldr1 (&&)) ?==> (and))+        in test "data\\Default.hs" 179 "foldr1 (&&) ==> and" t+    let t = \ x -> (sqrt x) ==> (x ** 0.5)+        in test "data\\Default.hs" 407 "sinh x / cosh x ==> tanh x" t+    let t = \ (NegZero i) x -> (take i x) ==> ([])+        in test "data\\Default.hs" 154 "take i x ==> []" t+    let t = \ (Compare f) x -> (head (sortBy f x)) ==> (minimumBy f x)+        in test "data\\Default.hs" 70 "head (sortBy f x) ==> minimumBy f x" t+    let t = \ f -> ((f $)) ==> (f)+        in test "data\\Default.hs" 218 "(f $) ==> f" t

@@ -1,7 +1,7 @@ cabal-version:      >= 1.6 build-type:         Simple name:               hlint-version:            1.9.12+version:            1.9.13 license:            BSD3 license-file:       LICENSE category:           Development@@ -63,6 +63,7 @@     exposed-modules:         Language.Haskell.HLint         Language.Haskell.HLint2+        Language.Haskell.HLint3     other-modules:         Paths_hlint         Apply

@@ -1,5 +1,5 @@ {-# LANGUAGE PatternGuards, RecordWildCards, DeriveDataTypeable #-}-{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-fields -fno-cse #-}  module CmdLine(Cmd(..), cmdCpp, CppFlags(..), getCmd, cmdExtensions, cmdHintFiles, cmdUseColour, exitWithHelp, resolveFile) where @@ -112,6 +112,7 @@         ,cmdDataDir :: FilePath          -- ^ the data directory         ,cmdReports :: [FilePath]        -- ^ where to generate reports         ,cmdWithHints :: [String]        -- ^ hints that are given on the command line+        ,cmdTempDir :: FilePath          -- ^ temporary directory to put the files in         ,cmdQuickCheck :: Bool         ,cmdTypeCheck :: Bool         }@@ -154,6 +155,7 @@         {cmdProof = nam_ "proof" &= typFile &= help "Isabelle/HOLCF theory file"         ,cmdTypeCheck = nam_ "typecheck" &= help "Use GHC to type check the hints"         ,cmdQuickCheck = nam_ "quickcheck" &= help "Use QuickCheck to check the hints"+        ,cmdTempDir = nam_ "tempdir" &= help "Where to put temporary files (not cleaned up)"         } &= explicit &= name "test"         &= details ["HLint gives hints on how to improve Haskell code."                  ,""

@@ -21,18 +21,19 @@ import Data.Maybe import Language.Preprocessor.Cpphs import qualified Data.Map as Map+import System.IO   -- | Created with 'defaultParseFlags', used by 'parseModuleEx'. data ParseFlags = ParseFlags-    {encoding :: Encoding -- ^ How the file is read in (defaults to 'defaultEncoding').+    {encoding :: TextEncoding -- ^ How the file is read in (defaults to 'utf8').     ,cppFlags :: CppFlags -- ^ How the file is preprocessed (defaults to 'NoCpp').     ,hseFlags :: ParseMode -- ^ How the file is parsed (defaults to all fixities in the @base@ package and most non-conflicting extensions).     } --- | Default values for 'ParseFlags'.+-- | Default value for 'ParseFlags'. defaultParseFlags :: ParseFlags-defaultParseFlags = ParseFlags defaultEncoding NoCpp defaultParseMode{fixities=Just baseFixities, ignoreLinePragmas=False, extensions=defaultExtensions}+defaultParseFlags = ParseFlags utf8 NoCpp defaultParseMode{fixities=Just baseFixities, ignoreLinePragmas=False, extensions=defaultExtensions}  parseFlagsNoLocations :: ParseFlags -> ParseFlags parseFlagsNoLocations x = x{cppFlags = case cppFlags x of Cpphs y -> Cpphs $ f y; y -> y}

@@ -1,10 +1,13 @@  module Hint.All(-    Hint(..), DeclHint, ModuHint,-    builtinHints, hintRules+    Hint(..), HintBuiltin(..), DeclHint, ModuHint,+    resolveHints, hintRules, resolveBuiltin, builtinHints     ) where  import Settings+import Data.Either+import Data.List+import Data.Maybe import Data.Monoid import Hint.Type @@ -23,30 +26,50 @@ import Hint.Comment import Hint.Unsafe +-- | A list of the builtin hints wired into HLint.+--   This list is likely to grow over time.+data HintBuiltin =+    HintList | HintListRec | HintMonad | HintLambda |+    HintBracket | HintNaming | HintStructure | HintImport |+    HintPragma | HintExtensions | HintUnsafe | HintDuplicate |+    HintComment+    deriving (Show,Eq,Ord,Bounded,Enum) --- | A list of builtin hints, currently including entries such as @\"List\"@ and @\"Bracket\"@.-builtinHints :: [(String,Hint)]-builtinHints =-    ["List"       ! listHint-    ,"ListRec"    ! listRecHint-    ,"Monad"      ! monadHint-    ,"Lambda"     ! lambdaHint-    ,"Bracket"    ! bracketHint-    ,"Naming"     ! namingHint-    ,"Structure"  ! structureHint-    ,"Import"     + importHint-    ,"Pragma"     + pragmaHint-    ,"Extensions" + extensionsHint-    ,"Unsafe"     + unsafeHint-    ,"Duplicate"  * duplicateHint-    ,"Comment"    - commentHint-    ]++builtin :: HintBuiltin -> Hint+builtin x = case x of+    HintList       -> decl listHint+    HintListRec   -> decl listRecHint+    HintMonad      -> decl monadHint+    HintLambda     -> decl lambdaHint+    HintBracket    -> decl bracketHint+    HintNaming     -> decl namingHint+    HintStructure  -> decl structureHint+    HintImport     -> modu importHint+    HintPragma     -> modu pragmaHint+    HintExtensions -> modu extensionsHint+    HintUnsafe     -> modu unsafeHint+    HintDuplicate  -> mods duplicateHint+    HintComment    -> comm commentHint     where-        x!y = (x,mempty{hintDecl=y})-        x+y = (x,mempty{hintModule=y})-        x*y = (x,mempty{hintModules=y})-        x-y = (x,mempty{hintComment=y})+        decl x = mempty{hintDecl=x}+        modu x = mempty{hintModule=x}+        mods x = mempty{hintModules=x}+        comm x = mempty{hintComment=x} ++-- | A list of builtin hints, currently including entries such as @\"List\"@ and @\"Bracket\"@.+builtinHints :: [(String, Hint)]+builtinHints = [(drop 4 $ show h, resolveHints [Left h]) | h <- [minBound .. maxBound]]+ -- | Transform a list of 'HintRule' into a 'Hint'.+resolveHints :: [Either HintBuiltin HintRule] -> Hint+resolveHints xs = mconcat $ mempty{hintDecl=readMatch rights} : map builtin (nub lefts)+    where (lefts,rights) = partitionEithers xs++resolveBuiltin :: [String] -> [Hint]+resolveBuiltin builtin = map f $ nub $ concat [if x == "All" then map fst builtinHints else [x] | x <- builtin]+    where f x = fromMaybe (error $ "Unknown builtin hints: HLint.Builtin." ++ x) $ lookup x builtinHints+ hintRules :: [HintRule] -> Hint-hintRules xs = mempty{hintDecl=readMatch xs}+hintRules = resolveHints . map Right

@@ -1,7 +1,8 @@ {-|-This module provides a library interface to HLint. The current-interface is strongly modelled on the command line interface,-and is expected to evolve.+/WARNING: This module represents the old version of the HLint API./+/It will be deleted in favour of "Language.Haskell.HLint3" in the next major version./++This module provides a library interface to HLint, strongly modelled on the command line interface. -}  module Language.Haskell.HLint(module HLint) where

@@ -1,6 +1,6 @@  -- | /WARNING: This module represents the evolving second version of the HLint API./---   /It will be renamed to drop the "2" in the next major version./+--   /It will be deleted in favour of "Language.Haskell.HLint3" in the next major version./ -- --   This module provides a way to apply HLint hints. As an example of approximating the @hlint@ experience: --@@ -16,7 +16,7 @@     -- * Settings     Classify(..),     getHLintDataDir,-    autoSettings, findSettings, readSettings,+    autoSettings, autoSettings', findSettings, readSettings,     -- * Hints     Hint(..), builtinHints,     HintRule(..), hintRules,@@ -40,7 +40,6 @@ import Control.Applicative import Data.Tuple.Extra import Data.List.Extra-import Data.Maybe import Data.Monoid import System.FilePath @@ -61,16 +60,15 @@ -- -- 1. Take all fixities from the 'findSettings' modules and put them in the 'ParseFlags'. autoSettings :: IO (ParseFlags, [Classify], Hint)-autoSettings = do-    dataDir <- getHLintDataDir+autoSettings = getHLintDataDir >>= autoSettings'++autoSettings' :: FilePath -> IO (ParseFlags, [Classify], Hint)+autoSettings' dataDir = do     (builtin, matches) <- first resolveBuiltin <$> findSettings dataDir (dataDir </> "HLint.hs") Nothing     let (classify, rules) = second hintRules $ concatUnzip $ map readSettings matches     let fixities = getFixity =<< moduleDecls =<< matches     return (parseFlagsAddFixities fixities defaultParseFlags, classify, mconcat $ rules : builtin) -resolveBuiltin :: [String] -> [Hint]-resolveBuiltin builtin = map f $ nub $ concat [if x == "All" then map fst builtinHints else [x] | x <- builtin]-    where f x = fromMaybe (error $ "Unknown builtin hints: HLint.Builtin." ++ x) $ lookup x builtinHints  -- | Snippet from the documentation, if this changes, update the documentation _docs :: IO ()

@@ -0,0 +1,108 @@+{-# LANGUAGE TupleSections, PatternGuards #-}++-- | /WARNING: This module represents the evolving second version of the HLint API./+--   /It will be renamed to drop the "3" in the next major version./+--+--   This module provides a way to apply HLint hints. As an example of approximating the @hlint@ experience:+--+-- @+-- (flags, classify, hint) <- 'autoSettings'+-- Right m <- 'parseModuleEx' flags \"MyFile.hs\" Nothing+-- print $ 'applyHints' classify hint [m]+-- @+module Language.Haskell.HLint3(+    applyHints,+    -- * Idea data type+    Idea(..), Severity(..), Note(..),+    -- * Settings+    Classify(..),+    getHLintDataDir, autoSettings,+    findSettings, readSettingsFile,+    -- * Hints+    HintBuiltin(..), HintRule(..),+    Hint(..), resolveHints,+    -- * Scopes+    Scope, scopeCreate, scopeMatch, scopeMove,+    -- * Haskell-src-exts+    parseModuleEx, defaultParseFlags, parseFlagsAddFixities, ParseError(..), ParseFlags(..), CppFlags(..)+    ) where++import Settings hiding (findSettings)+import Idea+import Apply+import Hint.Type+import Hint.All+import CmdLine+import Paths_hlint++import Data.List.Extra+import Data.Maybe+import System.FilePath+++-- | Get the Cabal configured data directory of HLint.+getHLintDataDir :: IO FilePath+getHLintDataDir = getDataDir+++-- | The function produces a tuple containg 'ParseFlags' (for 'parseModuleEx'),+--   and 'Classify' and 'Hint' for 'applyHints'.+--   It approximates the normal HLint configuration steps, roughly:+--+-- 1. Use 'findSettings' with 'readSettingsFile' to find and load the HLint settings files.+--+-- 1. Use 'parseFlagsAddFixities' and 'resolveHints' to transform the outputs of 'findSettings'.+--+--   If you want to do anything custom (e.g. using a different data directory, storing intermediate outputs,+--   loading hints from a database) you are expected to copy and paste this function, then change it to your needs.+autoSettings :: IO (ParseFlags, [Classify], Hint)+autoSettings = do+    (fixities, classify, hints) <- findSettings (readSettingsFile Nothing) Nothing+    return (parseFlagsAddFixities fixities defaultParseFlags, classify, resolveHints hints)+++-- | Given a directory (or 'Nothing' to imply 'getHLintDataDir'), and a mdoule name+--   (e.g. @HLint.Default@), find the settings file associated with it, returning the+--   name of the file, and (optionally) the contents.+--+--   This function looks for all settings files starting with @HLint.@ in the directory+--   argument, and all other files relative to the current directory.+readSettingsFile :: Maybe FilePath -> String -> IO (FilePath, Maybe String)+readSettingsFile dir x+    | Just x <- "HLint." `stripPrefix` x = do+        dir <- maybe getHLintDataDir return dir+        return (dir </> x <.> "hs", Nothing)+    | otherwise = return (x <.> "hs", Nothing)+++-- | Given a function to load a module (typically 'readSettingsFile'), and a module to start from+--   (defaults to @HLint.HLint@) find the information from all settings files.+findSettings :: (String -> IO (FilePath, Maybe String)) -> Maybe String -> IO ([Fixity], [Classify], [Either HintBuiltin HintRule])+findSettings load start = do+    (file,contents) <- load $ fromMaybe "HLint.HLint" start+    let flags = addInfix defaultParseFlags+    res <- parseModuleEx flags file contents+    case res of+        Left (ParseError sl msg err) ->+            error $ "Settings parse failure at " ++ showSrcLoc sl ++ ": " ++ msg ++ "\n" ++ err+        Right (m, _) -> do+            imported <- sequence [f $ fromNamed $ importModule i | i <- moduleImports m, importPkg i `elem` [Just "hint", Just "hlint"]]+            let (classify, rules) = Settings.readSettings m+            let fixities = getFixity =<< moduleDecls m+            return $ concatUnzip3 $ (fixities,classify,map Right rules) : imported+    where+        builtins =  [(drop 4 $ show h, h :: HintBuiltin) | h <- [minBound .. maxBound]]++        f x | x == "HLint.Builtin.All" = return ([], [], map Left [minBound..maxBound])+        f x | Just x <- "HLint.Builtin." `stripPrefix` x = case lookup x builtins of+                Just x -> return ([], [], [Left x])+                Nothing -> error $ "Unknown builtin hints: HLint.Builtin." ++ x+            | otherwise = findSettings load (Just x)+++-- | Snippet from the documentation, if this changes, update the documentation+_docs :: IO ()+_docs = do+    (flags, classify, hint) <- autoSettings+    Right m <- parseModuleEx flags "MyFile.hs" Nothing+    print $ applyHints classify hint [m]

@@ -4,7 +4,7 @@     Severity(..), Classify(..), HintRule(..), Note(..), showNotes, Setting(..),     defaultHintName, isUnifyVar,     findSettings, readSettings,-    readSettings2, readPragma, findSettings2+    readSettings2, readPragma, findSettings2, addInfix     ) where  import HSE.All@@ -75,9 +75,9 @@ -- | How to classify an 'Idea'. If any matching field is @\"\"@ then it matches everything. data Classify = Classify     {classifySeverity :: Severity -- ^ Severity to set the 'Idea' to.-    ,classifyHint :: String -- ^ 'ideaHint'.-    ,classifyModule :: String -- ^ 'ideaModule'.-    ,classifyDecl :: String -- ^ 'ideaDecl'.+    ,classifyHint :: String -- ^ Match on 'Idea' field 'ideaHint'.+    ,classifyModule :: String -- ^ Match on 'Idea' field 'ideaModule'.+    ,classifyDecl :: String -- ^ Match on 'Idea' field 'ideaDecl'.     }     deriving Show 

@@ -37,9 +37,9 @@     wrap "Hint names" $ mapM_ (\x -> do progress; testNames $ snd x) testFiles     wrap "Hint annotations" $ forM_ testFiles $ \(file,h) -> do progress; testAnnotations h file     when cmdTypeCheck $ wrap "Hint typechecking" $-        progress >> testTypeCheck [h | (file, h) <- testFiles, takeFileName file /= "Test.hs"]+        progress >> testTypeCheck cmdTempDir [h | (file, h) <- testFiles, takeFileName file /= "Test.hs"]     when cmdQuickCheck $ wrap "Hint QuickChecking" $-        progress >> testQuickCheck [h | (file, h) <- testFiles, takeFileName file /= "Test.hs"]+        progress >> testQuickCheck cmdTempDir [h | (file, h) <- testFiles, takeFileName file /= "Test.hs"]      when (null files && not hasSrc) $ putStrLn "Warning, couldn't find source code, so non-hint tests skipped" 

@@ -17,8 +17,8 @@ import Test.Util  -runMains :: [String] -> IO ()-runMains xs = withTempDir $ \dir -> do+runMains :: FilePath -> [String] -> IO ()+runMains tmpdir xs = (if tmpdir == "" then withTempDir else ($ tmpdir)) $ \dir -> do     ms <- forM (zip [1..] xs) $ \(i,x) -> do         let m = "I" ++ show i         writeFile (dir </> m <.> "hs") $ replace "module Main" ("module " ++ m) x@@ -33,15 +33,15 @@   -- | Given a set of hints, do all the HintRule hints type check-testTypeCheck :: [[Setting]] -> IO ()+testTypeCheck :: FilePath -> [[Setting]] -> IO () testTypeCheck = wrap toTypeCheck  -- | Given a set of hints, do all the HintRule hints satisfy QuickCheck-testQuickCheck :: [[Setting]] -> IO ()+testQuickCheck :: FilePath -> [[Setting]] -> IO () testQuickCheck = wrap toQuickCheck -wrap :: ([HintRule] -> [String]) -> [[Setting]] -> IO ()-wrap f hints = runMains [unlines $ body [x | SettingMatchExp x <- xs] | xs <- hints]+wrap :: ([HintRule] -> [String]) -> FilePath -> [[Setting]] -> IO ()+wrap f tmpdir hints = runMains tmpdir [unlines $ body [x | SettingMatchExp x <- xs] | xs <- hints]     where         body xs =             ["{-# LANGUAGE NoMonomorphismRestriction, ExtendedDefaultRules, ScopedTypeVariables, DeriveDataTypeable #-}"@@ -86,8 +86,9 @@         a $$ b = InfixApp an a (toNamed "$") b         tests =             [ Qualifier an $+                Let an (BDecls an [PatBind an (toNamed "t") (UnGuardedRhs an bod) Nothing]) $                 (toNamed "test" `app` str (fileName $ ann rhs) `app` int (startLine $ ann rhs) `app`-                 str (prettyPrint lhs ++ " ==> " ++ prettyPrint rhs)) $$ bod+                 str (prettyPrint lhs ++ " ==> " ++ prettyPrint rhs)) `app` (toNamed "t")             | (i, HintRule _ _ _ lhs rhs side note) <- zip [1..] hints, "noQuickCheck" `notElem` vars (maybeToList side)             , let vs = map (restrict side) $ nub $ filter isUnifyVar $ vars lhs ++ vars rhs             , let op = if any isRemovesError note then "?==>" else "==>"