module Language.Haskell.HLint3(
hlint, applyHints,
Idea(..), Severity(..), Note(..),
Classify(..),
getHLintDataDir, autoSettings, argsSettings,
findSettings, readSettingsFile,
HintBuiltin(..), HintRule(..),
Hint(..), resolveHints,
Scope, scopeCreate, scopeMatch, scopeMove,
parseModuleEx, defaultParseFlags, parseFlagsAddFixities, ParseError(..), ParseFlags(..), CppFlags(..)
) where
import Settings hiding (findSettings)
import Idea
import Apply
import HLint
import Hint.Type
import Hint.All
import CmdLine
import Util
import System.IO
import Paths_hlint
import Data.List.Extra
import Data.Maybe
import System.FilePath
getHLintDataDir :: IO FilePath
getHLintDataDir = getDataDir
autoSettings :: IO (ParseFlags, [Classify], Hint)
autoSettings = do
(fixities, classify, hints) <- findSettings (readSettingsFile Nothing) Nothing
return (parseFlagsAddFixities fixities defaultParseFlags, classify, resolveHints hints)
argsSettings :: [String] -> IO (ParseFlags, [Classify], Hint)
argsSettings args = do
cmd <- getCmd args
case cmd of
CmdMain{..} -> do
(fixities, classify, hints) <- findSettings (readSettingsFile $ Just cmdDataDir) Nothing
encoding <- if cmdUtf8 then return utf8 else readEncoding cmdEncoding
let flags = parseFlagsSetLanguage (cmdExtensions cmd) $ parseFlagsAddFixities fixities $
defaultParseFlags{cppFlags = cmdCpp cmd, encoding = encoding}
let ignore = [Classify Ignore x "" "" | x <- cmdIgnore]
return (flags, classify ++ ignore, resolveHints hints)
_ -> error "Can only invoke autoSettingsArgs with the root process"
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)
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)
_docs :: IO ()
_docs = do
(flags, classify, hint) <- autoSettings
Right m <- parseModuleEx flags "MyFile.hs" Nothing
print $ applyHints classify hint [m]