packages feed

hlint 1.8.57 → 1.8.58

raw patch · 12 files changed

+243/−234 lines, 12 filesdep +cmdargsdep ~cpphs

Dependencies added: cmdargs

Dependency ranges changed: cpphs

Files

CHANGES.txt view
@@ -1,5 +1,14 @@ Changelog for HLint +1.8.58+    Move the API to Language.Haskell.HLint2+    #638, ensure $! doesn't break strictness with strict fields+    #24, don't remove DeriveFunctor even when only on a newtype+    #22, turn off UnboxedTuples by default+    #21, strip /* C style */ comments+    #635 and #18, require cpphs-1.18.1+    Switch to CmdArgs for command line parsing+    Remove -x as a synonym for --cross 1.8.57     #6, add a preview of an API     #331, improve parse error locations for literate Haskell
README.md view
@@ -8,7 +8,7 @@  ### Acknowledgements -This program has only been made possible by the presence of the [haskell-src-exts](http://www.cs.chalmers.se/~d00nibro/haskell-src-exts/) package, and many improvements have been made by [Niklas Broberg](http://www.cs.chalmers.se/~d00nibro/) 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.+This program has only been made possible by the presence of the [haskell-src-exts](http://www.cs.chalmers.se/~d00nibro/haskell-src-exts/) package, and many improvements have been made by [Niklas Broberg](http://www.cs.chalmers.se/~d00nibro/) 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, Johannes Lippmann and others.  ### Bugs and limitations
data/Default.hs view
@@ -583,7 +583,13 @@ test = food id xs yes = baz baz >> return () -- Control.Monad.void (baz baz) no = foo >>= bar >>= something >>= elsee >> return ()-+no = f (#) x+data Pair = P {a :: !Int}; foo = return $! P{a=undefined}+data Pair = P {a :: !Int}; foo = return $! P undefined+foo = return $! Just undefined -- return (Just undefined)+foo = return $! (a,b) -- return (a,b)+foo = return $! 1+foo = return $! "test"  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.57+version:            1.8.58 license:            BSD3 license-file:       LICENSE category:           Development@@ -41,14 +41,15 @@         base == 4.*, process, filepath, directory, containers,         transformers >= 0.0,         hscolour >= 1.17,-        cpphs >= 1.11,+        cpphs >= 1.18.1,+        cmdargs >= 0.10,         haskell-src-exts >= 1.14 && < 1.15,         uniplate >= 1.5      hs-source-dirs:     src     exposed-modules:-        Temporary.API         Language.Haskell.HLint+        Language.Haskell.HLint2     other-modules:         Paths_hlint         Apply
src/CmdLine.hs view
@@ -1,24 +1,38 @@-{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE PatternGuards, RecordWildCards, DeriveDataTypeable #-} -module CmdLine(Cmd(..), CppFlags(..), getCmd, exitWithHelp) where+module CmdLine(Cmd(..), cmdCpp, CppFlags(..), getCmd, cmdExtensions, cmdHintFiles, exitWithHelp, resolveFile) where -import Control.Applicative-import Control.Monad import Data.Char import Data.List-import Data.Maybe-import System.Console.GetOpt+import System.Console.CmdArgs.Implicit import System.Directory import System.Exit import System.FilePath import Language.Preprocessor.Cpphs import Language.Haskell.Exts.Extension+import System.Environment  import Util import Paths_hlint import Data.Version +getCmd :: [String] -> IO Cmd+getCmd args = withArgs args $ automatic =<< cmdArgsRun mode ++automatic :: Cmd -> IO Cmd+automatic Cmd{..} = do+    cmdDataDir <- if cmdDataDir == "" then getDataDir else return cmdDataDir+    cmdPath <- return $ if null cmdPath then ["."] else cmdPath+    return Cmd{..}+++exitWithHelp :: IO a+exitWithHelp = do+    putStr $ show mode+    exitSuccess++ -- | What C pre processor should be used. data CppFlags     = NoCpp -- ^ No pre processing is done.@@ -26,164 +40,86 @@     | Cpphs CpphsOptions -- ^ The @cpphs@ library is used.  --- FIXME: Hints vs GivenHints is horrible data Cmd = Cmd-    {cmdTest :: Bool                 -- ^ run in test mode?-    ,cmdFiles :: Maybe [FilePath]    -- ^ which files to run it on, nothing = none given-    ,cmdHintFiles :: [FilePath]      -- ^ which settingsfiles to use+    {cmdFiles :: [FilePath]    -- ^ which files to run it on, nothing = none given+    ,cmdReports :: [FilePath]        -- ^ where to generate reports     ,cmdGivenHints :: [FilePath]     -- ^ which settignsfiles were explicitly given     ,cmdWithHints :: [String]        -- ^ hints that are given on the command line-    ,cmdReports :: [FilePath]        -- ^ where to generate reports+    ,cmdColor :: Bool                -- ^ color the result     ,cmdIgnore :: [String]           -- ^ the hints to ignore     ,cmdShowAll :: Bool              -- ^ display all skipped items-    ,cmdColor :: Bool                -- ^ color the result-    ,cmdCpp :: CppFlags              -- ^ options for CPP-    ,cmdDataDir :: FilePath          -- ^ the data directory-    ,cmdEncoding :: Encoding         -- ^ the text encoding-    ,cmdFindHints :: [FilePath]      -- ^ source files to look for hints in-    ,cmdLanguage :: [Extension]      -- ^ the extensions (may be prefixed by "No")-    ,cmdQuiet :: Bool                -- ^ supress all console output+    ,cmdExtension :: [String]        -- ^ extensions+    ,cmdLanguage :: [String]      -- ^ the extensions (may be prefixed by "No")+    ,cmdUtf8 :: Bool+    ,cmdEncoding :: String         -- ^ the text encoding     ,cmdCross :: Bool                -- ^ work between source files, applies to hints such as duplicate code between modules+    ,cmdFindHints :: [FilePath]      -- ^ source files to look for hints in+    ,cmdTest :: Bool                 -- ^ run in test mode?+    ,cmdDataDir :: FilePath          -- ^ the data directory+    ,cmdPath :: [String]     ,cmdProof :: [FilePath]          -- ^ a proof script to check against-    }-+    ,cmdCppDefine :: [String]+    ,cmdCppInclude :: [FilePath]+    ,cmdCppSimple :: Bool+    ,cmdCppAnsi :: Bool+    } deriving (Data,Typeable,Show) -data Opts = Help-          | Ver-          | Test-          | Hints FilePath-          | WithHint String-          | Path FilePath-          | Report FilePath-          | Skip String-          | ShowAll-          | Color-          | Define String-          | Include String-          | SimpleCpp-          | Ext String-          | DataDir String-          | Encoding String-          | FindHints FilePath-          | Language String-          | Proof FilePath-          | Quiet-          | Cross-          | Ansi-            deriving Eq+mode = cmdArgsMode $ Cmd+    {cmdFiles = def &= args &= typ "FILE/DIR"+    ,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"+    ,cmdColor = nam "colour" &= name "color" &= help "Color output (requires ANSI terminal)"+    ,cmdIgnore = nam "ignore" &= typ "HINT" &= help "Ignore a particular hint"+    ,cmdShowAll = nam "show" &= help "Show all ignored ideas"+    ,cmdExtension = nam "extension" &= typ "EXT" &= help "File extensions to search (default hs/lhs)"+    ,cmdLanguage = nam_ "language" &= name "X" &= typ "EXTENSION" &= help "Language extensions (Arrows, NoCPP)"+    ,cmdUtf8 = nam "utf8" &= help "Use UTF-8 text encoding"+    ,cmdEncoding = nam_ "encoding" &= typ "ENCODING" &= help "Choose the text encoding"+    ,cmdCross = nam_ "cross" &= help "Work between modules"+    ,cmdFindHints = nam "find" &= typFile &= help "Find hints in a Haskell file"+    ,cmdTest = nam "test" &= help "Run in test mode"+    ,cmdDataDir = nam "datadir" &= typDir &= help "Override the data directory"+    ,cmdPath = nam "path" &= help "Directory in which to search for files"+    ,cmdProof = nam_ "proof" &= typFile &= help "Isabelle/HOLCF theory file"+    ,cmdCppDefine = nam_ "cpp-define" &= typ "NAME[=VALUE]" &= help "CPP #define"+    ,cmdCppInclude = nam_ "cpp-include" &= typDir &= help "CPP include path"+    ,cmdCppSimple = nam_ "cpp-simple" &= help "Use a simple CPP (strip # lines)"+    ,cmdCppAnsi = nam_ "cpp-ansi" &= help "Use CPP in ANSI compatibility mode"+    } &= explicit &= name "hlint" &= program "hlint"+    &= summary ("HLint v" ++ showVersion version ++ ", (C) Neil Mitchell 2006-2014")+    &= details ["HLint gives hints on how to improve Haskell code."+             ,""+             ,"To check all Haskell files in 'src' and generate a report type:"+             ,"  hlint src --report"]+    where+        nam xs@(x:_) = nam_ xs &= name [x]+        nam_ xs = def &= explicit &= name xs +cmdHintFiles :: Cmd -> IO [FilePath]+cmdHintFiles Cmd{..} = mapM (getHintFile cmdDataDir) $ cmdGivenHints ++ ["HLint" | null cmdGivenHints && null cmdWithHints] -opts = [Option "?" ["help"] (NoArg Help) "Display help message"-       ,Option "v" ["version"] (NoArg Ver) "Display version information"-       ,Option "r" ["report"] (OptArg (Report . fromMaybe "report.html") "file") "Generate a report in HTML"-       ,Option "h" ["hint"] (ReqArg Hints "file") "Hint/ignore file to use"-       ,Option "w" ["with"] (ReqArg WithHint "hint") "Extra hints to use"-       ,Option "c" ["color","colour"] (NoArg Color) "Color output (requires ANSI terminal)"-       ,Option "i" ["ignore"] (ReqArg Skip "hint") "Ignore a particular hint"-       ,Option "s" ["show"] (NoArg ShowAll) "Show all ignored ideas"-       ,Option "e" ["extension"] (ReqArg Ext "ext") "File extensions to search (defaults to hs and lhs)"-       ,Option "X" ["language"] (ReqArg Language "lang") "Language extensions (Arrows, NoCPP)"-       ,Option "u" ["utf8"] (NoArg $ Encoding "UTF-8") "Use UTF-8 text encoding"-       ,Option ""  ["encoding"] (ReqArg Encoding "encoding") "Choose the text encoding"-       ,Option "x" ["cross"] (NoArg Cross) "Work between modules"-       ,Option "f" ["find"] (ReqArg FindHints "file") "Find hints in a Haskell file"-       ,Option "t" ["test"] (NoArg Test) "Run in test mode"-       ,Option "d" ["datadir"] (ReqArg DataDir "dir") "Override the data directory"-       ,Option "p" ["path"] (ReqArg Path "dir") "Directory in which to search for files"-       ,Option "q" ["quiet"] (NoArg Quiet) "Supress most console output"-       ,Option ""  ["proof"] (ReqArg Proof "file") "Isabelle/HOLCF theory file"-       ,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)"-       ,Option ""  ["cpp-ansi"] (NoArg Ansi) "Use CPP in ANSI compatibility mode"-       ]+cmdExtensions :: Cmd -> [Extension]+cmdExtensions = getExtensions . cmdLanguage  --- | Exit out if you need to display help info-getCmd :: [String] -> IO Cmd-getCmd args = do-    let (opt,files,err) = getOpt Permute opts args-    unless (null err) $-        error $ unlines $ "Unrecognised arguments:" : err--    when (Ver `elem` opt) $ do-        putStr versionText-        exitSuccess--    when (Help `elem` opt) exitWithHelp--    let test = Test `elem` opt--    dataDir <- last $ getDataDir : [return x | DataDir x <- opt]--    let exts = [x | Ext x <- opt]-        exts2 = if null exts then ["hs","lhs"] else exts-    let path = [x | Path x <- opt] ++ ["."]-    files <- if null files then return Nothing else Just <$> concatMapM (getFile path exts2) files-    findHints <- concatMapM (getFile path exts2) [x | FindHints x <- opt]--    let hintFiles = [x | Hints x <- opt]-    let withHints = [x | WithHint x <- opt]-    hints <- mapM (getHintFile dataDir) $ hintFiles ++ ["HLint" | null hintFiles && null withHints]-    let givenHints = if null hintFiles then [] else hints--    let languages = getExtensions [x | Language x <- opt]--    let cpphs = defaultCpphsOptions-            {boolopts=defaultBoolOptions{hashline=False, ansi=Ansi `elem` opt}-            ,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-            | EnableExtension CPP `elem` languages = Cpphs cpphs-            | otherwise = NoCpp--    encoding <- readEncoding $ last $ "" : [x | Encoding x <- opt]--    return Cmd-        {cmdTest = test-        ,cmdFiles = files-        ,cmdHintFiles = hints-        ,cmdGivenHints = givenHints-        ,cmdWithHints = withHints-        ,cmdReports = [x | Report x <- opt]-        ,cmdIgnore = [x | Skip x <- opt]-        ,cmdShowAll = ShowAll `elem` opt-        ,cmdColor = Color `elem` opt-        ,cmdCpp = cpp-        ,cmdDataDir = dataDir-        ,cmdEncoding = encoding-        ,cmdFindHints = findHints-        ,cmdLanguage = languages-        ,cmdQuiet = Quiet `elem` opt-        ,cmdCross = Cross `elem` opt-        ,cmdProof = [x | Proof x <- opt]+cmdCpp :: Cmd -> CppFlags+cmdCpp cmd@Cmd{..}+    | cmdCppSimple = CppSimple+    | EnableExtension CPP `elem` cmdExtensions cmd = Cpphs defaultCpphsOptions+        {boolopts=defaultBoolOptions{hashline=False, stripC89=True, ansi=cmdCppAnsi}+        ,includes = cmdCppInclude+        ,defines = [(a,drop 1 b) | x <- cmdCppDefine, let (a,b) = break (== '=') x]         }---exitWithHelp :: IO a-exitWithHelp = do-    putStr helpText-    exitSuccess---versionText :: String-versionText = "HLint v" ++ showVersion version ++ ", (C) Neil Mitchell 2006-2014\n"+    | otherwise = NoCpp  -helpText :: String-helpText = unlines-    [versionText-    ,"  hlint [files/directories] [options]"-    ,usageInfo "" opts-    ,"HLint gives hints on how to improve Haskell code."-    ,""-    ,"To check all Haskell files in 'src' and generate a report type:"-    ,"  hlint src --report"-    ]- "." <\> x = x x <\> y = x </> y+++resolveFile :: Cmd -> FilePath -> IO [FilePath]+resolveFile Cmd{..} = getFile cmdPath cmdExtension   getFile :: [FilePath] -> [String] -> FilePath -> IO [FilePath]
src/HLint.hs view
@@ -4,8 +4,8 @@  import Control.Applicative import Control.Monad+import System.Console.CmdArgs.Verbosity import Data.List-import Data.Maybe import System.Exit  import CmdLine@@ -49,7 +49,9 @@ hlint :: [String] -> IO [Suggestion] hlint args = do     cmd@Cmd{..} <- getCmd args-    let flags = parseFlagsSetExtensions cmdLanguage $ defaultParseFlags{cppFlags=cmdCpp, encoding=cmdEncoding}++    encoding <- readEncoding cmdEncoding+    let flags = parseFlagsSetExtensions (cmdExtensions cmd) $ defaultParseFlags{cppFlags=cmdCpp cmd, encoding=encoding}     if cmdTest then do         failed <- test (void . hlint) cmdDataDir cmdGivenHints         when (failed > 0) exitFailure@@ -59,18 +61,22 @@         let reps = if cmdReports == ["report.html"] then ["report.txt"] else cmdReports         mapM_ (proof reps s) cmdProof         return []-     else if isNothing cmdFiles && notNull cmdFindHints then-        mapM_ (\x -> putStrLn . fst =<< findSettings2 flags x) cmdFindHints >> return []-     else if isNothing cmdFiles then+     else if null cmdFiles && notNull cmdFindHints then do+        hints <- concatMapM (resolveFile cmd) cmdFindHints+        mapM_ (\x -> putStrLn . fst =<< findSettings2 flags x) hints >> return []+     else if null cmdFiles then         exitWithHelp-     else if cmdFiles == Just [] then-        error "No files found"-     else-        runHints cmd flags+     else do+        files <- concatMapM (resolveFile cmd) cmdFiles+        if null files then+            error "No files found"+         else+            runHints cmd{cmdFiles=files} flags  readAllSettings :: Cmd -> ParseFlags -> IO [Setting]-readAllSettings Cmd{..} flags = do-    settings1 <- readSettings2 cmdDataDir cmdHintFiles cmdWithHints+readAllSettings cmd@Cmd{..} flags = do+    files <- cmdHintFiles cmd+    settings1 <- readSettings2 cmdDataDir files cmdWithHints     settings2 <- concatMapM (fmap snd . findSettings2 flags) cmdFindHints     settings3 <- return [SettingClassify $ Classify Ignore x "" "" | x <- cmdIgnore]     return $ settings1 ++ settings2 ++ settings3@@ -78,13 +84,12 @@  runHints :: Cmd -> ParseFlags -> IO [Suggestion] runHints cmd@Cmd{..} flags = do-    let outStrLn x = unless cmdQuiet $ putStrLn x+    let outStrLn = whenNormal . putStrLn     settings <- readAllSettings cmd flags -    let files = fromMaybe [] cmdFiles     ideas <- if cmdCross-        then applyHintFiles flags settings files-        else concat <$> parallel [listM' =<< applyHintFile flags settings x Nothing | x <- files]+        then applyHintFiles flags settings cmdFiles+        else concat <$> parallel [listM' =<< applyHintFile flags settings x Nothing | x <- cmdFiles]     let (showideas,hideideas) = partition (\i -> cmdShowAll || ideaSeverity i /= Ignore) ideas     showItem <- if cmdColor then showANSI else return show     mapM_ (outStrLn . showItem) showideas
src/HSE/Util.hs view
@@ -146,13 +146,14 @@  isWHNF :: Exp_ -> Bool isWHNF Con{} = True-isWHNF Lit{} = True+isWHNF (Lit _ x) = case x of String{} -> False; Int{} -> False; Frac{} -> False; _ -> True isWHNF Lambda{} = True isWHNF Tuple{} = True isWHNF List{} = True isWHNF (Paren _ x) = isWHNF x-isWHNF RecConstr{} = True isWHNF (ExpTypeSig _ x _) = isWHNF x+-- other (unknown) constructors may have bang patterns in them, so approximate+isWHNF (App _ c@Con{} _) | prettyPrint c `elem` ["Just","Left","Right"] = True isWHNF _ = False
src/Hint/Extensions.hs view
@@ -46,7 +46,11 @@ {-# LANGUAGE DeriveFunctor #-} \ data Foo = Foo Int deriving Functor {-# LANGUAGE DeriveFunctor #-} \-newtype Foo = Foo Int deriving Functor --+newtype Foo = Foo Int deriving Functor+{-# LANGUAGE GeneralizedNewtypeDeriving #-} \+newtype Foo = Foo Int deriving Functor+{-# LANGUAGE GeneralizedNewtypeDeriving #-} \+newtype Foo = Foo Int deriving Data -- {-# LANGUAGE DeriveFunctor, GeneralizedNewtypeDeriving, StandaloneDeriving #-} \ deriving instance Functor Bar {-# LANGUAGE DeriveFunctor, GeneralizedNewtypeDeriving, StandaloneDeriving #-} \@@ -91,8 +95,13 @@ warnings _ _ = []  +-- | Classes that don't work with newtype deriving+noNewtypeDeriving :: [String]+noNewtypeDeriving = ["Read","Show","Data","Typeable","Generic","Generic1"]++ usedExt :: Extension -> Module_ -> Bool-usedExt (UnknownExtension "DeriveGeneric") = hasDerive True ["Generic","Generic1"]+usedExt (UnknownExtension "DeriveGeneric") = hasDerive ["Generic","Generic1"] usedExt (EnableExtension x) = used x usedExt _ = const True @@ -128,13 +137,11 @@ used PackageImports = hasS (isJust . importPkg) used QuasiQuotes = hasS isQuasiQuote used ViewPatterns = hasS isPViewPat-used DeriveDataTypeable = hasDerive True ["Data","Typeable"]-used DeriveFunctor = hasDerive False ["Functor"]-used DeriveFoldable = hasDerive False ["Foldable"]-used DeriveTraversable = hasDerive False ["Traversable"]-used GeneralizedNewtypeDeriving = any (`notElem` special) . fst . derives-    where special = ["Read","Show","Data","Typeable","Generic","Generic1"] -- these classes cannot use generalised deriving-    -- FIXME: This special list is duplicated here, and as booleans to hasDerive+used DeriveDataTypeable = hasDerive ["Data","Typeable"]+used DeriveFunctor = hasDerive ["Functor"]+used DeriveFoldable = hasDerive ["Foldable"]+used DeriveTraversable = hasDerive ["Traversable"]+used GeneralizedNewtypeDeriving = any (`notElem` noNewtypeDeriving) . fst . derives used Arrows = hasS f     where f Proc{} = True           f LeftArrApp{} = True@@ -150,14 +157,13 @@ used x = usedExt $ UnknownExtension $ show x  --hasDerive :: Bool -> [String] -> Module_ -> Bool-hasDerive nt want m = not $ null $ intersect want $ if nt then new ++ dat else dat+hasDerive :: [String] -> Module_ -> Bool+hasDerive want m = any (`elem` want) $ new ++ dat     where (new,dat) = derives m   -- | What is derived on newtype, and on data type---   'deriving' declarations may be on either, so we approximate+--   'deriving' declarations may be on either, so we approximate as both newtype and data derives :: Module_ -> ([String],[String]) derives = concatUnzip . map f . childrenBi     where
+ src/Language/Haskell/HLint2.hs view
@@ -0,0 +1,80 @@++-- | /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./+--+--   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.HLint2(+    applyHints,+    -- * Idea data type+    Idea(..), Severity(..), Note(..),+    -- * Settings+    Classify(..),+    getHLintDataDir,+    autoSettings, findSettings, readSettings,+    -- * Hints+    Hint(..), builtinHints,+    HintRule(..), hintRules,+    -- * Scopes+    Scope, scopeCreate, scopeMatch, scopeMove,+    -- * Haskell-src-exts+    parseModuleEx, defaultParseFlags, ParseError(..), ParseFlags(..), CppFlags(..),+    -- * File encodings+    Encoding, defaultEncoding, readEncoding, useEncoding+    ) where++import Settings+import Idea+import Apply+import Hint.Type+import Hint.All+import Util+import CmdLine+import Paths_hlint++import Control.Applicative+import Control.Arrow+import Data.List+import Data.Maybe+import Data.Monoid+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' to find and load the HLint settings files.+--+-- 1. Use 'readSettings' to interpret the settings files, producing 'HintRule' values (@LHS ==> RHS@ replacements)+--   and 'Classify' values to assign 'Severity' ratings to hints.+--+-- 1. Use 'builtinHints' and 'hintRules' to generate a 'Hint' value.+--+-- 1. Take all fixities from the 'findSettings' modules and put them in the 'ParseFlags'.+autoSettings :: IO (ParseFlags, [Classify], Hint)+autoSettings = do+    dataDir <- getHLintDataDir+    (builtin, matches) <- first resolveBuiltin <$> findSettings dataDir (dataDir </> "HLint.hs") Nothing+    let (classify, rules) = second hintRules $ concat2 $ 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 ()+_docs = do+    (flags, classify, hint) <- autoSettings+    Right m <- parseModuleEx flags "MyFile.hs" Nothing+    print $ applyHints classify hint [m]
src/Settings.hs view
@@ -8,7 +8,6 @@     ) where  import HSE.All-import Control.Monad import Data.Char import Data.List import Data.Monoid@@ -123,32 +122,31 @@  readHints :: FilePath -> Either String FilePath -> IO [Either String Module_] readHints datadir x = do-    (builtin,errs,ms) <- case x of+    (builtin,ms) <- case x of         Left src -> findSettings datadir "CommandLine" (Just src)         Right file -> findSettings datadir file Nothing-    forM_ errs $ \(ParseError sl msg _) -> return $! fromParseResult $ ParseFailed sl msg     return $ map Left builtin ++ map Right ms  --- | Given the data directory (where the @hlint@ data files reside), and a filename to read, and optionally that file's---   contents, produce a triple containing:+-- | Given the data directory (where the @hlint@ data files reside, see 'getHLintDataDir'),+--   and a filename to read, and optionally that file's contents, produce a pair containing: -- -- 1. Builtin hints to use, e.g. @"List"@, which should be resolved using 'builtinHints'. ----- 1. A list of parse errors produced while parsing settings files.--- -- 1. A list of modules containing hints, suitable for processing with 'readSettings'.-findSettings :: FilePath -> FilePath -> Maybe String -> IO ([String], [ParseError], [Module SrcSpanInfo])+--+--   Any parse failures will result in an exception.+findSettings :: FilePath -> FilePath -> Maybe String -> IO ([String], [Module SrcSpanInfo]) findSettings dataDir file contents = do     let flags = addInfix defaultParseFlags     res <- parseModuleEx flags file contents     case res of-        Left err -> return ([], [err], [])+        Left (ParseError sl msg err) -> exitMessage $ "Parse failure at " ++ showSrcLoc sl ++ ": " ++ msg ++ "\n" ++ err         Right m -> do             ys <- sequence [f $ fromNamed $ importModule i | i <- moduleImports m, importPkg i `elem` [Just "hint", Just "hlint"]]-            return $ concat3 $ ([],[],[m]) : ys+            return $ concat2 $ ([],[m]) : ys     where-        f x | Just x <- "HLint.Builtin." `stripPrefix` x = return ([x],[],[])+        f x | Just x <- "HLint.Builtin." `stripPrefix` x = return ([x],[])             | Just x <- "HLint." `stripPrefix` x = findSettings dataDir (dataDir </> x <.> "hs") Nothing             | otherwise = findSettings dataDir (x <.> "hs") Nothing
− src/Temporary/API.hs 
@@ -1,40 +0,0 @@---- | /WARNING: This module represents the evolving API of HLint, do not use./------   This module provides a way to apply HLint hints. To replicate the full @hlint@ experience you would:------ 1. Use 'findSettings' to find and load the HLint settings files.------ 1. Use 'readSettings' to interpret the settings files, producing 'HintRule' values (@LHS ==> RHS@ replacements)---   and 'Classify' values to assign 'Severity' ratings to hints.------ 1. Use 'builtinHints' and 'hintRules' to generate a 'Hint' value.------ 1. Use 'parseModuleEx' to parse the input files, using any fixity declarations from 'findSettings'.------ 1. Use 'applyHints' to execute the hints on the modules, generating 'Idea's.-module Temporary.API(-    applyHints,-    -- * Idea data type-    Idea(..), Severity(..), Note(..),-    -- * Settings-    Classify(..),-    findSettings, readSettings,-    -- * Hints-    Hint(..), builtinHints,-    HintRule(..), hintRules,-    -- * Scopes-    Scope, scopeCreate, scopeMatch, scopeMove,-    -- * Haskell-src-exts-    parseModuleEx, defaultParseFlags, ParseError(..), ParseFlags(..), CppFlags(..),-    -- * File encodings-    Encoding, defaultEncoding, readEncoding, useEncoding-    ) where--import Settings-import Idea-import Apply-import Hint.Type-import Hint.All-import Util-import CmdLine
src/Util.hs view
@@ -133,8 +133,14 @@ thd3 (a,b,c) = c  concat3 :: [([a],[b],[c])] -> ([a],[b],[c])-concat3 xs = (concatMap fst3 xs, concatMap snd3 xs, concatMap thd3 xs)+concat3 xs = (concat a, concat b, concat c)+    where (a,b,c) = unzip3 xs +concat2 :: [([a],[b])] -> ([a],[b])+concat2 xs = (concat a, concat b)+    where (a,b) = unzip xs++ --------------------------------------------------------------------- -- SYSTEM.IO @@ -265,4 +271,5 @@     [Arrows -- steals proc     ,TransformListComp -- steals the group keyword     ,XmlSyntax, RegularPatterns -- steals a-b+    ,UnboxedTuples -- breaks (#) lens operator     ]