diff --git a/CHANGES.txt b/CHANGES.txt --- a/CHANGES.txt +++ b/CHANGES.txt @@ -1,5 +1,12 @@ Changelog for HLint (* = breaking change) +2.1.24, released 2019-06-10 + Add Language.Haskell.HLint4 + #658, ignore the previously undocumented {- LINT -} comments + #658, force parsing of all pragmas and comments eagerly + #665, make different fromMaybe hints have different names + #664, better name for the Use uncurry hint + #659, make hints with brackets at the root work 2.1.23, released 2019-06-09 Make it an error if your code does not parse with GHC #662, don't warn on ($x), since it might not really be TH diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # HLint [![Hackage version](https://img.shields.io/hackage/v/hlint.svg?label=Hackage)](https://hackage.haskell.org/package/hlint) [![Stackage version](https://www.stackage.org/package/hlint/badge/nightly?label=Stackage)](https://www.stackage.org/package/hlint) [![Linux build status](https://img.shields.io/travis/ndmitchell/hlint/master.svg?label=Linux%20build)](https://travis-ci.org/ndmitchell/hlint) [![Windows build status](https://img.shields.io/appveyor/ci/ndmitchell/hlint/master.svg?label=Windows%20build)](https://ci.appveyor.com/project/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: +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: * [Installing and running HLint](#installing-and-running-hlint) * [FAQ](#faq) @@ -86,6 +86,8 @@ * [Code Climate](https://docs.codeclimate.com/v1.0/docs/hlint) is a CI for analysis which integrates HLint. * [Danger](http://allocinit.io/haskell/danger-and-hlint/) can be used to automatically comment on pull requests with HLint suggestions. * [Restyled](https://restyled.io) includes an HLint Restyler to automatically run `hlint --refactor` on files changed in GitHub Pull Requests. +* [lpaste](http://lpaste.net/) integrates with HLint - suggestions are shown at the bottom. +* [hlint-test](https://hackage.haskell.org/package/hlint-test) helps you write a small test runner with HLint. ### Automatically Applying Hints diff --git a/data/hlint.yaml b/data/hlint.yaml --- a/data/hlint.yaml +++ b/data/hlint.yaml @@ -261,15 +261,14 @@ - warn: {lhs: \x y -> x, rhs: const} - warn: {lhs: "\\(x,y) -> y", rhs: snd} - warn: {lhs: "\\(x,y) -> x", rhs: fst} - - hint: {lhs: "\\x y -> f (x,y)", rhs: curry f, name: Use curry} - - hint: {lhs: "\\(x,y) -> f x y", rhs: uncurry f, note: IncreasesLaziness, name: Use uncurry} - - warn: {lhs: ($) . f, rhs: f, name: Redundant $} - - warn: {lhs: (f $), rhs: f, name: Redundant $} + - hint: {lhs: "\\x y -> f (x,y)", rhs: curry f} + - hint: {lhs: "\\(x,y) -> f x y", rhs: uncurry f, note: IncreasesLaziness} + - warn: {lhs: f (fst p) (snd p), rhs: uncurry f p} - warn: {lhs: (Data.Function.& f), rhs: f, name: Redundant Data.Function.&} - hint: {lhs: \x -> y, rhs: const y, side: isAtom y && not (isWildcard y)} # If any isWildcard recursively then x may be used but not mentioned explicitly - - warn: {lhs: flip f x y, rhs: f y x, side: isApp original, name: Redundant flip} - - warn: {lhs: id x, rhs: x, side: not (isTypeApp x), name: Redundant id} + - warn: {lhs: flip f x y, rhs: f y x, side: isApp original} + - warn: {lhs: id x, rhs: x, side: not (isTypeApp x)} - warn: {lhs: id . x, rhs: x, name: Redundant id} - warn: {lhs: x . id, rhs: x, name: Redundant id} - warn: {lhs: "((,) x)", rhs: "(_noParen_ x,)", name: Use tuple-section, note: RequiresExtension TupleSections} @@ -473,7 +472,8 @@ - warn: {lhs: "maybe [] (:[])", rhs: maybeToList} - warn: {lhs: catMaybes (map f x), rhs: mapMaybe f x} - warn: {lhs: catMaybes (fmap f x), rhs: mapMaybe f x} - - hint: {lhs: case x of Nothing -> y; Just a -> a , rhs: fromMaybe y x} + - hint: {lhs: case x of Nothing -> y; Just a -> a , rhs: Data.Maybe.fromMaybe y x, name: Replace case with fromMaybe} + - hint: {lhs: case x of Just a -> a; Nothing -> y, rhs: Data.Maybe.fromMaybe y x, name: Replace case with fromMaybe} - warn: {lhs: if isNothing x then y else f (fromJust x), rhs: maybe y f x} - warn: {lhs: if isJust x then f (fromJust x) else y, rhs: maybe y f x} - warn: {lhs: maybe Nothing (Just . f), rhs: fmap f} @@ -485,7 +485,6 @@ - warn: {lhs: concatMap (maybeToList . f), rhs: Data.Maybe.mapMaybe f} - warn: {lhs: concatMap maybeToList, rhs: catMaybes} - warn: {lhs: maybe n Just x, rhs: x Control.Applicative.<|> n} - - hint: {lhs: case x of Just a -> a; Nothing -> y, rhs: fromMaybe y x} - warn: {lhs: if isNothing x then y else fromJust x, rhs: fromMaybe y x} - warn: {lhs: if isJust x then fromJust x else y, rhs: fromMaybe y x} - warn: {lhs: isJust x && (fromJust x == y), rhs: x == Just y} @@ -606,7 +605,6 @@ - warn: {lhs: either f g (Right y), rhs: g y, name: Evaluate} - warn: {lhs: "fst (x,y)", rhs: x, name: Evaluate} - warn: {lhs: "snd (x,y)", rhs: "y", name: Evaluate} - - warn: {lhs: f (fst p) (snd p), rhs: uncurry f p, name: Evaluate} - warn: {lhs: "init [x]", rhs: "[]", name: Evaluate} - warn: {lhs: "null []", rhs: "True", name: Evaluate} - warn: {lhs: "length []", rhs: "0", name: Evaluate} @@ -835,7 +833,7 @@ # yes x = case x of {True -> a ; False -> b} -- if x then a else b # yes x = case x of {False -> a ; _ -> b} -- if x then b else a # no = const . ok . toResponse $ "saved" -# yes = case x z of Nothing -> y z; Just pat -> pat -- fromMaybe (y z) (x z) +# yes = case x z of Nothing -> y z; Just pat -> pat -- Data.Maybe.fromMaybe (y z) (x z) # yes = if p then s else return () -- Control.Monad.when p s # warn = a $$$$ b $$$$ c ==> a . b $$$$$ c # yes = when (not . null $ asdf) -- unless (null asdf) @@ -913,6 +911,7 @@ # no = sequence (return x) # no = sequenceA (pure a) # {-# LANGUAGE QuasiQuotes #-}; no = f (\url -> [hamlet|foo @{url}|]) +# yes = f ((,) x) -- (x,) # import Prelude \ # yes = flip mapM -- Control.Monad.forM diff --git a/hlint.cabal b/hlint.cabal --- a/hlint.cabal +++ b/hlint.cabal @@ -1,7 +1,7 @@ cabal-version: >= 1.18 build-type: Simple name: hlint -version: 2.1.23 +version: 2.1.24 license: BSD3 license-file: LICENSE category: Development @@ -66,13 +66,12 @@ build-depends: hscolour >= 1.21 else cpp-options: -DGPL_SCARES_ME - if impl(ghc < 8.0) - build-depends: semigroups >= 0.18 hs-source-dirs: src exposed-modules: Language.Haskell.HLint Language.Haskell.HLint3 + Language.Haskell.HLint4 other-modules: Paths_hlint Apply diff --git a/src/Apply.hs b/src/Apply.hs --- a/src/Apply.hs +++ b/src/Apply.hs @@ -36,7 +36,7 @@ -- | Given a way of classifying results, and a 'Hint', apply to a set of modules generating a list of 'Idea's. -- The 'Idea' values will be ordered within a file. -- --- Given a set of modules, it may be faster pass each to 'applyHints' in a singleton list. +-- Given a set of modules, it may be faster to pass each to 'applyHints' in a singleton list. -- When given multiple modules at once this function attempts to find hints between modules, -- which is slower and often pointless (by default HLint passes modules singularly, using -- @--cross@ to pass all modules together). @@ -45,11 +45,13 @@ applyHintsReal :: [Setting] -> Hint -> [(Module_, [Comment])] -> [Idea] applyHintsReal settings hints_ ms = concat $ - [ map (classify (cls ++ mapMaybe readPragma (universeBi m) ++ concatMap readComment cs) . removeRequiresExtensionNotes m) $ + [ map (classify classifiers . removeRequiresExtensionNotes m) $ order [] (hintModule hints settings nm m) `merge` concat [order [fromNamed d] $ decHints d | d <- moduleDecls m] `merge` concat [order [] $ hintComment hints settings c | c <- cs] | (nm,(m,cs)) <- mns + , let classifiers = cls ++ mapMaybe readPragma (universeBi m) ++ concatMap readComment cs + , seq (length classifiers) True -- to force any errors from readPragma or readComment , let decHints = hintDecl hints settings nm m -- partially apply , let order n = map (\i -> i{ideaModule= f $ moduleName m : ideaModule i, ideaDecl= f $ n ++ ideaDecl i}) . sortOn ideaSpan , let merge = mergeBy (comparing ideaSpan)] ++ @@ -77,9 +79,9 @@ -- | Return either an idea (a parse error) or the module. In IO because might call the C pre processor. parseModuleApply :: ParseFlags -> [Setting] -> FilePath -> Maybe String -> IO (Either Idea (Module_, [Comment])) parseModuleApply flags s file src = do - res <- parseModuleExInternal (parseFlagsAddFixities [x | Infix x <- s] flags) file src + res <- parseModuleEx (parseFlagsAddFixities [x | Infix x <- s] flags) file src case res of - Right (ParsedModuleResults (m, c) _) -> return $ Right (m,c) + Right (ModuleEx (m, c) _) -> return $ Right (m,c) Left (ParseError sl msg ctxt) -> return $ Left $ classify [x | SettingClassify x <- s] $ rawIdeaN Error "Parse error" (mkSrcSpan sl sl) ctxt Nothing [] diff --git a/src/Config/Compute.hs b/src/Config/Compute.hs --- a/src/Config/Compute.hs +++ b/src/Config/Compute.hs @@ -14,11 +14,11 @@ -- Returns the text of the hints (if you want to save it down) along with the settings to be used. computeSettings :: ParseFlags -> FilePath -> IO (String, [Setting]) computeSettings flags file = do - x <- parseModuleExInternal flags file Nothing + x <- parseModuleEx flags file Nothing case x of Left (ParseError sl msg _) -> return ("# Parse error " ++ showSrcLoc sl ++ ": " ++ msg, []) - Right (ParsedModuleResults (m, _) _) -> do + Right (ModuleEx (m, _) _) -> do let xs = concatMap (findSetting $ UnQual an) (moduleDecls m) r = concatMap (readSetting mempty) xs s = unlines $ ["# hints found in " ++ file] ++ concatMap renderSetting r ++ ["# no hints found" | null xs] diff --git a/src/Config/Haskell.hs b/src/Config/Haskell.hs --- a/src/Config/Haskell.hs +++ b/src/Config/Haskell.hs @@ -27,11 +27,11 @@ readFileConfigHaskell :: FilePath -> Maybe String -> IO [Setting] readFileConfigHaskell file contents = do let flags = addInfix defaultParseFlags - res <- parseModuleExInternal flags file contents + res <- parseModuleEx flags file contents case res of Left (ParseError sl msg err) -> error $ "Config parse failure at " ++ showSrcLoc sl ++ ": " ++ msg ++ "\n" ++ err - Right (ParsedModuleResults (m, cs) _) -> return $ readSettings m ++ map SettingClassify (concatMap readComment cs) + Right (ModuleEx (m, cs) _) -> return $ readSettings m ++ map SettingClassify (concatMap readComment cs) -- | Given a module containing HLint settings information return the 'Classify' rules and the 'HintRule' expressions. @@ -83,7 +83,7 @@ | (hash, x) <- maybe (False, x) (True,) $ stripPrefix "#" x , x <- trim x , (hlint, x) <- word1 x - , lower hlint `elem` ["lint","hlint"] + , lower hlint == "hlint" = f hash x where f hash x diff --git a/src/Grep.hs b/src/Grep.hs --- a/src/Grep.hs +++ b/src/Grep.hs @@ -22,10 +22,10 @@ let scope = scopeCreate $ Module an Nothing [] [] [] let rule = hintRules [HintRule Suggestion "grep" scope exp (Tuple an Boxed []) Nothing []] forM_ files $ \file -> do - res <- parseModuleExInternal flags file Nothing + res <- parseModuleEx flags file Nothing case res of Left (ParseError sl msg ctxt) -> print $ rawIdeaN Error (if "Parse error" `isPrefixOf` msg then msg else "Parse error: " ++ msg) (mkSrcSpan sl sl) ctxt Nothing [] - Right (ParsedModuleResults (m, c) _) -> + Right (ModuleEx (m, c) _) -> forM_ (applyHints [] rule [(m, c)]) $ \i -> print i{ideaHint="", ideaTo=Nothing} diff --git a/src/HLint.hs b/src/HLint.hs --- a/src/HLint.hs +++ b/src/HLint.hs @@ -50,7 +50,7 @@ -- -- /Warning:/ The flags provided by HLint are relatively stable, but do not have the same -- API stability guarantees as the rest of the strongly-typed API. Do not run this function --- on a your server with untrusted input. +-- on your server with untrusted input. hlint :: [String] -> IO [Idea] hlint args = do cmd <- getCmd args diff --git a/src/HSE/All.hs b/src/HSE/All.hs --- a/src/HSE/All.hs +++ b/src/HSE/All.hs @@ -6,8 +6,8 @@ module X, CppFlags(..), ParseFlags(..), defaultParseFlags, parseFlagsAddFixities, parseFlagsSetLanguage, - parseModuleEx, ParseError(..), ParsedModuleResults(..), - parseModuleExInternal, + ParseError(..), ModuleEx(..), + parseModuleEx, freeVars, vars, varss, pvars ) where @@ -158,8 +158,9 @@ , parseErrorContents :: String -- ^ Snippet of several lines (typically 5) including a @>@ character pointing at the faulty line. } --- | Combined 'hs-src-ext' and 'ghc-lib-parser' parse trees. -data ParsedModuleResults = ParsedModuleResults { +-- | Result of 'parseModuleEx', representing a parsed module. +data ModuleEx = ModuleEx { + -- Combined 'hs-src-ext' and 'ghc-lib-parser' parse trees. pm_hsext :: (Module SrcSpanInfo, [Comment]) -- hs-src-ext result , pm_ghclib :: Located (HsSyn.HsModule HsSyn.GhcPs) -- ghc-lib-parser result } @@ -176,7 +177,7 @@ -> SrcLoc -> String -> Maybe (GHC.SrcSpan, ErrUtils.MsgDoc) - -> IO (Either ParseError ParsedModuleResults) + -> IO (Either ParseError ModuleEx) failOpParseModuleEx ppstr flags file str sl msg ghc = case ghc of Just err -> @@ -197,7 +198,7 @@ -> String -> SrcLoc -> String - -> IO (Either ParseError ParsedModuleResults) + -> IO (Either ParseError ModuleEx) hseFailOpParseModuleEx ppstr flags file str sl msg = do flags <- return $ parseFlagsNoLocations flags ppstr2 <- runCpp (cppFlags flags) file str @@ -211,7 +212,7 @@ -> FilePath -> String -> (GHC.SrcSpan, ErrUtils.MsgDoc) - -> IO (Either ParseError ParsedModuleResults) + -> IO (Either ParseError ModuleEx) ghcFailOpParseModuleEx ppstr file str (loc, err) = do let sl = case loc of @@ -233,11 +234,8 @@ -- filename @-@ is treated as @stdin@. Requires some flags (often -- 'defaultParseFlags'), the filename, and optionally the contents of -- that file. This version uses both hs-src-exts AND ghc-lib. -parseModuleEx :: ParseFlags -> FilePath -> Maybe String -> IO (Either ParseError (Module SrcSpanInfo, [Comment])) -parseModuleEx flags file str = fmap pm_hsext <$> parseModuleExInternal flags file str - -parseModuleExInternal :: ParseFlags -> FilePath -> Maybe String -> IO (Either ParseError ParsedModuleResults) -parseModuleExInternal flags file str = timedIO "Parse" file $ do +parseModuleEx :: ParseFlags -> FilePath -> Maybe String -> IO (Either ParseError ModuleEx) +parseModuleEx flags file str = timedIO "Parse" file $ do str <- case str of Just x -> return x Nothing | file == "-" -> getContentsUTF8 @@ -249,7 +247,7 @@ Right ghcFlags -> case (parseFileContentsWithComments (mkMode flags file) ppstr, parseFileGhcLib file ppstr ghcFlags) of (ParseOk (x, cs), POk _ a) -> - return $ Right (ParsedModuleResults (applyFixity fixity x, cs) a) + return $ Right (ModuleEx (applyFixity fixity x, cs) a) -- Parse error if GHC parsing fails (see -- https://github.com/ndmitchell/hlint/issues/645). (ParseOk _, PFailed _ loc err) -> diff --git a/src/HSE/Unify.hs b/src/HSE/Unify.hs --- a/src/HSE/Unify.hs +++ b/src/HSE/Unify.hs @@ -97,11 +97,10 @@ -- root = True, this is the outside of the expr -- do not expand out a dot at the root, since otherwise you get two matches because of readRule (Bug #570) unifyExp :: NameMatch -> Bool -> Exp_ -> Exp_ -> Maybe (Subst Exp_) -unifyExp nm root x y | not root, isParen x || isParen y = - fmap (rebracket y) <$> unifyExp nm root (fromParen x) (fromParen y) - where - rebracket (Paren l e') e | e' == e = Paren l e - rebracket e e' = e' + +-- brackets are not added when expanding $ in the users code, so tolerate them +-- in the match even if they aren't in the users code +unifyExp nm root x y | not root, isParen x, not $ isParen y = unifyExp nm root (fromParen x) y unifyExp nm root (Var _ (fromNamed -> v)) y | isUnifyVar v = Just $ Subst [(v,y)] unifyExp nm root (Var _ x) (Var _ y) | nm x y = Just mempty diff --git a/src/Hint/Match.hs b/src/Hint/Match.hs --- a/src/Hint/Match.hs +++ b/src/Hint/Match.hs @@ -95,7 +95,7 @@ findIdeas matches s _ decl = timed "Hint" "Match apply" $ forceList [ (idea (hintRuleSeverity m) (hintRuleName m) x y [r]){ideaNote=notes} | decl <- findDecls decl - , (parent,x) <- universeParentExp decl, not $ isParen x + , (parent,x) <- universeParentExp decl , m <- matches, Just (y,notes, subst) <- [matchIdea s decl m parent x] , let r = R.Replace R.Expr (toSS x) subst (prettyPrint $ hintRuleRHS m) ] diff --git a/src/Language/Haskell/HLint3.hs b/src/Language/Haskell/HLint3.hs --- a/src/Language/Haskell/HLint3.hs +++ b/src/Language/Haskell/HLint3.hs @@ -1,17 +1,7 @@ {-# LANGUAGE PatternGuards, RecordWildCards #-} --- | /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. If you want to just run @hlint@ in-process --- and collect the results see 'hlint'. If you want to approximate the @hlint@ experience with --- a more structured API try: --- --- @ --- (flags, classify, hint) <- 'autoSettings' --- Right m <- 'parseModuleEx' flags \"MyFile.hs\" Nothing --- print $ 'applyHints' classify hint [m] --- @ +-- | /WARNING: This module represents a previous version of the HLint API./ +-- /Please use "Language.Haskell.HLint4" instead./ module Language.Haskell.HLint3( hlint, applyHints, -- * Idea data type @@ -34,7 +24,8 @@ import Idea import Apply import HLint -import HSE.All +import HSE.All hiding (parseModuleEx) +import qualified HSE.All as H import Hint.All import CmdLine import Paths_hlint @@ -115,6 +106,16 @@ ([x | Infix x <- xs] ,[x | SettingClassify x <- xs] ,[Right x | SettingMatchExp x <- xs] ++ map Left [minBound..maxBound]) + + +-- | Parse a Haskell module. Applies the C pre processor, and uses +-- best-guess fixity resolution if there are ambiguities. The +-- filename @-@ is treated as @stdin@. Requires some flags (often +-- 'defaultParseFlags'), the filename, and optionally the contents of +-- that file. This version uses both hs-src-exts AND ghc-lib. +parseModuleEx :: ParseFlags -> FilePath -> Maybe String -> IO (Either ParseError (Module SrcSpanInfo, [Comment])) +parseModuleEx flags file str = fmap pm_hsext <$> H.parseModuleEx flags file str + -- | Snippet from the documentation, if this changes, update the documentation _docs :: IO () diff --git a/src/Language/Haskell/HLint4.hs b/src/Language/Haskell/HLint4.hs new file mode 100644 --- /dev/null +++ b/src/Language/Haskell/HLint4.hs @@ -0,0 +1,138 @@ +{-# LANGUAGE PatternGuards, RecordWildCards #-} + +-- | /WARNING: This module represents the evolving version of the HLint API./ +-- /It will be renamed to drop the "4" in the next major version./ +-- +-- This module provides a way to apply HLint hints. If you want to just run @hlint@ in-process +-- and collect the results see 'hlint'. If you want to approximate the @hlint@ experience with +-- a more structured API try: +-- +-- @ +-- (flags, classify, hint) <- 'autoSettings' +-- Right m <- 'parseModuleEx' flags \"MyFile.hs\" Nothing +-- print $ 'applyHints' classify hint [m] +-- @ +module Language.Haskell.HLint4( + hlint, applyHints, + -- * Idea data type + Idea(..), Severity(..), Note(..), + -- * Settings + Classify(..), + getHLintDataDir, autoSettings, argsSettings, + findSettings, readSettingsFile, + -- * Hints + Hint, resolveHints, + -- * Parse files + ModuleEx, parseModuleEx, defaultParseFlags, parseFlagsAddFixities, ParseError(..), ParseFlags(..), CppFlags(..) + ) where + +import Config.Type +import Config.Read +import Idea +import qualified Apply as H +import HLint +import HSE.All +import Hint.All hiding (resolveHints) +import qualified Hint.All as H +import CmdLine +import Paths_hlint + +import Data.List.Extra +import Data.Maybe +import System.FilePath +import Data.Functor +import Prelude + + +-- | 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, hints) + + +-- | The identity function. In previous versions of HLint this function was useful. Now, it isn't. +resolveHints :: Hint -> Hint +resolveHints = id + +-- | A version of 'autoSettings' which respects some of the arguments supported by HLint. +-- If arguments unrecognised by HLint are used it will result in an error. +-- Arguments which have no representation in the return type are silently ignored. +argsSettings :: [String] -> IO (ParseFlags, [Classify], Hint) +argsSettings args = do + cmd <- getCmd args + case cmd of + CmdMain{..} -> do + -- FIXME: Two things that could be supported (but aren't) are 'cmdGivenHints' and 'cmdWithHints'. + (_,settings) <- readAllSettings args cmd + let (fixities, classify, hints) = splitSettings settings + let flags = parseFlagsSetLanguage (cmdExtensions cmd) $ parseFlagsAddFixities fixities $ + defaultParseFlags{cppFlags = cmdCpp cmd} + let ignore = [Classify Ignore x "" "" | x <- cmdIgnore] + return (flags, classify ++ ignore, hints) + _ -> error "Can only invoke autoSettingsArgs with the root process" + + +-- | Given a directory (or 'Nothing' to imply 'getHLintDataDir'), and a module 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 + | takeExtension x `elem` [".yml",".yaml"] = do + dir <- maybe getHLintDataDir return dir + return (dir x, Nothing) + | 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.yaml@) find the information from all settings files. +findSettings :: (String -> IO (FilePath, Maybe String)) -> Maybe String -> IO ([Fixity], [Classify], Hint) +findSettings load start = do + (file,contents) <- load $ fromMaybe "hlint.yaml" start + splitSettings <$> readFilesConfig [(file,contents)] + +-- | Split a list of 'Setting' for separate use in parsing and hint resolution +splitSettings :: [Setting] -> ([Fixity], [Classify], Hint) +splitSettings xs = + ([x | Infix x <- xs] + ,[x | SettingClassify x <- xs] + ,H.resolveHints $ [Right x | SettingMatchExp x <- xs] ++ map Left [minBound..maxBound]) + + +-- | Given a way of classifying results, and a 'Hint', apply to a set of modules generating a list of 'Idea's. +-- The 'Idea' values will be ordered within a file. +-- +-- Given a set of modules, it may be faster to pass each to 'applyHints' in a singleton list. +-- When given multiple modules at once this function attempts to find hints between modules, +-- which is slower and often pointless (by default HLint passes modules singularly, using +-- @--cross@ to pass all modules together). +applyHints :: [Classify] -> Hint -> [ModuleEx] -> [Idea] +applyHints a b = H.applyHints a b . map pm_hsext + + +-- | 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]